Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1995
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1995

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Puzzle

  • To: mathgroup at smc.vnet.net
  • Subject: [mg2284] Re: Puzzle
  • From: wagner at goober.cs.colorado.edu (Dave Wagner)
  • Date: Mon, 23 Oct 1995 12:39:28 -0400
  • Organization: University of Colorado, Boulder

In article <DGMpFD.ICL at wri.com>, Will Self <wself at viking.emcmt.edu> wrote:
>Here's a nice puzzle.  Find the four numbers in the following sequence
>which total 100:  {6, 44, 30, 15, 24, 12, 33, 23, 18}.  It would seem that
>there might be a nice way to do this with Mathematica.  Any takers?
>
>Will Self
>Billings, Montana
>

This is a classic dynamic programming problem.  As is typical, it's
easy to come up with an incredibly inefficient recursive solution.  To
see if k numbers out of the list sum to n, do the following for each
element x of the list:  Drop x from the list, and if k-1 numbers in the
resulting list sum to n-x, then x is one of the numbers you are looking
for.  This solution strategy is incredibly inefficient (exponential
time complexity, I believe) because identical recursive calls are made
many times.  (Analogous to a recursive calculation of the fibonacci
numbers, but much harder to analyze for this particular problem.)

Now you can make this very inefficient  solution much more efficient
(polynomial time, I believe, but don't quote me on that!) by caching
the results of the recursive calls.  Here's a Mathematica
interpretation of this:

(* sumto[seq, k, n] returns a list of k numbers from seq that sum to n,
   if possible; otherwise it returns Null.
*)

In[1]:=
    Clear[sumto]
    sumto[seq_, k_, n_] := sumto[seq, k, n] =
    Module[{i, tmp},
	    Do[ tmp = sumto[Drop[seq, {i}], k-1, n-seq[[i]]];
		    If[tmp =!= Null, Return[Append[tmp, seq[[i]]]]],
		    {i, Length[seq]}
	    ]
    ]
    sumto[_, 0, 0] := {}	(* this indicates success *)
    sumto[___] := Null		(* this indicates failure *)

Here's an example:

In[5]:=
    sumto[{1,2,3}, 2, 5]
Out[5]=
    {3, 2}

There are now a bunch of cached values for sumto:

In[6]:=
    ?sumto
    Global`sumto

    sumto[{}, -1, -1] = Null
     
    sumto[{2}, 0, 1] = Null
     
    sumto[{3}, 0, 2] = Null
     
    sumto[{1, 3}, 1, 3] = {3}
     
    sumto[{2, 3}, 1, 4] = Null
     
    sumto[{1, 2, 3}, 2, 5] = {3, 2}
     
    sumto[_, 0, 0] := {}
     
    sumto[seq_, k_, n_] := 
      sumto[seq, k, n] = 
       Module[{i, tmp}, Do[tmp = 
	   sumto[Drop[seq, {i}], k - 1, n - seq[[i]]]; 
	  If[tmp =!= Null, Return[Append[tmp, seq[[i]]]]]\
	  , {i, Length[seq]}]]
     
    sumto[___] := Null

Here is your original problem:

In[7]:=
    nums = {6, 44, 30, 15, 24, 12, 33, 23, 18};

In[8]:=
    sumto[nums, 4, 100]
Out[8]=
    {18, 23, 15, 44}

The timing of this question could not have been better!  People
interested in a detailed treatment of dynamic programming using
Mathematica should refer to the article "Dynamic Programming", by yours
truly, which just appeared in The Mathematica Journal vol. 5 iss. 4.


		Dave Wagner
		Principia Consulting
		(303) 786-8371
		dbwagner at princon.com
		http://www.princon.com/princon


  • Prev by Date: Re: TCP/IP for Win95
  • Next by Date: Plots to Postscript files...
  • Previous by thread: Re: Puzzle
  • Next by thread: Re: Puzzle