Mathematica:在Flatten之后重建一个任意嵌套列表

Jan*_*nus 8 wolfram-mathematica

将任意时髦的嵌套列表映射expr到函数的最简单方法unflattenexpr==unflatten@@Flatten@expr什么?

动机: Compile只能处理完整的数组(我刚刚学到的东西 - 但不是来自错误信息),所以我的想法是unflatten与flattened表达式的编译版本一起使用:

fPrivate=Compile[{x,y},Evaluate@Flatten@expr];
f[x_?NumericQ,y_?NumericQ]:=unflatten@@fPrivate[x,y] 
Run Code Online (Sandbox Code Playgroud)

针对不太普遍的问题的解决方案的示例: 我实际需要做的是计算给定多变量函数的所有导数,直到某个顺序.在这种情况下,我像这样破解我的方式:

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 x y, x^2 + 3 y^2}, {{2 y, 2 x}, {2 x, 6 y}}}
Out[2]= {#1, {#2, #3}, {{#4, #5}, {#5, #7}}} &
Run Code Online (Sandbox Code Playgroud)

这有效,但既不优雅也不一般.

编辑:这是aaz提供的解决方案的"工作安全"版本:

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

它有魅力:

In[2]= makeUnflatten[expr]
Out[2]= {#1,{#2,#3},{{#4,#5},{#6,#7}}}&
Run Code Online (Sandbox Code Playgroud)

aaz*_*aaz 6

你显然需要保存一些关于列表结构的信息,因为Flatten[{a,{b,c}}]==Flatten[{{a,b},c}].

如果ArrayQ[expr],则列表结构由Dimensions[expr]您给出,您可以使用它重建它Partition.例如

expr = {{a, b, c}, {d, e, f}};
dimensions = Dimensions[expr]

  {2,3}

unflatten = Fold[Partition, #1, Reverse[Drop[dimensions, 1]]]&;
expr == unflatten @ Flatten[expr]
Run Code Online (Sandbox Code Playgroud)

(该Partition手册页实际上有一个类似的例子unflatten.)


如果expr不是数组,您可以尝试这样做:

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]
Run Code Online (Sandbox Code Playgroud)