Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I'm pretty new to Mathematica and am trying to learn to solve problems in a functional way. The problem I was solving was to list the ways in which I could sum elements from a list (with repetitions), so the sum is less-than-or-equal to some value. The code below solves my problem just fine.

i = {7.25, 7.75, 15, 19, 22};
m = 22;
getSum[l_List, n_List] := Total[Thread[{l, n}] /. {x_, y_} -> x y];
t = Prepend[Map[Range[0, Floor[m/#]] &, i], List];
Outer @@ %;
Flatten[%, ArrayDepth[%] - 2];
Map[{#, getSum[i, #]} &, %];
DeleteCases[%, {_, x_} /; x > m || x == 0];
TableForm[Flatten /@ SortBy[%, Last], 0, TableHeadings -> {None, Append[i, "Total"]}]

However, the code checks a lot of unneccesary cases, which could be a problem if m is bigger or the list is longer. My question is simply: what would be the most Mathematica-esque way to solve this problem with regard to both efficiency and code elegance.

share|improve this question

2 Answers 2

Here is a solution based on linked lists and recursion:

ClearAll[toLinkedList];
toLinkedList[x_List] := Fold[{#2, #1} &, {}, Reverse@x];

ClearAll[getCombs];
getCombs[l_List, lim_Integer] :=
  Cases[
    getCombs[{}, toLinkedList[Reverse@Sort@l], lim],
    getCombs[acc : Except[{}], __] :> Flatten[acc],
    Infinity
  ];
getCombs[accum_, l : {head_, tail_List}, lim_?Positive] :=
  {
     If[lim >= head, getCombs[{accum, head}, l, lim - head], Sequence @@ {}],
     getCombs[accum, tail, lim]
  };

The way it works is to create a tree by going backwards, subtracting a given element from the current maximal for the sum, to get the maximal for the sums of remaining elements. The case of repetitions is accounted for by the line If[lim>=head,...]. The resulting numbers are also accumulated in linked lists (accum parameter), and finally they are found with Cases and converted back to normal lists using Flatten. In this way, we avoid unnecessary array copying, so this code should be reasonably efficient.

Here is an example of use:

i = {7.25, 7.75, 15, 19, 22};
m = 22;

getCombs[i, m]

(* 
   {{22}, {19}, {15}, {7.75, 7.75}, {7.75, 7.25}, {7.75}, 
   {7.25, 7.25, 7.25}, {7.25, 7.25}, {7.25}} 
*)

Note that I did not make an effort to make this function tail-recursive, which possibly can be achieved with some more work. Note also that I did not attempt to optimize the algorithm further, which is probably possible too.

share|improve this answer
    
I like this answer. Today I learned about the concept of tail-recursion :) –  Jacob Akkerboom Mar 7 '13 at 20:16
    
@JacobAkkerboom Thanks. But keep in mind that the above function is not tail-recursive, and besides, tail-recursion in Mathematica has its own peculiarities –  Leonid Shifrin Mar 7 '13 at 20:32

As it is a knapsack problem you could use integer linear programming. The Reduce function is applicable for this task.

Here we set up the parameter values and constraints.

lens = {7.25, 7.75, 15, 19, 22};
max = 22;
coeffs = Array[v, Length[lens]];
c1 = Map[# >= 0 &, coeffs];
c2 = Total[coeffs] >= 1;
c3 = coeffs.Rationalize[lens] <= max;

Now solve and sort by values of objective.

solns = coeffs /. {ToRules[
     Reduce[Join[c1, {c2, c3}], coeffs, Integers]]};
SortBy[solns, #.lens &]

(* {{1, 0, 0, 0, 0}, {0, 1, 0, 0, 0}, {2, 0, 0, 0, 0}, {0, 0, 1, 0, 
  0}, {1, 1, 0, 0, 0}, {0, 2, 0, 0, 0}, {0, 0, 0, 1, 0}, {3, 0, 0, 0, 
  0}, {0, 0, 0, 0, 1}} *)
share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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