Knapsack Problem in F# with recursive function - functional-programming

We have to program the knapsack problem in for a school project in different programming types. One is functional programming and I am trying it in F#.
I am using a recursive function to always get the items with the highest value to put into my knapsack. At the end I want to have the highest total value of all elements combined. Here is the solution in Python and I just hoped I could transfer it to F#.
let names = ["Zahnbürste","Zahnpasta", "Teller", "Duschgel", "Shampoo", "Handtuch", "Besteck", "Trinkflasche", "Becher", "Taschenlampe", "Sonnenschutz", "Medikamente"]
let volumes = [2,4,5,2,2.5,10,5,3,3,9,2,1]
let values = [3,19,17,15,13,3,2,8,5,6,17,15]
maxVol = 20;
def rucksackProblem(restVol, i) :
if (i < (len(volumes))) :
dontPack = rucksackProblem(restVol, i + 1)
pack = 0
if (restVol - volumes[i] >= 0) :
pack = values[i] + rucksackProblem(restVol - volumes[i], i + 1)
if (dontPack > pack) :
return dontPack
else :
return pack
else :
return 0
result = rucksackProblem(maxVol, 0)
print(result)
This is what I tried in F#. Please help me figuring out my problems. I am new to F# and functional programming and other solutions to the knapsack problem with hundreds of code lines seem overcomplicated. This doesn´t really print the end result I want to get from this function. It just returns 0:
open System
let names_list = ["Zahnbürste";"Zahnpasta"; "Teller"; "Duschgel";"Shampoo"; "Handtuch"; "Besteck"; "Trinkflasche"; "Becher";"Taschenlampe";"Sonnenschutz";"Medikamente"]
let volumes_list = [2;4;5;2;3;10;5;3;3;9;2;1]
let values_list = [3;19;17;15;13;3;2;8;5;6;17;15]
let maxVolume = 20
let rec rucksackProblem (restVol : int, i : int) =
if i < volumes_list.Length then
let dontPack = rucksackProblem(restVol, i + 1)
let pack = 0
let currentVolumeItem = volumes_list.Item(i)
if restVol - volumes_list.Item(i) >= 0 then
let mutable pack = values_list.Item(i) + rucksackProblem(restVol - volumes_list.Item(i), i + 1)
printf "%i" (volumes_list.Item(i))
else()
if dontPack > pack then
dontPack
else
pack
else
0
let result = rucksackProblem(maxVolume, 0)
printfn "%i" result
Console.ReadKey() |> ignore

I took the liberty to rewrite your code and I ended up with this.
let names = ["Zahnbürste"; "Zahnpasta"; "Teller"; "Duschgel"; "Shampoo"; "Handtuch"; "Besteck"; "Trinkflasche"; "Becher"; "Taschenlampe"; "Sonnenschutz"; "Medikamente"]
let weights = [2; 4; 5; 2; 3; 10; 5; 3; 3; 9; 2; 1]
let profits = [3; 19; 17; 15; 13; 3; 2; 8; 5; 6; 17; 15]
let cap = 20
type Product = { Name: string; Profit: int; Weight: int }
let knappsack names profits weights cap =
let sortItemsInDecreasingOrder =
List.zip3 names profits weights
|> List.map (fun x -> { Name=x.Item1; Profit=x.Item2; Weight=x.Item3 })
|> List.sortBy (fun p -> p.Profit / p.Weight)
|> List.rev
let products = sortItemsInDecreasingOrder
let rec pack bag totalWeight idx =
if idx > List.length names - 1 then bag
else
let p = products.[idx]
if (totalWeight + p.Weight) > cap then bag
else
pack (bag # [p]) (totalWeight + p.Weight) (idx + 1)
pack List.empty 0 1
knappsack names profits weights cap
|> Dump
|> ignore
The result I get is
Name Profit Weight
Sonnenschutz 17 2
Duschgel 15 2
Shampoo 13 3
Zahnpasta 19 4
Teller 17 5
Trinkflasche 8 3
89 19
Btw. if you are interested in learning functional programming using f# I can highly recommend https://fsharpforfunandprofit.com/.

I can't vouch for the correctness or efficiency of the algorithm but this should do what you're looking for:
open System
let names_list = ["Zahnbürste";"Zahnpasta"; "Teller"; "Duschgel";"Shampoo"; "Handtuch"; "Besteck"; "Trinkflasche"; "Becher";"Taschenlampe";"Sonnenschutz";"Medikamente"]
let volumes_list = [2;4;5;2;3;10;5;3;3;9;2;1]
let values_list = [3;19;17;15;13;3;2;8;5;6;17;15]
let maxVolume = 20
let rec rucksackProblem (restVol : int) (i : int) =
if i < volumes_list.Length then
let dontPack = rucksackProblem restVol (i + 1)
let currentVolumeItem = volumes_list.[i]
let pack =
if restVol - volumes_list.[i] >= 0 then
values_list.[i] + rucksackProblem (restVol - volumes_list.[i]) (i + 1)
else 0
if dontPack > pack then
dontPack
else
pack
else
0
let result = rucksackProblem maxVolume 0
printfn "%i" result
Note that because your mutable pack was defined inside of the scope of an if it was inaccessible outside that branch of the if. I moved that definition above so it could be accessed outside.
I also did a few other changes. In F# items in a list can be accessed as list.[index]. Parameters are passed separated by spaces not commas as this is a more flexible approach, for example allows currying.

Related

Practicing on matrix - Ocaml

I am practicing on matrix at the moment but I am not really sure on the most efficient way to resolve some of the problems I encounter.
My first "problem" is to optimize a function. What I try to do is to iterate trough the 'a matrix which is a 'a array array.
For each line identified by an integer between 0 and 4 (the matrix has a size of (5,10)), I count how many "one" there is.
I had to split it in three different functions but I was wondering if there is any more optimized way to solve this problem ?
let count m i =
let ret=Array.fold_left (fun x y -> if y=1 then x+1 else x) 0 (m.(i)) in
ret;;
let rec clear l =
match l with
|[]->[]
|(a,b)::[]->if b=0 then [] else (a,b)::[]
|(a,b)::c->if b=0 then clear c else (a,b)::clear c;;
let all_moves s =
match s with
|(a,_)->clear[(0,count a 0);(1,count a 1);(2,count a 2);(3,count a 3);(4,count a 4)];;
Second of all, my main problem is to iterate through the entire matrix at once.
I'm trying to count all the 1 in the matrix except for the line identified by param "i".
I tried several things but I'm really stuck at the moment.
let countall m i =
let ret=Array.fold_left (fun x y -> if pos != i then x + y else ())
(Array.fold_left (fun x y -> if y=1 then x+1 else x) 0 (m.(i)))
0 m in
ret;;
I would like to thank you in advance for your help and I thought I might give a matrix for you to test my functions:
let c = [|[|1; 1; 1; 1; 1; 0; 0; 0; 0; 0|]; [|1; 1; 1; 1; 1; 1; 1; 1; 0; 0|];
[|1; 1; 1; 1; 1; 1; 1; 1; 1; 0|]; [|1; 0; 0; 0; 0; 0; 0; 0; 0; 0|];
[|1; 1; 1; 1; 1; 1; 1; 1; 1; 1|]|]
Sincerely yours,
Rama
Some pointers:
Expressions of the form let ret = expr in ret can be simplified to expr. And the reverse application operator |> can often be used to elide trivial let expressions.
If a function starts with a match expression that has just a single clause, that clause can often be rolled into the function signature. E.g. let all_moves s = match s with (a, _) -> ... becomes `let all_moves (a, _) = ...'.
The Array and List modules have more than just fold functions (and alternative standard libraries, such as Core, Batteries, or ExtLib add more functionality to them) that can be used to simplify a lot of Array/List processing.
Example:
let count_ones row =
Array.fold_left (fun c x -> if x=1 then c+1 else c) 0 row
let all_moves (mat, _) =
Array.mapi (fun i row -> (i, count_ones row)) mat
|> Array.to_list |> List.filter (fun (_, c) -> c != 0)
I'm not 100% sure what the intended semantics of countall are, but if I'm understanding it correctly, the following should work (it follows the basic structure of your attempted solution, but relies on mapi instead of fold_left, which is a better fit):
let countall mat k =
Array.mapi (fun i row -> if i = k then 0 else count_ones row) mat
|> Array.fold_left (+) 0
This function can be implemented in different ways, too, e.g.:
let countall mat k =
Array.(append (sub mat 0 k) (sub mat (k+1) (length mat - k - 1)))
|> Array.map count_ones |> Array.fold_left (+) 0
In this variant, I'm using a local open Array.(expr) so that I don't have to prefix every single array operation with Array.. Also, in both versions (+) is a way to write the plus operator as a function with two arguments, and is roughly equivalent to writing (fun x y -> x + y) in its place.
Maybe that could help you
let countall m i =
snd (
Array.fold_left (fun (lg,c) v ->
let c=
if lg = i then c
else
Array.fold_left (fun c xy -> if xy=1 then c+1 else c) c v
in
(lg+1,c)
) (0,0) m
)
;;
Test
# countall c 0;;
- : int = 28

Tail Recursivity in F# : Inversions with Quicksort

Hi i have some difficulty in understanding tail-recursivity. I know thats it's important to avoid infinite loops and also for memory usage. I've seen some examples on simple functions like Fibonacci in "Expert in F#", but I don't think i've seen code when the result is something different than just a number.
What would be the accumulator then ? i'm not sure...
Here is a recursive function that I've written. It counts the number of inversions in an array, using the quicksort algorithm. [it's taken from an exercise of the Coursera MOOC Algo I by Stanford]
I'd be grateful if somebody could explain how to make that tail recursive.
[Also, i've translated that code from imperative code, as i had written that in R before, so the style is not functional at all...]
another question: is the syntax correct, A being a (mutable) array, i've written let A = .... everywhere ?
is A <- .... better / the same ?
open System.IO
open System
let X = [|57; 97; 17; 31; 54; 98; 87; 27; 89; 81; 18; 70; 3; 34; 63; 100; 46; 30; 99;
10; 33; 65; 96; 38; 48; 80; 95; 6; 16; 19; 56; 61; 1; 47; 12; 73; 49; 41;
37; 40; 59; 67; 93; 26; 75; 44; 58; 66; 8; 55; 94; 74; 83; 7; 15; 86; 42;
50; 5; 22; 90; 13; 69; 53; 43; 24; 92; 51; 23; 39; 78; 85; 4; 25; 52; 36;
60; 68; 9; 64; 79; 14; 45; 2; 77; 84; 11; 71; 35; 72; 28; 76; 82; 88; 32;
21; 20; 91; 62; 29|]
// not tail recursive. answer = 488
let N = X.Length
let mutable count = 0
let swap (A:int[]) a b =
let tmp = A.[a]
A.[a] <- A.[b]
A.[b] <- tmp
A
let rec quicksortNT (A:int[]) =
let L = A.Length
match L with
| 1 -> A
| 2 -> count <- count + 1
if (A.[0]<A.[1]) then A
else [|A.[1];A.[0]|]
| x -> let p = x
let pval = A.[p-1]
let A = swap A 0 (p-1)
let mutable i = 1
for j in 1 .. (x-1) do
if (A.[j]<pval) then let A = swap A i j
i <- i+1
// end of for loop
// putting back pivot at its right place
let A = swap A 0 (i-1)
let l1 = i-1
let l2 = x-i
if (l1=0) then
let A = Array.append [|A.[0]|] (quicksortNT A.[1..p-1])
count <- count + (l2-1)
A
elif (l2=0) then
let A = Array.append (quicksortNT A.[0..p-2]) [|A.[p-1]|]
count <- count + (l2-1)
A
else
let A = Array.append ( Array.append (quicksortNT A.[0..(i-2)]) [|A.[i-1]|] ) (quicksortNT A.[i..p-1])
count <- count + (l1-1)+(l2-1)
A
let Y = quicksortNT X
for i in 1..N do printfn "%d" Y.[i-1]
printfn "count = %d" count
Console.ReadKey() |> ignore
Thank you very much for your help
As I said in my comment: you do inplace-swapping so it makes no sense to recreate and return arrays.
But as you ask about tail-recursive solutions look at this version using lists and continuation-passing-style to make the algorithm tail-recursive:
let quicksort values =
let rec qsort xs cont =
match xs with
| [] -> cont xs
| (x::xs) ->
let lower = List.filter (fun y -> y <= x) xs
let upper = List.filter (fun y -> y > x) xs
qsort lower (fun lowerSorted ->
qsort upper (fun upperSorted -> cont (lowerSorted # x :: upperSorted)))
qsort values id
remarks:
you can think of it like this:
first partition the input into upper and lower parts
then start with sorting (recursively) the lower part, when you are done with this continue by...
... take lowerSorted and sort the upper part as well and continue with ...
... take both sorted parts, join them and pass them to the outer continuation
the outermost continuation should of course just be the id function
some will argue that this is not quicksort as it does not sort inplace!
maybe it's hard to see but it's tail-recursive as the very last call is to qsort and it's result will be the result of the current call
I used List because the pattern-matching is so much nicer - but you can adopt this to your version with arrays as well
in those cases (as here) where you have multiple recursive calls I always find cont-passing solutions to be easier to write and more natural - but accumulators could be used as well (but it will get messy as you need to pass where you are too)
this will not take less memory than the version without the cont-passing at all - it just will be placed on the heap instead of the stack (you usually have way more heap available ;) ) - so it's a bit like cheating
that's why the imperative algorithm is still way better performance-wise - so a usual compromise is to (for example) copy the array, use the inplace-algorithm on the copy and then return the copy - this way the algorithm behaves as if it's pure on the outside
The whole point to quicksort's swapping partition procedure is that it can mutate the same array; you just pass it the low and the high index of the array's range it has to process.
So make a nested function and pass it just the 2 indices. To make it tail recursive, add the third parameter, list-of-ranges-to-process; when that becomes empty, you're done. Wikibook says you mutate arrays with A.[i] <- A.[j].
A nested function can access its parent function's argument directly, because it is in scope. So, make swap nested too:
let rec quicksort (A:int[]) =
let swap a b =
let tmp = A.[a]
A.[a] <- A.[b]
A.[b] <- tmp
let todo = ... (* empty list *)
let rec partition low high =
.... (* run the swapping loop,
find the two new pairs of indices,
put one into TODO and call *)
partition new_low new_high
let L = A.Length
match L with
| 1 -> (* do nothing A *)
| 2 -> count <- count + 1
if (A.[0]<A.[1]) then (* do nothing A *)
else (* [|A.[1];A.[0]|] *) swap 1 0
| x -> ....
partition 0 L
So partition will be tail recursive, working inside the environment set up for it by quicksort.
(disclaimer: I don't know F# and have never used it, but I know Haskell and Scheme, to some degree).

SML: Keeping track of number of iterations

I'm sure there's a way to do this elegantly in SML but I'm having difficulty keeping track of the number of iterations (basically the number of times my function has been called).
I'm trying to write a function that evaluates to a pair of numbers, one for the floor of the answer and the other for the remainder. So if you called:
divmod(11, 2), you'd get (5, 1) back.
Here's what I have so far:
divmod(number : int, divisor : int) =
if number < divisor then
(number, count)
else
divmod(number - divisor, divisor);
Obviously, I haven't set up my count variable so it won't compile but that's the idea of the algorithm. All that's left is initializing count to 0 and being able to pass it between recursive calls. But I'm only allowed the two parameters for this function.
I can, however, write auxiliary functions.
Thoughts?
If SML has support for nested functions you could do like this:
divmod(number : int, divisor : int) =
_divmod(n : int, d : int, count : int) =
if n < d then
(count, n)
else
_divmod(n - d, d, count + 1)
_divmod(number, divisor, 0)
Personally, I like the fact that SML isn't a pure functional language. Keeping track of function calls is naturally done via side effects (rather than explicitly passing a counter variable).
For example, given a generic recursive Fibonacci:
fun fib 0 = 0
| fib 1 = 0
| fib n = fib(n-2) + fib(n-1);
You can modify it so that every time it is called it increments a counter as a side effect:
counter = ref 0;
fun fib 0 = (counter := !counter + 1; 0)
| fib 1 = (counter := !counter + 1; 1)
| fib n = (counter := !counter + 1; fib(n-2) + fib(n-1));
You can use this directly or wrap it up a bit:
fun fibonacci n = (
counter :=0;
let val v = fib n
in
(!counter,v)
end);
With a typical run:
- fibonacci 30;
val it = (2692537,832040) : int * int
(Which, by the way, shows why this version of the Fibonacci recursion isn't very good!)

Reversing an int in OCaml

I'm teaching myself OCaml, and the main resources I'm using for practice are some problem sets Cornell has made available from their 3110 class. One of the problems is to write a function to reverse an int (i.e: 1234 -> 4321, -1234 -> -4321, 2 -> 2, -10 -> -1 etc).
I have a working solution, but I'm concerned that it isn't exactly idiomatic OCaml:
let rev_int (i : int) : int =
let rec power cnt value =
if value / 10 = 0 then cnt
else power (10 * cnt) (value/10) in
let rec aux pow temp value =
if value <> 0 then aux (pow/10) (temp + (value mod 10 * pow)) (value / 10)
else temp in
aux (power 1 i) 0 i
It works properly in all cases as far as I can tell, but it just seems seriously "un-OCaml" to me, particularly because I'm running through the length of the int twice with two inner-functions. So I'm just wondering whether there's a more "OCaml" way to do this.
I would say, that the following is idiomatic enough.
(* [rev x] returns such value [y] that its decimal representation
is a reverse of decimal representation of [x], e.g.,
[rev 12345 = 54321] *)
let rev n =
let rec loop acc n =
if n = 0 then acc
else loop (acc * 10 + n mod 10) (n / 10) in
loop 0 n
But as Jeffrey said in a comment, your solution is quite idiomatic, although not the nicest one.
Btw, my own style, would be to write like this:
let rev n =
let rec loop acc = function
| 0 -> acc
| n -> loop (acc * 10 + n mod 10) (n / 10) in
loop 0 n
As I prefer pattern matching to if/then/else. But this is a matter of mine personal taste.
I can propose you some way of doing it:
let decompose_int i =
let r = i / 10 in
i - (r * 10) , r
This function allows me to decompose the integer as if I had a list.
For instance 1234 is decomposed into 4 and 123.
Then we reverse it.
let rec rev_int i = match decompose_int i with
| x , 0 -> 10 , x
| h , t ->
let (m,r) = rev_int t in
(10 * m, h * m + r)
The idea here is to return 10, 100, 1000... and so on to know where to place the last digit.
What I wanted to do here is to treat them as I would treat lists, decompose_int being a List.hd and List.tl equivalent.

Why ocamlc says I mismatched {} while I don't?

I have written myPercolation.ml.
open MyUnionFind
module type MyPercolationSig = sig
type percolation
val create_percolation : int -> percolation
val open_site : percolation -> int -> int -> unit
val is_open : percolation -> int -> int -> bool
val is_full : percolation -> int -> int -> bool
val can_percolates : percolation -> bool
end
module MyPercolation : MyPercolationSig = struct
exception IndexOutOfBounds;;
type percolation =
{n : int;
sites: bool array;
union : MyUnionFind.union_find};;
let create_percolation n =
{n = n; sites = Array.make (n*n) false; union = MyUnionFind.create_union (n*n)};;
let open_site p i j =
let {n;_;union} = p
in
if not (is_open p i j) then
begin
sites.(index_of n i j) <- true;
if i - 1 >= 1 && i - 1 <= n && is_open n (i-1) j then
MyUnionFind.union union (index_of n i j) (index_of n (i-1) j)
else if i + 1 >= 1 && i + 1 <= n && is_open n (i+1) j then
MyUnionFind.union union (index_of n i j) (index_of n (i+1) j)
else if j - 1 >= 1 && j - 1 <= n && is_open n i (j-1) then
MyUnionFind.union union (index_of n i j) (index_of n i (j-1))
else if j + 1 >= 1 && j + 1 <= n && is_open n i (j+1) then
MyUnionFind.union union (index_of n i j) (index_of n i (j+1))
end;;
let index_of n i j = n * (i - 1) + j;;
let is_open {n;sites;_} i j =
if i < 1 || i > n || j < 1 || j > n then
raise IndexOutOfBounds
else
sites.(index_of n i j);;
let is_full {n;_;union} i j =
let rec is_connected_top j' =
if j = 0 then false
else
if MyUnionFind.is_connected union (index_of n i j) (index_of n 0 j') then true
else is_connected_top (j'-1)
in is_connected_top n;;
let can_percolates p =
let {n;_;_} = p
in
let rec is_full_bottom j =
if j = 0 then false
else
if is_full p n j then true
else is_full_bottom (j-1)
end
Please ignore the package MyUnionFind package. It is just a homemade implementation for union-find algorithm.
when I try to compile the myPercolation.ml, I got such an error:
$ ocamlc -c myPercolation.ml
File "myPercolation.ml", line 25, characters 11-12:
Error: Syntax error: '}' expected
File "myPercolation.ml", line 25, characters 8-9:
Error: This '{' might be unmatched
I think the error is talking about let {n;_;union} = p in function of let open_site p i j.
I have read through that line and all code many times, but I still don't see any mismatched {} in that line.
can anyone help please?
Another possible error: {n;_;_} should be {n;_} Only 1 underscore is necessary. Think of it like the _ wildcard in a match statement.
The expression let {n; _; union} = p is not well formed OCaml. I think what you want is let {n; union} = p. The way to handle fields you don't care about in a record pattern is not to mention them.
Update:
As rgrinberg points out, a much better way to describe the problem is that the _ has to appear as the last field. That's why the compiler is expecting to see } afterward. It might be good style to include the _ as an indicator that you're purposely matching only a subset of the fields of the record. You can, in fact, turn on a compiler option that checks for this.
Update 2:
The warning for incomplete record patterns is warning number 9, and also is associated with the letter R. Here's how to use R:
$ ocaml -w +R
OCaml version 4.00.0
# type r = { a: int; b: char };;
type r = { a : int; b : char; }
# let {a} = {a=3; b='x'} in a;;
Warning 9: the following labels are not bound in this record pattern:
b
Either bind these labels explicitly or add '; _' to the pattern.
- : int = 3
The command-line syntax is the same for the compiler.

Resources