6
$\begingroup$

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

$\endgroup$
6
$\begingroup$
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} *)
$\endgroup$
  • $\begingroup$ yes, this is just what i wanted $\endgroup$ – science404 Apr 24 '15 at 9:51
  • $\begingroup$ @science404, thank you for the accept. $\endgroup$ – kglr Apr 24 '15 at 11:30
  • $\begingroup$ 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 $\endgroup$ – science404 Apr 24 '15 at 14:06
  • $\begingroup$ @kguler2 sorry for taking away your 'accept'. thanks for all the help, indeed it motivated the now 'accepted' solution! $\endgroup$ – science404 Apr 24 '15 at 14:09
  • 1
    $\begingroup$ @Mr.Wizard, Join@@ was the first thing I tried; it doesn't give a 2d list. Join@@Join@@Table works. $\endgroup$ – kglr Apr 24 '15 at 15:39
3
$\begingroup$

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]

enter image description here

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

enter image description here

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]
  ]
$\endgroup$
  • $\begingroup$ hi this isn't quite what I was looking for, but thanks for putting in your time! $\endgroup$ – science404 Apr 24 '15 at 9:50
  • $\begingroup$ @science404 now I understand from kgulers answer $\endgroup$ – ubpdqn Apr 24 '15 at 10:00
  • $\begingroup$ @science404 I have, I hope, corrected my answer. $\endgroup$ – ubpdqn Apr 24 '15 at 10:23
  • $\begingroup$ great thx for this alternative! $\endgroup$ – science404 Apr 24 '15 at 11:58
1
$\begingroup$

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}}
$\endgroup$
  • $\begingroup$ hey, thanks but this one seems to work for that example. $\endgroup$ – science404 Apr 24 '15 at 9:48

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.