2011-02-15 83 views
8

将任意时髦的嵌套列表expr映射到函数unflatten以便[email protected]@[email protected]的最简单方法是什么?Mathematica:在拼合之后重建任意的嵌套列表

动机: Compile只能处理全阵列(这是我刚刚学会 - 但不是从错误信息),这样的想法是与扁平式的编译版本一起使用unflatten

fPrivate=Compile[{x,y},[email protected]@expr]; 
f[x_?NumericQ,y_?NumericQ]:[email protected]@fPrivate[x,y] 

解决一个少一般问题的例子: 我真正需要做的是计算所有衍生品对于给定的多元函数达到某种秩序。对于这种情况,我按照如下方式破解了我的方式:

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}}} & 

这样的工作,但它既不优雅也不普遍。

编辑:这里是AAZ提供的解决方案中的“就业保障”的版本:

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

它的工作原理魅力:

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

我没有测试它,但狮子座希夫林的修改`rearrangeAs`可能工作http://stackoverflow.com/questions/4811082/applying-transformation-of-gatherby-to-a-different-list/4811794# 4811794 – 2011-02-15 08:05:02

+0

谢谢,雅罗斯拉夫:这当然看起来相关 - 但有点难以理解:)。我最终做了一件我自己的事情,如果没有人咬我就会发布......总是有同样的故事:1)为你解决特定情况的问题,2)认识到一个更普遍的解决方案可能很有趣,3)避免浪费时间在切线上,把它张贴在SO上,让别人去做你的切线工作,4)自己去做。叹息 – Janus 2011-02-15 08:49:11

+0

这个问题似乎相关http://stackoverflow.com/questions/3807976/inverse-of-flatten-in-mathematica – dbjohn 2011-02-15 12:15:11

回答

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] 

(该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] 
1

我不知道你在想什么与编译有关。当你想用数值非常快速地评估程序或函数表达式时使用它,所以我认为这不会对此有所帮助。如果重复计算D [f,...]妨碍了你的性能,你可以预先计算并存储它们,例如: Table[d[k]=D[f,{{x,y},k}],{k,0,kk}];

然后,只需调用d [k]来获得第k个导数。

1

我只是想更新aaz和Janus的优秀解决方案。看来,至少在Mac OSX上的Mathematica 9.0.1.0中,赋值(参见aaz的解决方案)

{i_Integer -> Slot[i]} 

失败。但是,如果我们使用

{i_Integer :> Slot[i]} 

取而代之的是,我们成功了。当然,在Janus的“工作安全”版本中调用ReplaceAll也是一样。

对于好的措施,我包括我自己的功能。

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] & 

这似乎有点像作弊使用的功能的原始表达式,但AAZ指出的,我们需要从原来的表情有些信息。虽然你不需要它全部,为了有一个功能,可以unflatten,都是必要的。

我的申请与Janus's相似:我正在调用Simplify来调用张量。使用ParallelTable我可以显着提高性能,但是我在此过程中破坏了张量结构。这给我一个快速的方法来重建我的原始张量,简化。