3
$\begingroup$

I am looking for an effective way to generate all lists of non-negative integer numbers $\{k_0,k_1,k_2\dots\} $ such that $$\sum_{i\ge0} k_i=K, \quad\sum_{i\ge0} i k_i=N $$ for given $K$ and $N$. The lists should have equal length $N+1$, corresponding to that of the longest set or end with the last non-zero element.

I would appreciate any hint.

Improve this question
$\endgroup$
1
$\begingroup$

Here is a variation of @kglr's answer that does what I think your looking for:

g[k_, n_] := With[
    {
    p = Catenate @ Map[Permutations] @ PadRight[IntegerPartitions[k, n+1], {Automatic, n+1}]
    },

    Pick[p, p . Range[0, n], n]
]

For example:

g[2,3]
g[3,5]

{{1, 0, 0, 1}, {0, 1, 1, 0}}

{{2, 0, 0, 0, 0, 1}, {0, 2, 0, 1, 0, 0}, {0, 1, 2, 0, 0, 0}, {1, 1, 0, 0, 1, 0}, {1, 0, 1, 1, 0, 0}}

Using Permutations makes it rather brute force, so this may be too slow for you. Also, I used a max length of n+1 instead of k+1, changing this is straightforward.

Improve this answer
$\endgroup$
5
  • $\begingroup$ Thanks. This is indeed what I was looking for. For some unclear reasons I am unable at the moment to upvote or accept answers. As soon as the problem is solved I will be back. If you find out how to avoid Permutations please let me know. $\endgroup$ – drer Feb 25 '18 at 19:40
  • $\begingroup$ Upon checking the code I have found that it fails for $n=1$. It seems that replacement IntegerPartitions[k]$\rightarrow$IntegerPartitions[k,n+1] helps. $\endgroup$ – drer Feb 26 '18 at 8:47
  • $\begingroup$ I could not find a description for the option Automatic for PadRight. Certainly the code does not work without the option. Could you explain how does it work? $\endgroup$ – drer Feb 26 '18 at 8:54
  • $\begingroup$ @drer Yes, I think your suggested change is good. As for PadRight, Automatic means use the existing dimension. $\endgroup$ – Carl Woll Feb 26 '18 at 15:56
  • $\begingroup$ I have found a way to get rid of Permutations. I have posted an answer with the corresponding code. Please take a look at it. I would be very thankful for any suggestions on improving the code, as it looks ugly comparing with those given by experienced Mathematica users. $\endgroup$ – drer Feb 28 '18 at 17:28
2
$\begingroup$ 
ClearAll[f]
f[k_, n_] := Module[{p = PadLeft[Sort /@ IntegerPartitions@k, {Automatic, k + 1}]}, 
  Pick[p, Range[0, k].# & /@ p, n]]

Examples:

 Join @@ Table[{i, #, f[i, #]} & /@ Range[i^2] /. {_, _, {}} -> Sequence[], {i, 2, 6}] // 
 Grid[Prepend[#, {"k", "n", "f[k,n]"}], 
   Dividers -> {All, Thread[{1, 2, 4, 7, 12, 19, 29, -1} -> True]}, 
   Background -> {None, None, {{{2, 3}, {1, -1}} -> LightYellow, 
      {{4, 6}, {1, -1}} -> LightRed, {{7, 11}, {1, -1}} -> LightGreen, 
      {{12, 18}, {1, -1}} -> LightPurple, {{19, -1}, {1, -1}} -> LightBlue}}] &

enter image description here

{10, #, f[10, #]} & /@ Range[10^2] /. {_, _, {}} -> Sequence[] // 
  Grid[Prepend[#, {"k", "n", "f[k,n]"}], Dividers -> All] & // TeXForm

$$\begin{array}{|c|c|c|} \hline \text{k} & \text{n} & \text{f[k,n]} \\ \hline 10 & 55 & \left( \begin{array}{ccccccccccc} 0 & 1 & 1 & 1 & 1 & 1 & 1 & 1 & 1 & 1 & 1 \\ \end{array} \right) \\ \hline 10 & 64 & \left( \begin{array}{ccccccccccc} 0 & 0 & 1 & 1 & 1 & 1 & 1 & 1 & 1 & 1 & 2 \\ \end{array} \right) \\ \hline 10 & 71 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 1 & 1 & 1 & 1 & 1 & 1 & 2 & 2 \\ \end{array} \right) \\ \hline 10 & 72 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 1 & 1 & 1 & 1 & 1 & 1 & 1 & 3 \\ \end{array} \right) \\ \hline 10 & 76 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 1 & 1 & 1 & 1 & 2 & 2 & 2 \\ \end{array} \right) \\ \hline 10 & 78 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 1 & 1 & 1 & 1 & 1 & 2 & 3 \\ \end{array} \right) \\ \hline 10 & 79 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 1 & 1 & 1 & 1 & 1 & 1 & 4 \\ 0 & 0 & 0 & 0 & 0 & 1 & 1 & 2 & 2 & 2 & 2 \\ \end{array} \right) \\ \hline 10 & 80 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 2 & 2 & 2 & 2 & 2 \\ \end{array} \right) \\ \hline 10 & 82 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 1 & 1 & 1 & 2 & 2 & 3 \\ \end{array} \right) \\ \hline 10 & 83 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 1 & 1 & 1 & 1 & 3 & 3 \\ \end{array} \right) \\ \hline 10 & 84 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 1 & 1 & 1 & 1 & 2 & 4 \\ 0 & 0 & 0 & 0 & 0 & 0 & 1 & 2 & 2 & 2 & 3 \\ \end{array} \right) \\ \hline 10 & 85 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 1 & 1 & 1 & 1 & 1 & 5 \\ \end{array} \right) \\ \hline 10 & 86 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 1 & 1 & 2 & 3 & 3 \\ \end{array} \right) \\ \hline 10 & 87 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 1 & 1 & 2 & 2 & 4 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 2 & 2 & 3 & 3 \\ \end{array} \right) \\ \hline 10 & 88 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 1 & 1 & 1 & 3 & 4 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 2 & 2 & 2 & 4 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & 3 & 3 & 3 \\ \end{array} \right) \\ \hline 10 & 89 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 1 & 1 & 1 & 2 & 5 \\ \end{array} \right) \\ \hline 10 & 90 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 1 & 1 & 1 & 1 & 6 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & 2 & 3 & 4 \\ \end{array} \right) \\ \hline 10 & 91 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & 2 & 2 & 5 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & 1 & 4 & 4 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 3 & 3 & 4 \\ \end{array} \right) \\ \hline 10 & 92 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & 1 & 3 & 5 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 2 & 4 & 4 \\ \end{array} \right) \\ \hline 10 & 93 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & 1 & 2 & 6 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 2 & 3 & 5 \\ \end{array} \right) \\ \hline 10 & 94 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & 1 & 1 & 7 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 2 & 2 & 6 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & 4 & 5 \\ \end{array} \right) \\ \hline 10 & 95 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & 3 & 6 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 5 & 5 \\ \end{array} \right) \\ \hline 10 & 96 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & 2 & 7 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 4 & 6 \\ \end{array} \right) \\ \hline 10 & 97 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & 1 & 8 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 3 & 7 \\ \end{array} \right) \\ \hline 10 & 98 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 2 & 8 \\ \end{array} \right) \\ \hline 10 & 99 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & 9 \\ \end{array} \right) \\ \hline 10 & 100 & \left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 10 \\ \end{array} \right) \\ \hline \end{array}$$

Improve this answer
$\endgroup$
8
  • $\begingroup$ Probably I was not precise enough. I need not a single reresentative, but the complete list of the requred sets (lists). Besides I have an impresssion that the first element of your lists corresponds to $i=1$, rather than $i=0$. $\endgroup$ – drer Feb 25 '18 at 12:21
  • $\begingroup$ @drer, changed the index to start from 0. f gives all lists that satisfy the two conditions. $\endgroup$ – kglr Feb 25 '18 at 12:27
  • $\begingroup$ Thank you! It seems to work. The only thing to correct is to allow the value $k_i=0$ as well. $\endgroup$ – drer Feb 25 '18 at 12:53
  • $\begingroup$ Besides it seems that your solutions are subject to condition $k_i\le k_{i+1}$. $\endgroup$ – drer Feb 25 '18 at 13:48
  • 1
    $\begingroup$ @drer, i thought "ordered non-negative integer numbers" meant $k_i \leq k_{i+1}$. $\endgroup$ – kglr Feb 25 '18 at 18:00
2
$\begingroup$

This answer is intended not to present programming skills (rather opposite) or to give a general recipe for generating lists with several constraints, but instead aims on solving the particular problem. The solution should be much more effective than the brute force approach and uses a bijection between integer partitions and the sets (lists) in question.

I have checked two versions:

g1[n_,k_]:=Module[
  {u=Map[Tally] @ IntegerPartitions[n,k],s},
  Table[s=SparseArray[Rule @@ Transpose[u[[i]]],n]//Normal;
  Join[{k-Total[s]},s],{i,Length[u]}]
]

g2[n_,k_]:=Module[
  {u=Map[Tally] @ PadRight[IntegerPartitions[n,k],{Automatic,k}],pos,val},
  Table[{pos,val}=Transpose[u[[i]]];SparseArray[pos+1->val,n+1]//Normal,
  {i,Length[u]}]
]

They both appear to give correct result

g1[5,3]

{{2,0,0,0,0,1},{1,1,0,0,1,0},{1,0,1,1,0,0},{0,2,0,1,0,0},{0,1,2,0,0,0}}

and seem to be equally efficient. I would be very thankful for any suggestions on improving the code.

Improve this answer
$\endgroup$
1
  • $\begingroup$ This looks very good. I think you should make this the accepted answer. $\endgroup$ – Carl Woll Feb 28 '18 at 20:46

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.