New answers tagged

7

You may use PartitionsP to skip calculating the partitions. This will improve performance "infinity-fold" (in practical terms) for the integer frequency counts on larger numbers. ClearAll[integerPartitionFrequency]; integerPartitionFrequency[number_Integer, int_Integer] := Total@PartitionsP[Range[number - int, 0, -int]] Then compare KeySort@Counts@...


3

Here is a combination of @ciao's suggesting and @yarchik's comment: assoc = <||>; max = 70; step = 10000; Do[assoc = Merge[ {assoc, Counts[Flatten[ IntegerPartitions[max, All, All, {n, Min[n + step - 1, PartitionsP[max]]}]]]}, Total], {n, 1, PartitionsP[max], step}] // AbsoluteTiming (* 66 seconds *) DiscretePlot[assoc[x]...


10

There are 190,569,292 unrestricted integer partitions of 100 (PartitionsP@100). This will need >1gb of RAM just to keep the final result. You can generate them in blocks, e.g., partitions 3000000-3000010: IntegerPartitions[100, All, All, {3000000, 3000010}] In any case, you'll be looking at a long computation. However, if you're just after the tally of ...


3

As an example with m = 5, n = 3, and f[ki][x] the functions in the question, the Sum can be written as m = 5; Sum[KroneckerDelta[m - (k1 + k2 + k3)] Multinomial[k1, k2, k3] f[k1][x] f[k2][x] f[k3][x], {k1, m}, {k2, m}, {k3, m}] (* 90 f[1][x] f[2][x]^2 + 60 f[1][x]^2 f[3][x] *) See the documentation for the definition of Multinomial.


4

Several interpretations that seem to do other than what the OP is asking for resulting in unnecessary code complexity.. This is simply a shuffle-product as stated in OP (the first N of length M shuffled with the remaining M-N of the list.) This uses some code for the SP I did long ago, with a TakeDrop tacked on to provide specification of N per OP. Quite ...


1

You can use Fold to apply patterns repeatedly to cull the list of permutations: list = {1, 2, 3, 4}; patterns = {___, #1, ___, #2, ___} & @@@ Partition[list, 2]; This generates the patterns {{___, 1, ___, 2, ___}, {___, 3, ___, 4, ___}} which can be applied using Fold: Fold[ Cases[#1, #2] &, Permutations[list], patterns ] The meat of the ...


3

n = 5; m = 3; a = Range[n]; left = Subsets[a, {m}]; right = Complement[a, #] & /@ left; perm = MapThread[Join, {left, right}] Permute[a, #] & /@ perm//TableForm Explanation: We prepare first a list of all possible permutations using Subsets and Complement. Subsequently we Join permutations for the left $m$ and right $n-m$ objects and apply ...


6

Working with Kuba's redacted method (which had problems) I came up with this: oP2[list_, groups_] := Module[{idx, ele}, idx = ArrayComponents[ Range @ Length @ list, 1, MapIndexed[Alternatives @@ # -> #2[[1]] &, groups] ]; ele = list[[Ordering @ idx]]; ele[[#]] & /@ Ordering /@ Ordering /@ Permutations @ idx ] It ...


8

I think one should avoid Permutations, because it imposes unnecessarily high complexity. E.g: go[L_, m_] := Normal[SparseArray[Flatten[With[{R = Range[Length[L]]}, MapIndexed[Thread[Thread[{First[#2], Join[#, Complement[R, #]]}] -> L] &, Subsets[R, {m}]]], 1]]] go[{1, 2, 3, 4, 5}, 2]


8

pos = {{1, 2}, {4, 5}}; list = {a, b, c, d, e}; This answer is more general, OP wants to split the list on two parts while I'm allowing not covered elements to be permuted freely, thus unnecessarily complicated. we replace elements in the same group with the same unique symbol e.g {x, x, c, y, y} we take advantage of the fact that Permutations considers ...


1

cp=HankelMatrix[#, RotateRight@#] &; Should perform quite well and returns packed array...


1

At least in version 10.1 under Windows there is a performance problem with yode's Permute solution. For comparison here is his code, Joe's original code, and a variation of my own: fn1[list_] := RotateRight[list, #] & /@ (Range[Length[list]] - 1) fn2 = Permute[#, CyclicGroup[Length@#]] &; fn3[a_] := Array[RotateLeft[a, #]&, Length @ a] The ...


4

Take a look at this function Tuples Tuples[{a, 0}, 3]


0

This approach is quite different from my previous answer. Therefore I decided to separate them for clarity. Let us write first a function that for a given sample returns the probability to obtain it via the random process described in the original post. prob[ncol_, max_, len_, conf_] := Module[{cnt = ConstantArray[max, ncol], ucnt, p = 1}, Do[ ...


7

Per the request,I post my comment as a answer for read First question cy := Permute[#, CyclicGroup[Length@#]] & cy[Range@5] {{1, 2, 3, 4, 5}, {2, 3, 4, 5, 1}, {3, 4, 5, 1, 2}, {4, 5, 1, 2, 3}, {5, 1, 2, 3, 4}} Second question We can use the Complement mentioned by J.M. in his comment.I surppost the order is $5$,Then you can use the method to ...


1

Another approach you might find use in: repWithin[expr_, {heads__} | heads_, rules_] := expr /. foo : Alternatives[heads][__] :> (foo /. rules) Now: repWithin[s[1] + s[3] + s[1, 3], s, permreplacements[3][[2]]] (* out= s[1] + s[2] + s[1, 2] *) repWithin[s[1] + 3 s[2] + k[1, 3], {s, k}, permreplacements[3][[4]]] (* out= k[2, 1] + s[2] + 3 s[3] ...


3

Solution provided by Anton and J.M.: labelstoarguments[expr_, variables_] := With[{ temp = expr /. ((#[idx__Integer] :> # @@ Slot /@ {idx}) & /@ variables) /. ((Subscript[#, idx__Integer] :> Subscript[#, Sequence @@ Slot /@ {idx}]) & /@ variables) }, Function[temp] ] An example usage: labelstoarguments[s[1] + 3 s[2] + k[1,3], {...


10

There is also a newer package, HolonomicFunctions, that has an implementation of Chyzak's generalization of Zeilberger's algorithm. To perform the desired task, use the following commands: smnd = Simplify[ G /. HoldPattern[HypergeometricPFQ[pl_List, ql_List, x_]] :> (Times @@ (Pochhammer[#, k] & /@ pl)) / (Times @@ (Pochhammer[#, k] & /@ ql)...



Top 50 recent answers are included