3
$\begingroup$

Writing:

nn = 10;

Table[Sum[Length[Select[DeleteDuplicates[Map[Sort, Tuples[
     {1, 2, 5, 10}, i]]], Total[#] == n &]], {i, 1, n}], {n, 1, nn}]

I get:

{1, 2, 2, 3, 4, 5, 6, 7, 8, 11}

which is what I wanted!

Problem: for greater nn the algorithm is too slow and fails to generate the desired vector. Could someone make it leaner?

Thank you!

$\endgroup$
11
$\begingroup$

Looks like you are describing the classic problem of counting the number of ways to make change, given coins of value 1, 2, 5, and 10.

Generating functions can count the ways.

GFCoinPartitions[n_, d_List] := 
   Block[{z}, 
         Coefficient[Series[1/Times @@ (1 - z^d), {z, 0, n}], z, n]
   ]

For your case, the input list of denominations is d={1,2,5,10}, and n is the sum you want. For example,

Table[GFCoinPartitions[i,{1,2,5,10}],{i,1,10}]

{1, 2, 2, 3, 4, 5, 6, 7, 8, 11}

If you really want some speed, then consider SeriesCoefficient.

messyexpression =
   SeriesCoefficient[
      1/((1 - z) (1 - z^2) (1 - z^5) (1 - z^10)),
      {z, 0, n}, Assumptions :> n > 0]

Use this as follows to get counts up to 120.

Round[messyexpression /. n -> Range[1, 120]]

Much, much faster is the rather arcane code below. This gives the first 120 counts in less than a millisecond.

Block[{n = 120, c, t},
   c = ConstantArray[1, n + 1];
   t = c;
   Do[
      Do[t[[Range[i + 1, n + 1]]] += c[[Range[n + 1 - i]]], {i, k, n, k}];
      c = t,
      {k, {2, 5, 10}}];
   c
]
$\endgroup$
  • 2
    $\begingroup$ I am speechless, definitely fantastic! $\endgroup$ – TeM May 17 '18 at 5:54
  • 2
    $\begingroup$ I can suggest an improvement to your first method. Just take the series to degree 120 (or whatever) and the third element, the coefficient list, is the set of values of interest. Handles to 1000 in 0.15 seconds. Still much slower than the mystery method though. $\endgroup$ – Daniel Lichtblau May 17 '18 at 15:19
  • $\begingroup$ Thanks @DanielLichtblau. By the way, the arcane method comes from the discussion of this related question. $\endgroup$ – KennyColnago May 17 '18 at 18:21
  • $\begingroup$ Interesting. I did notice that both methods scale quadratically. There may be a way to improve on that, some flavor of Newton iterations maybe. $\endgroup$ – Daniel Lichtblau May 18 '18 at 2:03
11
$\begingroup$

You could use FrobeniusSolve for this:

Table[
    Length @ FrobeniusSolve[{1,2,5,10}, i],
    {i,10}
]

{1, 2, 2, 3, 4, 5, 6, 7, 8, 11}

Addendum

@Kenny mentioned a SeriesCoefficient approach is also possible, but then showed that an "arcane" Do loop would be much faster if one wanted all values up to some threshold. On the other hand, if one is only interested in a single value, then the "messy" SeriesCoefficient approach would be much faster for large enough $n$. Here is the SeriesCoefficient approach:

messyexpression = SeriesCoefficient[
    1/((1-z) (1-z^2) (1-z^5) (1-z^10)),
    {z,0,n},
    Assumptions:>n>0
];
messyexpression //TeXForm

$\frac{1}{20} \left(\frac{(-1)^{\frac{n}{5}+\frac{7}{5}} \left(-3-(-1)^{2/5}+(-1)^{3/5}\right)}{\left(-1+\sqrt[5]{-1}\right) \left(1+\sqrt[5]{-1}\right)^3 \left(1-\sqrt[5]{-1}+(-1)^{2/5}\right)}+\frac{(-1)^{4/5} \left(-(-1)^{4/5}\right)^n \left(-3-(-1)^{2/5}+(-1)^{3/5}\right)}{\left(-1+\sqrt[5]{-1}\right) \left(1+\sqrt[5]{-1}\right)^3 \left(1-\sqrt[5]{-1}+(-1)^{2/5}\right)}+\frac{(-1)^{\frac{3 n}{5}+\frac{4}{5}} \left(3-\sqrt[5]{-1}+(-1)^{4/5}\right)}{\left(-1+\sqrt[5]{-1}\right) \left(1+\sqrt[5]{-1}\right)^3}-\frac{\left(-(-1)^{2/5}\right)^n \left(3-\sqrt[5]{-1}+(-1)^{4/5}\right)}{\left(-1+\sqrt[5]{-1}\right) \left(1+\sqrt[5]{-1}\right)^3}\right)+\frac{(-1)^n}{10}+\frac{1}{100} \left(\frac{(-1)^{2/5} \left(-\sqrt[5]{-1}\right)^n \left(-17+30 \sqrt[5]{-1}-21 (-1)^{2/5}+21 (-1)^{3/5}\right)}{\left(-1+\sqrt[5]{-1}\right) \left(1+\sqrt[5]{-1}\right)^3 \left(1-\sqrt[5]{-1}+(-1)^{2/5}\right)}+\frac{(-1)^{2 n/5} \left(17-21 \sqrt[5]{-1}+30 (-1)^{2/5}+21 (-1)^{4/5}\right)}{\left(-1+\sqrt[5]{-1}\right) \left(1+\sqrt[5]{-1}\right)^3}-\frac{(-1)^{4/5} \left(-(-1)^{3/5}\right)^n \left(17-21 \sqrt[5]{-1}-30 (-1)^{3/5}+21 (-1)^{4/5}\right)}{\left(-1+\sqrt[5]{-1}\right) \left(1+\sqrt[5]{-1}\right)^3}+\frac{(-1)^{\frac{4 n}{5}+\frac{4}{5}} \left(17+21 (-1)^{2/5}-21 (-1)^{3/5}+30 (-1)^{4/5}\right)}{\left(-1+\sqrt[5]{-1}\right) \left(1+\sqrt[5]{-1}\right)^3 \left(1-\sqrt[5]{-1}+(-1)^{2/5}\right)}\right)+\frac{1}{80} (-1)^n (n+1)+\frac{91 (n+1)}{400}+\frac{7}{200} (n+1) (n+2)+\frac{1}{600} (n+1) (n+2) (n+3)+\frac{1}{10} \left(\frac{(-1)^{2/5} \left(-\sqrt[5]{-1}\right)^n \left(-(-1)^{3/5} n-n+2 (-1)^{4/5}-3 (-1)^{3/5}+3 (-1)^{2/5}-3 \sqrt[5]{-1}\right)}{\left(-1+\sqrt[5]{-1}\right) \left(1+\sqrt[5]{-1}\right)^7 \left(1-\sqrt[5]{-1}+(-1)^{2/5}\right)^3}+\frac{(-1)^{\frac{2 n}{5}+\frac{6}{5}} \left((-1)^{4/5} n-n+3 (-1)^{4/5}+(-1)^{2/5}\right)}{\left(-1+\sqrt[5]{-1}\right)^3 \left(1+\sqrt[5]{-1}\right)^7}-\frac{(-1)^{2/5} \left(-(-1)^{3/5}\right)^n \left((-1)^{4/5} n+(-1)^{3/5} n-\sqrt[5]{-1} n-n+(-1)^{4/5}+(-1)^{3/5}-2 (-1)^{2/5}-2 \sqrt[5]{-1}-2\right)}{\left(-1+\sqrt[5]{-1}\right)^2 \left(1+\sqrt[5]{-1}\right)^7}+\frac{(-1)^{\frac{4 n}{5}+\frac{1}{5}} \left(2 (-1)^{4/5} n-2 (-1)^{2/5} n+\sqrt[5]{-1} n+n+11 (-1)^{4/5}-7 (-1)^{3/5}+5 (-1)^{2/5}-9 \sqrt[5]{-1}+12\right)}{\left(-1+\sqrt[5]{-1}\right)^3 \left(1+\sqrt[5]{-1}\right)^7 \left(1-\sqrt[5]{-1}+(-1)^{2/5}\right)^3}\right)+\frac{21}{50}$

Comparing:

FullSimplify[messyexpression /. n->10^8] //AbsoluteTiming
TimeConstrained[
    Block[{n = 10^8, c, t},
        c = ConstantArray[1, n + 1];
        t = c;
        Do[
            Do[t[[Range[i + 1, n + 1]]] += c[[Range[n + 1 - i]]], {i, k, n, k}];
            c = t,
            {k, {2, 5, 10}}
        ];
        c
    ],
    10
]

{0.190879, 1666667116666705000001}

$Aborted

Moreover, it is possible to simplify messyexpression a bit as follows:

s = FullSimplify[
    Simplify[
        ComplexExpand[Re[messyexpression]] /. s_Sin | s_Cos :> FullSimplify[s]
    ],
    n \[Element] Integers
];
s //TeXForm

$-\frac{-\left(11 \sqrt{5}-25\right) (n+9) \left(2 n (n+18)+15 (-1)^n+97\right)+60 \sqrt{50-22 \sqrt{5}} \sin \left(\frac{\pi n}{5}\right)+\frac{24 \left(\left(160-6 \sqrt{5}\right) n+1271\right) \sin \left(\frac{2 \pi n}{5}\right)}{\sqrt{91325+40822 \sqrt{5}}}+120 \sqrt{1525-682 \sqrt{5}} \sin \left(\frac{3 \pi n}{5}\right)-24 \sqrt{\frac{2}{669125+299231 \sqrt{5}}} \left(2 \left(80+3 \sqrt{5}\right) n+1271\right) \sin \left(\frac{4 \pi n}{5}\right)+60 \left(15-7 \sqrt{5}\right) \cos \left(\frac{\pi n}{5}\right)-24 \left(2 \left(4 \sqrt{5}-9\right) n+79 \sqrt{5}-178\right) \cos \left(\frac{2 \pi n}{5}\right)+120 \left(9 \sqrt{5}-20\right) \cos \left(\frac{3 \pi n}{5}\right)+12 \left(\left(14-6 \sqrt{5}\right) n-73 \sqrt{5}+169\right) \cos \left(\frac{4 \pi n}{5}\right)}{1200 \left(11 \sqrt{5}-25\right)}$

The simplified form is a bit faster to compute:

Simplify[s /. n->10^15] //AbsoluteTiming

{0.0124, 1666666666666711666666666667050000000000001}

$\endgroup$
  • 2
    $\begingroup$ This is a bit faster: Total /@ Table[ Length@IntegerPartitions[n, {i}, {1, 2, 5, 10}], {n, 1, nn}, {i, 1, n}] $\endgroup$ – chuy May 16 '18 at 20:30
  • $\begingroup$ @chuy That's a very good solution. I think you should post that as an answer. $\endgroup$ – Henrik Schumacher May 16 '18 at 20:59
  • $\begingroup$ Thanks so much! $\endgroup$ – TeM May 17 '18 at 5:53
7
$\begingroup$

You can also take advantage of the function IntegerPartitions to avoid the unnecessary overhead of creating all of those tuples only to discard the ones that don't add up to $n$.

Total /@ Table[
  Length@IntegerPartitions[n, {i}, {1, 2, 5, 10}], {n, 1, nn}, {i, 1, 
   n}]

Now this still won't realistically get you up to nn=1000, for example on my machine I can get up to 400 in about 23 seconds. For higher numbers @KennyColnago's solution is definitely the way to go.

$\endgroup$
  • $\begingroup$ Thanks so much! $\endgroup$ – TeM May 17 '18 at 5:53
  • $\begingroup$ The GF method by Kenny is neat, but I think this is the neatest one of the lot. The only change I would suggest is that you should use Total[expr, {2}] instead of Total /@ expr. $\endgroup$ – J. M. will be back soon Sep 25 '18 at 4:09

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.