2
$\begingroup$

I've been trying to write a function toTriangle which converts a given integer to a triangular array. For example:

toTriangle(123456)     = {{1, 2, 3}, {4, 5}, {6}}
toTriangle(1010101010) = {{1, 0, 1, 0}, {1, 0, 1}, {0, 1}, {0}}

and so on. Naturally, this only works if the number of digits of the integer n is a triangular number. (that is, if $n = m(m+1)/2$ for some $m\in\mathbb N$.

I have written the following to try and implement this:

toTriangle := Function[n,
    len := 1/2 (Sqrt[1 + 8 IntegerLength[n]] - 1);
    digits := IntegerDigits[n];
    triangle = {};
    For[i = 0, i < len; i++,
     AppendTo[triangle, Take[digits, n - i]];
     digits = Drop[digits, n - i];
    ];
    triangle
  ];

I have tried dry running the code bit by bit, and I noticed that it was the Take[] function which was causing the hassle; I suspect that you cannot give it a variable argument in position 2:

Take::seqs: Sequence specification (+n, -n, {+n}, {-n}, {m, n}, or {m, n, s}) expected at position 2 in Take[{1,2,3,4,5,6},i]. >>

The same exact code I tested worked if I substituted i with some number. (directly, not by doing /. i->3). Can someone help me with this?

$\endgroup$
  • 1
    $\begingroup$ Some comments: You define global variables inside your function, consider using Module. Is there any reason to define a pure function rather than toTriangle[n_]:=...? AppendTo and For are not "Mathematica like", you might want to try to bring the function into a more functional form $\endgroup$ – Lukas Lang Sep 18 '17 at 21:36
  • $\begingroup$ Somewhat related: (29425), (55659), (56446) $\endgroup$ – Mr.Wizard Sep 18 '17 at 22:23
3
$\begingroup$

Your issue is that you use n instead of len inside Take and Drop:

toTriangle := 
  Function[n,
   len := 1/2 (Sqrt[1 + 8 IntegerLength[n]] - 1); 
   digits := IntegerDigits[n];
   triangle = {}; 
   For[i = 0, i < len, i++,
    AppendTo[triangle, Take[digits, len - i]];
    digits = Drop[digits, len - i];
   ];
   triangle
  ];

toTriangle[123456]
(* {{1, 2, 3}, {4, 5}, {6}} *)

For a solution that is more functional, see @kglr's solution.

$\endgroup$
  • $\begingroup$ You're right, but even when I switch it to len it renders { } as an output. $\endgroup$ – Luke Collins Sep 18 '17 at 21:42
  • $\begingroup$ The code you posted above also has a ; instead of a , after i++. I didn't say anything because I assumed that was a typo of this version (given that the errors you show only occur when you put the , there) $\endgroup$ – Lukas Lang Sep 18 '17 at 21:44
  • $\begingroup$ Sorted - can't believe my mistake was a ;. Thanks. $\endgroup$ – Luke Collins Sep 18 '17 at 21:51
3
$\begingroup$
ClearAll[toTriangleF]
toTriangleF = TakeList[IntegerDigits @ #, 
   Reverse @ Range[(Sqrt[1 + 8 IntegerLength @ #] - 1)/2]] &;


toTriangleF /@ {123456, 1010101010}

{{{1, 2, 3}, {4, 5}, {6}}, {{1, 0, 1, 0}, {1, 0, 1}, {0, 1}, {0}}}

$\endgroup$
  • $\begingroup$ Is there a way to do this without TakeLists? I'm using version 10. $\endgroup$ – Luke Collins Sep 18 '17 at 21:45
  • $\begingroup$ @LukeCollins, you can use Internal`PartitionRagged in place of TakeList. $\endgroup$ – kglr Sep 19 '17 at 4:05
3
$\begingroup$

[Edit: It seems aardvark2012 beat me by 2 minutes using this exact approach - I'll leave this here for the moment as the explanation (although probably confusing) is more detailed in this answer]

Another solution without TakeLists, as requested:

toTriangle = Function[n, 
 First /@ Rest@
  FoldList[
   TakeDrop[#[[2]], #2] &,
   {{}, IntegerDigits@n}, 
   Reverse@Range[(Sqrt[1 + 8 IntegerLength@n] - 1)/2]]
]

This works the following way:

  • The function inside FoldList gets two arguments each time: The result from the previous step (starting with {{}, IntegerDigits@n}) and a number specifying how many elements to take off. The number comes from the list built by Reverse@Range[(Sqrt[1 + 8 IntegerLength@n] - 1)/2]]
  • The function, TakeDrop[#[[2]], #2] &, takes the second part of the first argument (which contains the remaining digits) and splits off the number specified by #2.
  • After finishing the iteration, we drop the first element (which is {{}, IntegerDigits@n}), and take the first part of each of the remaining pairs. (Which is the part Taken by TakeDrop in each iteration)
$\endgroup$
2
$\begingroup$

How about:

toTriangle[n_] := Module[{d = Sqrt[1 + 8 IntegerLength[n]]-1},
    TakeList[IntegerDigits[n], Range[d/2, 1, -1]] /; IntegerQ[d]
]

If you have M11.1-, then use Internal`PartitionRagged instead of TakeList.

$\endgroup$
  • $\begingroup$ Is there a way to do this without TakeLists? I'm using version 10. $\endgroup$ – Luke Collins Sep 18 '17 at 21:45
2
$\begingroup$

For what it's worth, using my partitionBy from Partitioning with varying partition size:

list = {a, b, c, d, e, f, g, h, i, j};

partitionBy[Reverse@list, # &] ~Reverse~ {1, 2}
{{a, b, c, d}, {e, f, g}, {h, i}, {j}}
$\endgroup$
2
$\begingroup$

@Mathe172's version seems to be a more direct way to improve your code. But in the interests of not using For, here are some possibilities that work on v10.4.

All of them are based on FoldList. The first uses TakeDrop to split the integer digits into the desired sublist and the remainder that will be subdivided further:

toTriangle1[n_] := 
 Module[{len = 1/2 (Sqrt[1 + 8 IntegerLength[n]] - 1)}, 
  FoldList[TakeDrop[#1[[-1]], #2] &, {IntegerDigits[n]}, 
    Range[len, 1, -1]][[2 ;;, 1]]
  ]

The second modifies this with Reap and a kind of SowDrop function inside FoldList:

toTriangle2[n_] := 
 Module[{len = 1/2 (Sqrt[1 + 8 IntegerLength[n]] - 1)},
  Reap[FoldList[(Sow[#1[[1 ;; #2]]]; Drop[#1, #2]) &, IntegerDigits@n,
      Reverse@Range[len]]][[-1, 1]]
  ]

The third calculates the index ranges for each sublist and then uses Part ([[ ]]) to extract them:

toTriangle3[n_] := 
 Module[{len = 1/2 (Sqrt[1 + 8 IntegerLength[n]] - 1), 
   listn = IntegerDigits[n]},
  listn[[#[[1]] ;; #[[2]]]] & /@ 
   Transpose[{Most[#], Rest[#] - 1} &@
     FoldList[#1 + #2 &, 1, Reverse@Range[len]]]
  ]

All of which give

toTriangle1 /@ {123456, 1010101010}
toTriangle2 /@ {123456, 1010101010}
toTriangle3 /@ {123456, 1010101010}

(* {{{1, 2, 3}, {4, 5}, {6}}, 
    {{1, 0, 1, 0}, {1, 0, 1}, {0, 1}, {0}}} *)
$\endgroup$
1
$\begingroup$

Using some undocumented functionality:

toTriangle[n_Integer] := Module[{l = IntegerLength[n]},
  MapIndexed[Drop[#, First[#2]] &, Most[
             Statistics`Library`VectorToUpperTriangularMatrix[IntegerDigits[n],
                                                              0, (Sqrt[8 l + 1] + 1)/2]]]]

For example,

toTriangle[1010101010]
   {{1, 0, 1, 0}, {1, 0, 1}, {0, 1}, {0}}
$\endgroup$

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.