Converting integer to a triangular array

Question

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?

Answer 1

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.

Answer 2

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

Answer 3

[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)

Answer 4

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.

Answer 5

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

Answer 6

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

Answer 7

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