4
$\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!

Improve this question
$\endgroup$

3 Answers 3

Reset to default
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
]
Improve this answer
$\endgroup$
3
  • 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
    Commented May 17, 2018 at 15:19
  • $\begingroup$ Thanks @DanielLichtblau. By the way, the arcane method comes from the discussion of this related question. $\endgroup$
    – KennyColnago
    Commented May 17, 2018 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
    Commented May 18, 2018 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}

Improve this answer
$\endgroup$
2
  • 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
    Commented May 16, 2018 at 20:30
  • $\begingroup$ @chuy That's a very good solution. I think you should post that as an answer. $\endgroup$
    – Henrik Schumacher
    Commented May 16, 2018 at 20:59
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.

Improve this answer
$\endgroup$
1
  • $\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.'s missing motivation ♦
    Commented Sep 25, 2018 at 4:09

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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