Am in on the right track for programming the knapsack problem in scheme? My program doesn't have to account for objects "values" , only their weights. The goal is to take the best combination of items so that I have approximately half of the weight in my bag.
(define (split-equip wlst)
(define (sum lst)
(define (sum-h accum lst1)
(if (null? lst)
(/ accum (length lst))
(sum-h (+ (car lst1) accum) (cdr lst1))))
(sum-h 0 lst))
(define (split-equip-h)
(let ((target-w (/ (sum wlst) 2)))
I am tempted to write my program to output a list with all of the different combinations of weights possible and then traversing the list until I find the best set of weights, but not sure how to implement this.
Since this is already your second attempt at this (the first question was deleted), I'll show you a solution in Racket. You should read it like pseudo-code and translate it into the Scheme variant you have been taught.
Disclaimer: I suck at these kind of exercises. That should be another reason for you to understand and reformulate this. But the results of my code still seem correct.
Here's the code:
#lang racket
(define (knapsack lst)
(define half (/ (apply + lst) 2)) ; compute half of total
(printf "list : ~a\nhalf : ~a\n" lst half)
(define (combs lst1 (lst2 null)) ; compute all the combinations
(if (null? lst1)
(if (null? lst2)
null
(list (reverse lst2)))
(append
(combs (cdr lst1) lst2) ; case 1 -> we don't carry the iten
(combs (cdr lst1) (cons (car lst1) lst2))))) ; case 2 -> we do
(for/fold ((delta half) (res null)) ((c (in-list (combs lst)))) ; determine the best fit
(let* ((sm (apply + c)) (newdelta (abs (- half sm))))
(cond
((< newdelta delta) (values newdelta (list c)))
((= newdelta delta) (values delta (cons c res)))
(else (values delta res))))))
(time
(let-values (((delta res) (knapsack (cdr (range 0 24 3)))))
(printf "result: ~a\ndelta : ~a\n" res delta)))
and here's what it says:
list : (3 6 9 12 15 18 21)
half : 42
result: ((3 6 12 21) (3 6 15 18) (3 9 12 18) (3 18 21) (6 9 12 15) (6 15 21) (9 12 21) (9 15 18))
delta : 0
cpu time: 6 real time: 5 gc time: 0
Hope this helps. Don't hesitate to ask questions if there's something you don't get!
Related
I am trying to create Pascal's Triangle using recursion. My code is:
(define (pascal n)
(cond
( (= n 1)
list '(1))
(else (append (list (pascal (- n 1))) (list(add '1 (coresublist (last (pascal (- n 1))))))
)))) ;appends the list from pascal n-1 to the new generated list
(define (add s lst) ;adds 1 to the beginning and end of the list
(append (list s) lst (list s))
)
(define (coresublist lst) ;adds the subsequent numbers, takes in n-1 list
(cond ((= (length lst) 1) empty)
(else
(cons (+ (first lst) (second lst)) (coresublist (cdr lst)))
)))
When I try to run it with:
(display(pascal 3))
I am getting an error that says:
length: contract violation
expected: list?
given: 1
I am looking for someone to help me fix this code (not write me entirely new code that does Pascal's Triangle). Thanks in advance! The output for pascal 3 should be:
(1) (1 1) (1 2 1)
We should start with the recursive definition for a value inside Pascals' triangle, which is usually expressed in terms of two parameters (row and column):
(define (pascal x y)
(if (or (zero? y) (= x y))
1
(+ (pascal (sub1 x) y)
(pascal (sub1 x) (sub1 y)))))
There are more efficient ways to implement it (see Wikipedia), but it will work fine for small values. After that, we just have to build the sublists. In Racket, this is straightforward using iterations, but feel free to implement it with explicit recursion if you wish:
(define (pascal-triangle n)
(for/list ([x (in-range 0 n)])
(for/list ([y (in-range 0 (add1 x))])
(pascal x y))))
It'll work as expected:
(pascal-triangle 3)
=> '((1) (1 1) (1 2 1))
I was trying to make a recursive function to split a list into two lists according the number of elements one wants.
Ex:
(split 3 '(1 3 5 7 9)) ((1 3 5) (7 9))
(split 7 '(1 3 5 7 9)) ((1 3 5 7 9) NIL)
(split 0 '(1 3 5 7 9)) (NIL (1 3 5 7 9))
My code is like this:
(defun split (e L)
(cond ((eql e 0) '(() L))
((> e 0) (cons (car L) (car (split (- e 1) (cdr L))))))))
I don't find a way to join the first list elements and return the second list.
Tail recursive solution
(defun split (n l &optional (acc-l '()))
(cond ((null l) (list (reverse acc-l) ()))
((>= 0 n) (list (reverse acc-l) l))
(t (split (1- n) (cdr l) (cons (car l) acc-l)))))
Improved version
(in this version, it is ensured that acc-l is at the beginning '()):
(defun split (n l)
(labels ((inner-split (n l &optional (acc-l '()))
(cond ((null l) (list (reverse acc-l) ()))
((= 0 n) (list (reverse acc-l) l))
(t (inner-split (1- n) (cdr l) (cons (car l) acc-l))))))
(inner-split n l)))
Test it:
(split 3 '(1 2 3 4 5 6 7))
;; returns: ((1 2 3) (4 5 6 7))
(split 0 '(1 2 3 4 5 6 7))
;; returns: (NIL (1 2 3 4 5 6 7))
(split 7 '(1 2 3 4 5 6 7))
;; returns ((1 2 3 4 5 6 7) NIL)
(split 9 '(1 2 3 4 5 6 7))
;; returns ((1 2 3 4 5 6 7) NIL)
(split -3 '(1 2 3 4 5 6 7))
;; returns (NIL (1 2 3 4 5 6 7))
In the improved version, the recursive function is placed one level deeper (kind of encapsulation) by using labels (kind of let which allows definition of local functions but in a way that they are allowed to call themselves - so it allows recursive local functions).
How I came to the solution:
Somehow it is clear, that the first list in the result must result from consing one element after another from the beginning of l in successive order. However, consing adds an element to an existing list at its beginning and not its end.
So, successively consing the car of the list will lead to a reversed order.
Thus, it is clear that in the last step, when the first list is returned, it hast to be reversed. The second list is simply (cdr l) of the last step so can be added to the result in the last step, when the result is returned.
So I thought, it is good to accumulate the first list into (acc-l) - the accumulator is mostly the last element in the argument list of tail-recursive functions, the components of the first list. I called it acc-l - accumulator-list.
When writing a recursive function, one begins the cond part with the trivial cases. If the inputs are a number and a list, the most trivial cases - and the last steps of the recursion, are the cases, when
the list is empty (equal l '()) ---> (null l)
and the number is zero ----> (= n 0) - actually (zerop n). But later I changed it to (>= n 0) to catch also the cases that a negative number is given as input.
(Thus very often recursive cond parts have null or zerop in their conditions.)
When the list l is empty, then the two lists have to be returned - while the second list is an empty list and the first list is - unintuitively - the reversed acc-l.
You have to build them with (list ) since the list arguments get evaluated shortly before return (in contrast to quote = '(...) where the result cannot be evaluated to sth in the last step.)
When n is zero (and later: when n is negative) then nothing is to do than to return l as the second list and what have been accumulated for the first list until now - but in reverse order.
In all other cases (t ...), the car of the list l is consed to the list which was accumulated until now (for the first list): (cons (car l) acc-l) and this I give as the accumulator list (acc-l) to split and the rest of the list as the new list in this call (cdr l) and (1- n). This decrementation in the recursive call is very typical for recursive function definitions.
By that, we have covered all possibilities for one step in the recursion.
And that makes recursion so powerful: conquer all possibilities in ONE step - and then you have defined how to handle nearly infinitely many cases.
Non-tail-recursive solution
(inspired by Dan Robertson's solution - Thank you Dan! Especially his solution with destructuring-bind I liked.)
(defun split (n l)
(cond ((null l) (list '() '()))
((>= 0 n) (list '() l))
(t (destructuring-bind (left right) (split (1- n) (cdr l))
(list (cons (car l) left) right)))))
And a solution with only very elementary functions (only null, list, >=, let, t, cons, car, cdr, cadr)
(defun split (n l)
(cond ((null l) (list '() '()))
((>= 0 n) (list '() l))
(t (let ((res (split (1- n) (cdr l))))
(let ((left-list (car res))
(right-list (cadr res)))
(list (cons (car l) left-list) right-list))))))
Remember: split returns a list of two lists.
(defun split (e L)
(cond ((eql e 0)
'(() L)) ; you want to call the function LIST
; so that the value of L is in the list,
; and not the symbol L itself
((> e 0)
; now you want to return a list of two lists.
; thus it probably is a good idea to call the function LIST
; the first sublist is made of the first element of L
; and the first sublist of the result of SPLIT
; the second sublist is made of the second sublist
; of the result of SPLIT
(cons (car L)
(car (split (- e 1)
(cdr L)))))))
Well let’s try to derive the recursion we should be doing.
(split 0 l) = (list () l)
So that’s our base case. Now we know
(split 1 (cons a b)) = (list (list a) b)
But we think a bit and we’re building up the first argument on the left and the way to build up lists that way is with CONS so we write down
(split 1 (cons a b)) = (list (cons a ()) b)
And then we think a bit and we think about what (split 0 l) is and we can write down for n>=1:
(split n+1 (cons a b)) = (list (cons a l1) l2) where (split n b) = (list l1 l2)
So let’s write that down in Lisp:
(defun split (n list)
(ecase (signum n)
(0 (list nil list))
(1 (if (cdr list)
(destructuring-bind (left right) (split (1- n) (cdr list))
(list (cons (car list) left) right))
(list nil nil)))))
The most idiomatic solution would be something like:
(defun split (n list)
(etypecase n
((eql 0) (list nil list))
(unsigned-integer
(loop repeat n for (x . r) on list
collect x into left
finally (return (list left r))))))
I want to implement Heap's algorithm in Scheme (Gambit).
I read his paper and checked out lots of resources but I haven't found many functional language implementations.
I would like to at least get the number of possible permutations.
The next step would be to actually print out all possible permutations.
Here is what I have so far:
3 (define (heap lst n)
4 (if (= n 1)
5 0
6 (let ((i 1) (temp 0))
7 (if (< i n)
8 (begin
9 (heap lst (- n 1))
10 (cond
11 ; if even: 1 to n -1 consecutively cell selected
12 ((= 0 (modulo n 2))
13 ;(cons (car lst) (heap (cdr lst) (length (cdr lst)))))
14 (+ 1 (heap (cdr lst) (length (cdr lst)))))
15
16 ; if odd: first cell selectd
17 ((= 1 (modulo n 2))
18 ;(cons (car lst) (heap (cdr lst) (length (cdr lst)))))
19 (+ 1 (heap (car lst) 1)))
20 )
21 )
22 0
23 )
24 )
25 )
26 )
27
28 (define myLst '(a b c))
29
30 (display (heap myLst (length myLst)))
31 (newline)
I'm sure this is way off but it's as close as I could get.
Any help would be great, thanks.
Here's a 1-to-1 transcription of the algorithm described on the Wikipedia page. Since the algorithm makes heavy use of indexing I've used a vector as a data structure rather than a list:
(define (generate n A)
(cond
((= n 1) (display A)
(newline))
(else (let loop ((i 0))
(generate (- n 1) A)
(if (even? n)
(swap A i (- n 1))
(swap A 0 (- n 1)))
(if (< i (- n 2))
(loop (+ i 1))
(generate (- n 1) A))))))
and the swap helper procedure:
(define (swap A i1 i2)
(let ((tmp (vector-ref A i1)))
(vector-set! A i1 (vector-ref A i2))
(vector-set! A i2 tmp)))
Testing:
Gambit v4.8.4
> (generate 3 (vector 'a 'b 'c))
#(a b c)
#(b a c)
#(c a b)
#(a c b)
#(b c a)
#(c b a)
I was asked to write a procedure that computes elements of Pascal's triangle by means of a recursive process. I may create a procedure that returns a single row in the triangle or a number within a particular row.
Here is my solution:
(define (f n)
(cond ((= n 1) '(1))
(else
(define (func i n l)
(if (> i n)
l
(func (+ i 1) n (cons (+ (convert (find (- i 1) (f (- n 1))))
(convert (find i (f (- n 1)))))
l))))
(func 1 n '()))))
(define (find n l)
(define (find i n a)
(if (or (null? a) (<= n 0))
'()
(if (>= i n)
(car a)
(find (+ i 1) n (cdr a)))))
(find 1 n l))
(define (convert l)
(if (null? l)
0
(+ l 0)))
This seems to work fine but it gets really inefficient to find elements of a larger row starting with (f 8). Is there a better procedure that solves this problem by means of a recursive process?
Also, how would I write it, if I want to use an iterative process (tail-recursion)?
There are several ways to optimize the algorithm, one of the best would be to use dynamic programming to efficiently calculate each value. Here is my own solution to a similar problem, which includes references to better understand this approach - it's a tail-recursive, iterative process. The key point is that it uses mutation operations for updating a vector of precomputed values, and it's a simple matter to adapt the implementation to print a list for a given row:
(define (f n)
(let ([table (make-vector n 1)])
(let outer ([i 1])
(when (< i n)
(let inner ([j 1] [previous 1])
(when (< j i)
(let ([current (vector-ref table j)])
(vector-set! table j (+ current previous))
(inner (add1 j) current))))
(outer (add1 i))))
(vector->list table)))
Alternatively, and borrowing from #Sylwester's solution we can write a purely functional tail-recursive iterative version that uses lists for storing the precomputed values; in my tests this is slower than the previous version:
(define (f n)
(define (aux tr tc prev acc)
(cond ((> tr n) '())
((and (= tc 1) (= tr n))
prev)
((= tc tr)
(aux (add1 tr) 1 (cons 1 acc) '(1)))
(else
(aux tr
(add1 tc)
(cdr prev)
(cons (+ (car prev) (cadr prev)) acc)))))
(if (= n 1)
'(1)
(aux 2 1 '(1 1) '(1))))
Either way it works as expected for larger inputs, it'll be fast for n values in the order of a couple of thousands:
(f 10)
=> '(1 9 36 84 126 126 84 36 9 1)
There are a number of soluitons presented already, and they do point out that usign dynamic programming is a good option here. I think that this can be written a bit more simply though. Here's what I'd do as a straightforward list-based solution. It's based on the observation that if row n is (a b c d e), then row n+1 is (a (+ a b) (+ b c) (+ c d) (+ d e) e). An easy easy to compute that is to iterate over the tails of (0 a b c d e) collecting ((+ 0 a) (+ a b) ... (+ d e) e).
(define (pascal n)
(let pascal ((n n) (row '(1)))
(if (= n 0) row
(pascal (- n 1)
(maplist (lambda (tail)
(if (null? (cdr tail)) 1
(+ (car tail)
(cadr tail))))
(cons 0 row))))))
(pascal 0) ;=> (1)
(pascal 1) ;=> (1 1)
(pascal 2) ;=> (1 2 1)
(pascal 3) ;=> (1 3 3 1)
(pascal 4) ;=> (1 4 6 4 1)
This made use of an auxiliary function maplist:
(define (maplist function list)
(if (null? list) list
(cons (function list)
(maplist function (cdr list)))))
(maplist reverse '(1 2 3))
;=> ((3 2 1) (3 2) (3))
Hey guys, I have a homework question that's been frustrating me to no end! I'm supposed to create index-of-least that will take a non-empty list and return the index of the smallest number in the list. The index of the (car ls) = 0, index of the (car (cdr ls)) = 1, and so on.
A helper needs to be created that will keep track of the current-position, least-position, least-value, and list. So far, I have this program (that doesn't load) that shows the basic algorithm.. But I'm having a hard time keeping track of everything and putting it into chez scheme code.
(define index-helper
(lambda (ls current-position least-position least-value)
(if (> (car ls) least-value)
(add1 (car ls (cdr ls (add1 current-position))))
(car ls (cdr ls (add1 current-position))))))
;trace
;ls: (4231) c-pos: 0 least-value: 5 least-pos: 0
;ls: (231) c-pos: 1 least-value: 4 least-pos: 1
;ls: (31) c-pos 2 least-value: 2 least-pos: 2
;ls: 1 c-pos: 3 l-v: 2 l-pos: 2
;ls '() c-pos: 4 l-v: 1 l-pos: 4
;*least-position = current-position
I already googled this and found similar questions in python, but I don't understand the code because I'm new to programming. :P
If anyone can give me a hint, I'd really appreciate it!
You want two functions. The first function find the least element x. The second function finds the index of the element x in the list.
Something like:
(define (find-least xs)
(foldl (lambda (e acc) (min e acc)) (car xs) xs))
(define (elem-index x xs)
(define (elem-index-find x xs ind)
(cond
((empty? xs) ind)
((eq? x (car xs))
ind)
(else (elem-index-find x (cdr xs) (+ ind 1)))))
(if (empty? xs)
(error "empty list")
(elem-index-find x xs 0)))
(define (index-of-least xs)
(let ((least (find-least xs)))
(elem-index least xs)))
Test:
> (index-of-least (list 5 8 4 9 1 3 7 2))
4
Or, in one pass:
(define (index-of-least-1-pass xs)
(define (index-do least ind-least ind xs)
(cond
((empty? xs) ind-least)
((< (car xs) least)
(index-do (car xs) (+ ind 1) (+ ind 1) (cdr xs)))
(else
(index-do least ind-least (+ ind 1) (cdr xs)))))
(index-do (car xs) 0 0 (cdr xs)))
Test:
> (index-of-least-1-pass (list 5 8 4 9 1 3 7 2))
4
In index-do helper function first you check if the intermediate list is empty; this is a base case, when we have got just one element int the list, and return its index.
Next condition checks if the next element of the intermediate list is greater than the current least value, and if so, we call helper with the new value of least and its index.
The last condition is selected, when the next element is not greater than the least, and it calls the helper function with the same values of least and ind-least, and the intermediate list with head element removed until there are no elements in the list, and we approached the base case, when there are no elements in the list.
A good example for named let:
(define (index-of-least xs)
(let loop ((i 0) (p 0) (x (car xs)) (xs (cdr xs)))
(cond ((null? xs) p)
((< (car xs) x) (loop (+ i 1) (+ i 1) (car xs) (cdr xs)))
(else (loop (+ i 1) p x (cdr xs))))))
(index-of-least (list 5 8 4 9 1 3 7 2)) => 4