Given some tuple $\{N,M,L\}$ such that $N\geq M\geq L\geq 0$ and $N>0$, how can I generate all tuples $\{n,m,l\}$ such that $n\geq m\geq l\geq 0$ and such that FromDigits[{N,M,L},N] is greater than FromDigits[{n,m,l},N]?
I would like to have this returned in a $Q\times 3$ List, where $Q$ is the number of distinct tuples $\{n,m,l\}$.
For example, if $\{N,M,L\}=\{2,1,0\}$, then it would return {{1,0,0},{1,1,0},{1,1,1},{2,0,0},{2,1,0}}.
triplesF = Partition[Flatten[Table[{i, j, k},
{i, 0, #}, {j, 0, If[i == #, #2, i]}, {k, 0, If[i == #, Min[j, #3], j]}]], 3] &;
Examples:
(* {{0, 0, 0}, {1, 0, 0}, {1, 1, 0}} *)
triplesF[1, 1, 1]
(* {{0,0,0},{1,0,0},{1,1,0},{1,1,1}} *)
triplesF[2, 1, 0]
(* {{0, 0, 0}, {1, 0, 0}, {1, 1, 0}, {1, 1, 1}, {2, 0, 0}, {2, 1, 0}}*)
triplesF[2, 2, 0]
(* {{0, 0, 0}, {1, 0, 0}, {1, 1, 0}, {1, 1, 1}, {2, 0, 0}, {2, 1, 0}, {2, 2, 0}}*)
triplesF[3, 2, 0]
(* {{0, 0, 0}, {1, 0, 0}, {1, 1, 0}, {1, 1, 1}, {2, 0, 0}, {2, 1, 0}, {2, 1, 1},
{2, 2, 0}, {2, 2, 1}, {2, 2, 2}, {3, 0, 0}, {3, 1, 0}, {3, 2, 0}} *)
triplesF[3, 1, 0]
(* {{0, 0, 0}, {1, 0, 0}, {1, 1, 0}, {1, 1, 1}, {2, 0, 0}, {2, 1, 0}, {2, 1, 1},
{2, 2, 0}, {2, 2, 1}, {2, 2, 2}, {3, 0, 0}, {3, 1, 0}} *)
Update: Some timing comparisons
First@AbsoluteTiming[res1 = triplesF[10, 10, 10];]
(* 0.001001 *)
First@AbsoluteTiming[res2 = c[10, 10, 10];]
(* 0.006004 *)
Complement[res1, res2]
(* {{0, 0, 0}} *)
First@AbsoluteTiming[res1 = triplesF[100, 100, 100];]
(* 0.097286 *)
First@AbsoluteTiming[res2 = c[100, 100, 100];]
(* 3.400685 *)
Complement[res1, res2]
(* {{0, 0, 0}} *)
First@AbsoluteTiming[res1 = triplesF[200, 100, 100];]
(* 0.660541 *)
First@AbsoluteTiming[res2 = c[200, 100, 100];]
(* 26.008599 *)
Complement[res1, res2]
(* {{0, 0, 0}} *)
Update 2: Faster version using Join@@Join@@ instead of Partition[Flatten[...],3] (thanks: Mr.Wizard)
triplesFb = Join @@ Join @@ Table[{i, j, k}, {i, 0, #},
{j, 0, If[i == #, #2, i]}, {k, 0, If[i == #, Min[#3, j], j]}] &;
First[AbsoluteTiming[resb = triplesFb[100, 100, 100];]]
(* 0.073053 *)
First[AbsoluteTiming[res1 = triplesF[100, 100, 100];]]
(* 0.094067 *)
resb == res1
(* True *)
{First[AbsoluteTiming[resb = triplesFb[500, 100, 100];]], Length[resb]}
(* {11.780317,20963651} *)
{{0, 0, 0}, {1, 0, 0}, {1, 0, 1}, {1, 1, 0}, {1, 1, 1}}, but {1,0,1} is incorrect
$\endgroup$
Commented
Apr 24, 2015 at 14:06
Join@@ was the first thing I tried; it doesn't give a 2d list. Join@@Join@@Table works.
$\endgroup$
UPDATE
Correcting my misunderstanding:
c[n_, m_, l_] :=
With[{t = Sort@Tuples[Range[0, n], 3],crit = FromDigits[{n, m, l}, n]},
Rest@Pick[t,Reverse@Sort[#] == # && FromDigits[#, n] <= crit & /@ t]]
So using kguler test cases:
Grid[{#, c @@ #, Length[c @@ #]} & /@ {{2, 1, 0}, {2, 2, 0}, {3, 1,
0}, {3, 2, 0}}, Frame -> All]
Original answer
func[n_, m_, l_] :=
Rest@With[{tup = Sort@Tuples[{n, m, l}, 3],
crit = FromDigits[{n, m, l}, n]},
Pick[tup,
Reverse@Sort[#] == # && FromDigits[#, n] <= crit & /@ tup]]
I have removed {0,0,0} with Rest and ordered in increasing order as per example.
Some testing:
Grid[{#, func @@ #} & /@ {{2, 1, 0}, {3, 1, 0}, {4, 3, 2}, {5, 2, 1}},
Dividers -> {{True, True, {False}, True}, {{True}}}]
As FromDigits: $\sum_{j=0}^{\text{Length[d_j]}}d_jb^j$, simply ordering the tuples till element and selecting the elements to the argument and select the elements are non-decreasing yields the same results without needing FromDigits:
g[n_, m_, l_] := Module[{t = Sort@Tuples[{n, m, l}, 3], p},
p = t[[;; Position[t, {n, m, l}][[1, 1]]]];
Rest@Pick[p, Reverse@Sort[#] == # & /@ p]
]
Like this?
func[n_,m_,l_]:=
Cases[
Tuples[{n, m, l}, 3],
{x_, y_, z_} /;
x >= y >= z && FromDigits[{n, m, l}, n] >= FromDigits[{x, y, z}, n]
]
func[2,1,0]
{{2, 1, 0}, {2, 0, 0}, {1, 1, 1}, {1, 1, 0}, {1, 0, 0}, {0, 0, 0}}
