6
$\begingroup$

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.

Improve this question
$\endgroup$

2 Answers 2

Reset to default
9
$\begingroup$

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.

Improve this answer
$\endgroup$
2
  • $\begingroup$ I like this answer. Today I learned about the concept of tail-recursion :) $\endgroup$
    – Jacob Akkerboom
    Mar 7, 2013 at 20:16
  • 2
    $\begingroup$ @JacobAkkerboom Thanks. But keep in mind that the above function is not tail-recursive, and besides, tail-recursion in Mathematica has its own peculiarities $\endgroup$
    – Leonid Shifrin
    Mar 7, 2013 at 20:32
4
$\begingroup$

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}} *)
Improve this answer
$\endgroup$

Your Answer

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

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