2010-08-25 12 views
6

Wie Select[Tuples[Range[0, n], d], Total[#] == n &], aber schneller?Aufzählung aller Partitionen in Mathematica

aktualisieren

Hier werden die drei Lösungen und Handlungs ihrer Zeit sind, von Permutationen gefolgt IntegerPartitions scheint am schnellsten zu sein. Timing bei 1, 7, 0,03 für rekursive, FrobeniusSolve und IntegerPartition Lösungen, die jeweils

 
partition[n_, 1] := {{n}}; 
partition[n_, d_] := 
    Flatten[Table[ 
    Map[Join[{k}, #] &, partition[n - k, d - 1]], {k, 0, n}], 1]; 
f[n_, d_, 1] := partition[n, d]; 
f[n_, d_, 2] := FrobeniusSolve[Array[1 &, d], n]; 
f[n_, d_, 3] := 
    Flatten[Permutations /@ IntegerPartitions[n, {d}, Range[0, n]], 1]; 
times = Table[First[Log[Timing[f[n, 8, i]]]], {i, 1, 3}, {n, 3, 8}]; 
Needs["PlotLegends`"]; 
ListLinePlot[times, PlotRange -> All, 
PlotLegend -> {"Recursive", "Frobenius", "IntegerPartitions"}] 
Exp /@ times[[All, 6]] 

Antwort

7

Ihre Funktion:

In[21]:= g[n_, d_] := Select[Tuples[Range[0, n], d], Total[#] == n &] 

In[22]:= Timing[g[15, 4];] 

Out[22]= {0.219, Null} 

Versuchen FrobeniusSolve:

In[23]:= f[n_, d_] := FrobeniusSolve[ConstantArray[1, d], n] 

In[24]:= Timing[f[15, 4];] 

Out[24]= {0.031, Null} 

Die Ergebnisse sind die gleichen:

In[25]:= f[15, 4] == g[15, 4] 

Out[25]= True 

Sie können es machen schneller mit IntegerPartitions, wenn Sie nicht die Ergebnisse in der gleichen Reihenfolge erhalten:

In[43]:= h[n_, d_] := 
Flatten[Permutations /@ IntegerPartitions[n, {d}, Range[0, n]], 1] 

Die sortierten Ergebnisse sind die gleichen:

In[46]:= Sort[h[15, 4]] == Sort[f[15, 4]] 

Out[46]= True 

Es ist viel schneller:

Dank phadej's schnelle Antwort für mich wieder zu schauen.

Hinweis müssen Sie nur den Aufruf von Permutations (und Flatten), wenn Sie tatsächlich die anders bestellt alle Permutationen wollen, dh wenn Sie

In[60]:= h[3, 2] 

Out[60]= {{3, 0}, {0, 3}, {2, 1}, {1, 2}} 

statt

In[60]:= etc[3, 2] 

Out[60]= {{3, 0}, {2, 1}} 
5
partition[n_, 1] := {{n}} 
partition[n_, d_] := Flatten[ Table[ Map[Join[{k}, #] &, partition[n - k, d - 1]], {k, 0, n}], 1] 

Diese wollen ist sogar schneller als FrobeniusSolve :)

Edit: Wenn geschrieben zehn in Haskell, es ist wahrscheinlich klarer, was passiert - auch funktional:

partition n 1 = [[n]] 
partition n d = concat $ map outer [0..n] 
    where outer k = map (k:) $ partition (n-k) (d-1)