lshifr
10/6/2015 - 10:22 PM

Creating nested structure from flat, for Mathematica expressions

Creating nested structure from flat, for Mathematica expressions

BeginPackage["Unflatten`"]

Unflatten::usage = "Unflatten[h[elems], posints, heads] creates a nested structure by wrapping

UnflattenNested::usage = "UnflattenNested[expr, {startposlist, endposlist}, head] wraps elements
of expr at positions starting at startposlist_i and ending at endposlist_i in head head";

Begin["`Private`"]

ClearAll[listSplit,reconstructIntervals,groupElements,groupPositions,processPosList,groupElementsNested];

#1@@Take[x,#2]&,
];

reconstructIntervals[listlen_Integer,ints_List]:=
Module[{missed,startint,lastint},
startint = If[ints[[1,1]]==1,{},{1,ints[[1,1]]-1}];
lastint = If[ints[[-1,-1]]==listlen, {},{ints[[-1,-1]]+1,listlen}];
missed =
Map[
If[#[[2,1]]-#[[1,2]]>1,{#[[1,2]]+1,#[[2,1]]-1},{}]&,
Partition[ints,2,1]
];
missed = Join[missed,{lastint}];
Prepend[Flatten[Transpose[{ints,missed}],1],startint]
];

groupElements[
Append[
Sequence
];
allints = reconstructIntervals[Length[lst],poslist];
llist = Map[If[#==={},0,1-Subtract@@#]&,allints];
];

(* To work on general heads, we need this *)

(* If we have a single head *)

groupPositions[plist_List]:=
Reap[Sow[Last[#],{Most[#]}]&/@plist,_,List][[2]];

processPosList::unmtch = "The starting and ending position lists `1` and `2` don't match";
processPosList[{openlist_List,closelist_List}]:=
Module[{opengroup,closegroup,poslist},
{opengroup,closegroup} = groupPositions/@{openlist,closelist};
poslist = Transpose[Transpose[Sort[#]]&/@{opengroup,closegroup}];
If[UnsameQ @@ poslist[[1]],
Message[processPosList::unmtch,openlist,closelist];
{},
(* else *)
Transpose[{poslist[[1,1]],Transpose/@ Transpose[poslist[[2]]]}]
]
];