# List and patterns

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}}.

## 3 Answers

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} *)

• yes, this is just what i wanted – science404 Apr 24 '15 at 9:51
• @science404, thank you for the accept. – kglr Apr 24 '15 at 11:30
• hi, I just noticed that there is slight bug in this solution... it does not return the correct series for [1,1,1], namely it returns {{0, 0, 0}, {1, 0, 0}, {1, 0, 1}, {1, 1, 0}, {1, 1, 1}}, but {1,0,1} is incorrect – science404 Apr 24 '15 at 14:06
• @kguler2 sorry for taking away your 'accept'. thanks for all the help, indeed it motivated the now 'accepted' solution! – science404 Apr 24 '15 at 14:09
• @Mr.Wizard, Join@@ was the first thing I tried; it doesn't give a 2d list. Join@@Join@@Table works. – kglr Apr 24 '15 at 15:39

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]
]

• hi this isn't quite what I was looking for, but thanks for putting in your time! – science404 Apr 24 '15 at 9:50
• @science404 now I understand from kgulers answer – ubpdqn Apr 24 '15 at 10:00
• @science404 I have, I hope, corrected my answer. – ubpdqn Apr 24 '15 at 10:23
• great thx for this alternative! – science404 Apr 24 '15 at 11:58

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}}

• hey, thanks but this one seems to work for that example. – science404 Apr 24 '15 at 9:48