"Unflattening" a list

Edit

As described here, the solution below leaks symbols in the global namespace. This can be prevented by using this shorter equivalent:

unflatten[l_, o_] := Module[{i = 1, l1 = Flatten[l]},
  Function[Null, l1[[i++]], {Listable}][o]
]

Original

You can unflatten every list with the same number of elements as long as you still have your original list. When you really overwrite your original list with its flattened version, then the structure is lost forever.

Let me give an alternative approach which should work with all kinds of elements. Additionally, this function might have a nerdy touch, because it is not quite obvious why it does what it does

unflatten[l_, o_] := Module[{f, i = 1, l1 = Flatten[l]},
  Attributes[f] = {Listable}; f[_] := l1[[i++]]; f[o]]

When we now take a somehow deeply structured list orig, we can restructure the list {1,2,3,4} in exactly the same way

orig = {{{}, {Exp[1]}, 3, {{{{a}}}, c}}};
unflatten[Range[4], orig]

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

Spoiler alert

OK, to give some hints: Above we want to structure the list l exactly the same way as o. The function f doesn't really do something. Every time it is called with any argument, it returns the next element from the list l by using the counter i. The important thing is, that f has the attribute Listable which makes that it is first distributed to all elements in the list, no matter how deeply they are nested. If f finally meets a list element, it returns the replacement element and the list structure is preserved. Therefore, the whole approach works because Listable functions return the same list structure as their arguments and the order in which the elements are visited is the correct one.


I faced the same problem a while ago. Here's my initial code:

copyPartition[A_, B_] := Module[{i = 0}, Map[A[[++i]]&,B,{-1}]]  

It works fine most of the time:

A = {a,b,c,d,e,f,g,h,i};  
B = {1, {2, 3}, {4, {5}, 6}, {7, {{8}, {9}}}};  
copyPartition[A,B]
(*  {a, {b, c}, {d, {e}, f}, {g, {{h}, {i}}}} *)

But change the i in A to i$:

A = {a,b,c,d,e,f,g,h,i$};
copyPartition[A,B]
(*  {a, {b, c}, {d, {e}, f}, {g, {{h}, {8}}}} *)

The i$ got evaluated -- a situation that's not likely to occur in practice, but I still didn't like it.
My solution was to do everything twice:

copyPartishun[A_, B_] := Map[A[[#]]&, Block[{i = 0}, Map[++i&,B,{-1}]], {-1}]

That solves the problem, but it's slow, so I asked in Mathgroup.
The best answer was from J. Siehler:

partitionedAz[A_, B_] := ReplacePart[B, A, Position[B,_,{-1},Heads->False],
                                     Transpose@{Range@Length@Flatten@B}]

Internal`CopyListStructure

Examples:

orig = {{{}, {Exp[1]}, 3, {{{{a}}}, c}}};

Internal`CopyListStructure[orig, Range[4]]
{{{}, {1}, 2, {{{{3}}}, 4}}}
list = {{{2, 3}, {2, 4}}, {{{3, 4}}}, {{5, 6}, {7, 8}}};
list1 = Flatten[list, 1];
list1[[1]] = {2, 8};

Internal`CopyListStructure[list, Flatten@list1]
 {{{2, 8}, {2, 4}}, {{{3, 4}}}, {{5, 6}, {7, 8}}}