A-M baby

Task/Knapsack-problem-Unbounded/Forth/knapsack-problem-unbounded-1.fth

@@ -0,0 +1,60 @@
+\ : value ; immediate
+: weight cell+ ;
+: volume 2 cells + ;
+: number 3 cells + ;
+
+\      item value weight volume number
+create panacea 30 ,   3 ,  25 , 0 ,
+create ichor   18 ,   2 ,  15 , 0 ,
+create gold    25 ,  20 ,   2 , 0 ,
+create sack     0 , 250 , 250 ,
+
+: fits? ( item -- ? )
+  dup weight @ sack weight @ > if drop false exit then
+      volume @ sack volume @ > 0= ;
+
+: add ( item -- )
+  dup        @        sack        +!
+  dup weight @ negate sack weight +!
+  dup volume @ negate sack volume +!
+  1 swap number +! ;
+
+: take ( item -- )
+  dup        @ negate sack        +!
+  dup weight @        sack weight +!
+  dup volume @        sack volume +!
+  -1 swap number +! ;
+
+variable max-value
+variable max-pan
+variable max-ich
+variable max-au
+
+: .solution
+  cr
+  max-pan @ . ." Panaceas, "
+  max-ich @ . ." Ichors, and "
+  max-au  @ . ." Gold for a total value of "
+  max-value @ 100 * . ;
+
+: check
+  sack @ max-value @ <= if exit then
+  sack           @ max-value !
+  panacea number @ max-pan   !
+  ichor   number @ max-ich   !
+  gold    number @ max-au    !
+  ( .solution ) ;    \ and change <= to < to see all solutions
+
+: solve-gold
+  gold fits? if gold add  recurse  gold take
+  else check then ;
+
+: solve-ichor
+  ichor fits? if ichor add  recurse  ichor take then
+  solve-gold ;
+
+: solve-panacea
+  panacea fits? if panacea add  recurse  panacea take then
+  solve-ichor ;
+
+solve-panacea .solution

Task/Knapsack-problem-Unbounded/Forth/knapsack-problem-unbounded-2.fth

@@ -0,0 +1,34 @@
+0 VALUE vials
+0 VALUE ampules
+0 VALUE bars
+0 VALUE bag	
+
+#250   3 /  #250 #25 /   MIN 1+ CONSTANT maxvials	
+#250    2/  #250 #15 /   MIN 1+ CONSTANT maxampules
+#250 #20 /  #250    2/   MIN 1+ CONSTANT maxbars	
+
+: RESULTS ( v a b -- k )
+	3DUP #20 *  SWAP 2*      +  SWAP     3 * +  #250 > IF  3DROP -1 EXIT  ENDIF
+	3DUP    2*  SWAP #15   * +  SWAP   #25 * +  #250 > IF  3DROP -1 EXIT  ENDIF
+	#2500    *  SWAP #1800 * +  SWAP #3000 * + ;
+
+: .SOLUTION ( -- )
+	CR ." The traveller's knapsack contains "
+	   vials   DEC. ." vials of panacea, "
+	   ampules DEC. ." ampules of ichor, "
+	CR bars    DEC. ." bars of gold, a total value of "
+	   vials ampules bars RESULTS 0DEC.R ." ." ;
+
+: KNAPSACK ( -- )
+	-1 TO bag
+	maxvials 0 ?DO
+	maxampules 0 ?DO
+	     maxbars 0 ?DO
+                              K J I RESULTS DUP
+			    bag  > IF  TO bag  K TO vials J TO ampules I TO bars
+				ELSE  DROP
+			        ENDIF
+		     LOOP
+		   LOOP
+		 LOOP
+	.SOLUTION ;