2011-02-15 75 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我可以顯着提高性能,但是我在此過程中破壞了張量結構。這給我一個快速的方法來重建我的原始張量,簡化。