перечисление всех разделов в Mathematica
Как Выберите [Кортежи [Диапазон [0, n], d], Всего [#] == n &] , но быстрее?
Обновление
Вот 3 решения и график их времени, IntegerPartitions, за которым следуют перестановки, кажутся самыми быстрыми. Сроки 1, 7, 0,03 для рекурсивных решений, решений FrobeniusSolve и IntegerPartition соответственно
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]]
2 ответа
Ваша функция:
In[21]:= g[n_, d_] := Select[Tuples[Range[0, n], d], Total[#] == n &]
In[22]:= Timing[g[15, 4];]
Out[22]= {0.219, Null}
Попробуйте FrobeniusSolve:
In[23]:= f[n_, d_] := FrobeniusSolve[ConstantArray[1, d], n]
In[24]:= Timing[f[15, 4];]
Out[24]= {0.031, Null}
Результаты такие же:
In[25]:= f[15, 4] == g[15, 4]
Out[25]= True
Вы можете сделать это быстрее с помощью IntegerPartitions , хотя вы не получаете результаты в том же порядке:
In[43]:= h[n_, d_] :=
Flatten[Permutations /@ IntegerPartitions[n, {d}, Range[0, n]], 1]
Отсортированные результаты такие же:
In[46]:= Sort[h[15, 4]] == Sort[f[15, 4]]
Out[46]= True
Это намного быстрее:
In[59]:= {Timing[h[15, 4];], Timing[h[23, 5];]}
Out[59]= {{0., Null}, {0., Null}}
Спасибо phadej за быстрый ответ, который заставил меня посмотреть еще раз.
Обратите внимание, что вызов Permutations (и Flatten) нужен только в том случае, если вам действительно нужны все перестановки в другом порядке, т.е. если вы хотите
In[60]:= h[3, 2]
Out[60]= {{3, 0}, {0, 3}, {2, 1}, {1, 2}}
вместо
In[60]:= etc[3, 2]
Out[60]= {{3, 0}, {2, 1}}
partition[n_, 1] := {{n}}
partition[n_, d_] := Flatten[ Table[ Map[Join[{k}, #] &, partition[n - k, d - 1]], {k, 0, n}], 1]
Это даже быстрее, чем FrobeniusSolve :)
Edit: Если написано на Haskell, вероятно, будет понятнее, что происходит - также функционально:
partition n 1 = [[n]]
partition n d = concat $ map outer [0..n]
where outer k = map (k:) $ partition (n-k) (d-1)