10
$\begingroup$

Is there any concise syntax for the following partitioning of a list. Given {1, 2, 3, 4}, I want to get the output as shown below. I have tried various function such as Partition and others, but I couldn't get the result I want.

{1} {2, 3, 4, 5}
{1, 2} {3, 4, 5}
{1, 2, 3} {4, 5}
{1, 2, 3, 4} {5}
$\endgroup$
  • $\begingroup$ I don't think there is a built-in function that does this, as this question as appeared before (but don't have time to find link right now). You can define a function that does the job like so: splits[list_] := Table[{Take[list, n], Drop[list, n]}, {n, Length[list] - 1}] $\endgroup$ – Marius Ladegård Meyer Jul 15 '17 at 11:16
  • $\begingroup$ Related: (5305), (8528), (32404), (37869) $\endgroup$ – Mr.Wizard Jul 17 '17 at 6:14
18
$\begingroup$
Li = Range[5];
TakeDrop[Li, #] & /@ Range[Length[Li]-1] // Column[Row/@#]&

or, slightly shorter,

i = 1; TakeDrop[Li, i++] & /@ Most[Li] // Column[Row/@#]&

or, using just Range and organizing the result with Transpose:

Transpose[{Range[Range[4]], Range[1 + Range[4], 5]}] // Column[Row/@#]&

enter image description here

For an arbitrary list of size 5, say, lst = {w, v, x, y, z},

lst[[#]] & /@ # & /@ Transpose[{Range[Range[4]], Range[1 + Range[4], 5]}] // format  

enter image description here

A few more alternatives:

ClearAll[f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, ☺]
f1 = Module[{i = 1, lst = #},  TakeDrop[lst, i++] & /@ Rest[lst]] &;
f2 = Module[{lst = #},  TakeDrop[lst, #] & /@ Range[Length[lst] - 1]] &;
f3 = Table[Partition[#, Length@#, 1, {-1, 1}, {}][[{i, i + Length@#}]], {i, Length@# - 1}]&
f4 = Module[{lst = #, l = Length@# - 1}, lst[[#]] & /@ # & /@ 
      Transpose[{Range[Range[l]], Range[1 + Range[l], l + 1]}]] &;
f5 = Module[{lst = #, r = Range[Length[#] - 1], l = Length@#, parts}, 
      parts =Transpose[{Range[r], Range[1 + r, l]}]; Extract[lst, List/@ #] &/@ parts]&;
f6 = Function[{x}, Most@MapIndexed[{x[[;; #2[[1]]]], x[[1 + #2[[1]] ;;]]} &, x]];
f7 = Table[Values@GroupBy[MapIndexed[{#2[[1]], #} &, #], First[#] <= i &, Last /@ # &], 
      {i, Length[#] - 1}] &;
f8 = Rest@NestList[{Join[#[[1]], {#[[-1, 1]]}], #[[-1, 2 ;;]]} &, {{}, #}, Length@# - 1] &;
f9 = Module[{lst = #},  
      Function[k, Module[{t = 0}, Split[lst, ++t <= k || (t = -Length@lst) &]]] /@
       Range[0, Length[lst] - 2]] &;

f10 = ReplaceList[#, {x__, y__} -> {{x}, {y}}] &; (* one word ? *)

☺ = ♯♯  (♯ = 1; {♯♯[[;; ♯]], ♯♯[[++♯ ;;]]} & /@ {##2 & @@♯♯}); (* no words:)*)

and, for formatting the outputs of the functions above

format = Column[Row /@ #] &; 

Examples:

f1 @ Li // format

enter image description here

Equal @@ Through[{f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, ☺} @Range[4]]

True

f1 @ {a,b,a,c,d,b} // format

enter image description here

Equal @@ Through[{f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, ☺} @ {a,b,a,c,d,b}]

True

Notes: I learned about the Or trick in f9 from this answer by Mr.Wizard. See also this answer by Simon Woods.

$\endgroup$
  • $\begingroup$ Those in code always make me laugh $\endgroup$ – yode Jul 15 '17 at 15:29
  • 2
    $\begingroup$ @yode, that's an intended side effect:) $\endgroup$ – kglr Jul 15 '17 at 15:37
  • $\begingroup$ @kglr very nice. can you kindly explain f3 especially how the Partition is behaving here with all these arguments. I looked at the document but could not understand much from there $\endgroup$ – Ali Hashmi Jul 16 '17 at 12:46
  • $\begingroup$ @Ali, from my reading of the docs: Partition[list,n,d,{Subscript[k, L],Subscript[k, R]}] specifies that the first element of list should appear at position Subscript[k, L] in the first sublist, and the last element of list should appear at or after position Subscript[k, R] in the last sublist. If additional elements are needed, Partition fills them in by treating list as cyclic. It is easier to see what this means inspecting Partition[Range[5], 5, 1, {-1, 1}, x] playing with different values for the two numbers. Using {} instead of x gives a ragged partition. $\endgroup$ – kglr Jul 16 '17 at 13:04
  • $\begingroup$ ... also: the setting {-1,1} allow maximal overhangs at both beginning and end $\endgroup$ – kglr Jul 16 '17 at 13:05
13
$\begingroup$

This is literally the canonical example from the ReplaceList documentation:

ReplaceList[{a, b, c, d, e, f}, {x__, y__} -> {{x}, {y}}]

{{{a}, {b, c, d, e, f}}, {{a, b}, {c, d, e, f}}, {{a, b, c}, {d, e, f}}, {{a, b, c, d}, {e, f}}, {{a, b, c, d, e}, {f}}}

enter image description here

$\endgroup$
  • $\begingroup$ This should be the accepted answer. $\endgroup$ – Anton Antonov Jul 17 '17 at 12:30
  • 1
    $\begingroup$ @Anton & Mr.Wizard, this is f10 in my answer; has been there since the second edit:) $\endgroup$ – kglr Jul 17 '17 at 14:30
  • $\begingroup$ @kglr Ahh, yes! (+1 on your answer then.) $\endgroup$ – Anton Antonov Jul 17 '17 at 15:03
  • 1
    $\begingroup$ @kglr I did of course already vote for your answer. However I felt that this method and its prominence in the documentation was not given sufficient exposure, as evidenced by Anton's overlooking it earlier. In the past I would often write the omnibus answer with every method I could think of, as you did here, but a simple and to-the-point answer is a good complement for that. $\endgroup$ – Mr.Wizard Jul 17 '17 at 19:46
8
$\begingroup$
Li = Range[5];

groups = Table[GatherBy[Li, # <= n &], {n, 4}]

(*  {{{1}, {2, 3, 4, 5}}, {{1, 2}, {3, 4, 5}}, {{1, 2, 3}, {4, 5}}, {{1, 2, 3, 
   4}, {5}}}  *)

To display this as shown in your question

Column[StringJoin /@ Map[ToString, groups, {2}]]

enter image description here

EDIT: Or more generally,

Li = {a, c, b, e, d};

groups = Table[
  GatherBy[Li, Position[Li, #][[1, 1]] <= n &],
  {n, Length[Li] - 1}]

(*  {{{a}, {c, b, e, d}}, {{a, c}, {b, e, d}}, {{a, c, b}, {e, d}}, {{a, c, b, 
   e}, {d}}}  *)

Column[StringJoin /@ Map[ToString, groups, {2}]]

enter image description here

$\endgroup$
4
$\begingroup$

So far only Bob Hanlon's answer adheres to the form required in the question.

Here is another answer producing that form:

Li = Range[5]
ColumnForm@Map[StringReplacePart[ToString[Li], "}{", #] &, 
 StringPosition[ToString[Li], ", "]]

enter image description here

$\endgroup$
1
$\begingroup$

Suppose you don't mind the order

Li = {1, 2, 3, 4, 5};
TakeDrop[Li, #] & @@@ Catenate[Permutations /@ IntegerPartitions[5, {2}]] // Column

$\endgroup$
1
$\begingroup$
n = 5;

tra = Transpose[{
   Most@Partition[Range@n, n, 1, {-1}, {}],
   Rest@Partition[Range@n, n, 1, {+1}, {}]}];

Row /@ tra // Column

enter image description here

$\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.