Mathematica: restore arbitrary nested list after Flatten

Question

What is the easiest way to map an arbitrary nested expr list to an unflatten function unflatten that expr==unflatten@@Flatten@expr ?

Motivation: Compile can only process full arrays (something I just found out, but not from the error message), so the idea is to use unflatten along with a compiled version of the smoothed expression:

 fPrivate=Compile[{x,y},Evaluate@Flatten@expr]; f[x_?NumericQ,y_?NumericQ]:=unflatten@@fPrivate[x,y] 

An example of a solution to a less general problem: I really need to calculate all the derivatives for a given multidimensional function to some order. In this case, I make my way like this:

 expr=Table[D[x^2 y+y^3,{{x,y},k}],{k,0,2}]; unflatten=Module[{f,x,y,a,b,sslot,tt}, tt=Table[D[f[x,y],{{x,y},k}],{k,0,2}] /. {Derivative[a_,b_][_][__]-> x[a,b], f[__]-> x[0,0]}; (Evaluate[tt/.MapIndexed[#1->sslot[#2[[1]]]&, Flatten[tt]]/. sslot-> Slot]&) ] Out[1]= {x^2 y + y^3, {2 xy, x^2 + 3 y^2}, {{2 y, 2 x}, {2 x, 6 y}}} Out[2]= {#1, {#2, #3}, {{#4, #5}, {#5, #7}}} & 

It works, but is neither elegant nor general.

Edit: Here is the version of the security solution provided by aaz:

 makeUnflatten[expr_List]:=Module[{i=1}, Function@Evaluate@ReplaceAll[ If[ListQ[#1],Map[#0,#1],i++]&@expr, i_Integer-> Slot[i]]] 

It works:

 In[2]= makeUnflatten[expr] Out[2]= {#1,{#2,#3},{{#4,#5},{#6,#7}}}& 

Answer 1

You obviously need to save some information about the structure of the list, because Flatten[{a,{b,c}}]==Flatten[{{a,b},c}] .

If ArrayQ[expr] , the list structure is specified by Dimensions[expr] , and you can restore it using Partition . For example.

 expr = {{a, b, c}, {d, e, f}}; dimensions = Dimensions[expr] {2,3} unflatten = Fold[Partition, #1, Reverse[Drop[dimensions, 1]]]&; expr == unflatten @ Flatten[expr] 

(The Partition manual page actually has a similar example called unflatten .)

---

If expr not an array, you can try the following:

 expr = {a, {b, c}}; indexes = Module[{i=0}, If[ListQ[#1], Map[#0, #1], ++i]& @expr] {1, {2, 3}} slots = indexes /. {i_Integer -> Slot[i]} {#1, {#2, #3}} unflatten = Function[Release[slots]] {#1, {#2, #3}} & expr == unflatten @@ Flatten[expr] 

Answer 2

I'm not sure what you are trying to do with compilation. It is used when you want to quickly evaluate procedural or functional expressions by numerical values, so I don't think this will help here. If recalculating D [f, ...] hinders your performance, you can precompile and store them with something like Table[d[k]=D[f,{{x,y},k}],{k,0,kk}];

Then just call d [k] to get the kth derivative.

Answer 3

I just wanted to update great solutions from aaz and Janus. It seems that, at least in Mathematica 9.0.1.0 on Mac OSX, the purpose (see Solution aaz)

 {i_Integer -> Slot[i]} 

fails. If, however, we use

 {i_Integer :> Slot[i]} 

instead we succeed. The same applies, of course, to the ReplaceAll call in the Janus version of "job security".

For good measure, I turn on my own function.

 unflatten[ex_List, exOriginal_List] := Module[ {indexes, slots, unflat}, indexes = Module[ {i = 0}, If[ListQ[#1], Map[#0, #1], ++i] &@exOriginal ]; slots = indexes /. {i_Integer :> Slot[i]}; unflat = Function[Release[slots]]; unflat @@ ex ]; (* example *) expr = {a, {b, c}}; expr // Flatten // unflatten[#, expr] & 

It might seem like a cheat to use the original expression in a function, but as aaz points out, we need some information from the original expression. Although you do not need all this to have a single function that can unflatten , all this is necessary.

My application is similar to Janus: I am parallelizing calls on Simplify for a tensor. Using ParallelTable , I can significantly improve performance, but I am destroying the tensor structure in the process. This gives me a quick way to restore my original simplified tensor.