Creating an evaluate function in racket - scheme

Example of what function should do:
(list 3 4 6 9 7) ←→ 3x^4 + 4x^3 + 6x^2 + 9x + 7
What I have so far:
(define (poly-eval x numlist)
(compute-poly-tail x numlist 0 0))
(define (compute-poly-tail xn list n acc)
(cond
[(null? list) acc]
[else (compute-poly-tail (first list) (rest list)
(+ acc (* (first list) (expt xn n))) (+ n 1))]))
(check-expect(poly-eval 5 (list 1 0 -1)) 24)
(check-expect(poly-eval 0 (list 3 4 6 9 7)) 7)
(check-expect(poly-eval 2 (list 1 1 0 1 1 0)) 54)
Expected results:
(check-expect(poly-eval 5(list 1 0 -1)) 24)
(check-expect(poly-eval 0 (list 3 4 6 9 7))7)
(check-expect(poly-eval 2 (list 1 1 0 1 1 0)) 54)
I am getting a run-time error. Can someone spot what I am doing wrong. I don't know why I am getting these results.

There are a couple of errors in the code:
You need to process the coefficient's list in the correct order, corresponding to their position in the polynomial! you can either:
reverse the list from the beginning and process the coefficients from right to left (simpler).
Or start n in (sub1 (length numlist)) and decrease it at each iteration (that's what I did).
The order and value of the arguments when calling the recursion in compute-poly-tail is incorrect, check the procedure definition, make sure that you pass along the values in the same order as you defined them, also the first call to (first list) doesn't make any sense.
You should not name list a parameter, this will clash with the built-in procedure of the same name. I renamed it to lst.
This should fix the issues:
(define (poly-eval x numlist)
(compute-poly-tail x numlist (sub1 (length numlist)) 0))
(define (compute-poly-tail xn lst n acc)
(cond
[(null? lst) acc]
[else (compute-poly-tail xn
(rest lst)
(- n 1)
(+ acc (* (first lst) (expt xn n))))]))
It works as expected:
(poly-eval 5 (list 1 0 -1))
=> 24
(poly-eval 0 (list 3 4 6 9 7))
=> 7
(poly-eval 2 (list 1 1 0 1 1 0))
=> 54

Build power coefficient and unknown list than use map function.
; 2*3^1+4*3^0
; input is 3 and '(2 4)
; we need '(3 3) '(2 4) '(1 0)
; use map expt build '(3^1 3^0)
; use map * build '(2*3^1 4*3^0)
; use foldr + 0 sum up
(define (poly-eval x coefficient-ls)
(local ((define power-ls (reverse (build-list (length coefficient-ls) values)))
(define unknown-ls (build-list (length coefficient-ls) (λ (i) x))))
(foldr + 0 (map * coefficient-ls (map expt unknown-ls power-ls)))))

Related

How can I use dynamic programming in Scheme to solve the Coin Change problem?

I'm trying to learn a Lisp language and have settled on Guile and am trying to solve this problem:
You are given an integer array coins representing coins of different denominations and an integer amount representing a total amount of money.
Return the fewest number of coins that you need to make up that amount. If that amount of money cannot be made up by any combination of the coins, return -1.
You may assume that you have an infinite number of each kind of coin.
Fundamentally, I understand the basic of dynamic programming where you can use recursion and memoization in order to save calculating at lower depths, but as Lisp I would expect it to be perfect for this type of problem. The problem I am having is returning separate lists for each combination of coins.
For an example case, consider target of 6 with coins [2, 3]. The simple tree would look like this:
The correct answer would be (3 3) with the other "complete" solution being (2 2 2).
However, if I try and construct these, the form I would want to use (without memoization) would look something like this.
(define get-coins (lambda (coins target)
(cond
((= target 0) '())
; not quite sure how to "terminate" a list here
; An idea is to return (list -1) and then filter
; lists that contain -1
((< target 0) ?????)
(else
; for each coin, recurse
(map (lambda (v)
(cons v (get-coins coins (- target v))))))
)
))
However, this doesn't return more lists as it goes through. Rather, it creates nested lists. And this is my problem. Any help with this would be greatly appreciated.
I wanted to avoid nested lists, so I used a variable results:
(define (get-coins coins target)
(let ((results '()))
Then I defined the function get-coins-helper, similar to your get-coins. And whenever I found some possible result, I used set! to update results:
(letrec ((get-coins-helper
(lambda (coins target result)
(cond ((= target 0) (set! results (cons result results)))
((< target 0) '())
(else (map (lambda (value)
(get-coins-helper coins
(- target value)
(cons value result)))
coins))))))
Then I called (get-coins-helper coins target '()) to find all possible results and at the end, I checked the value of results and returned -1 (if results are empty) or the shortest element of results:
(if (null? results)
-1
(car (sort results (lambda (x y) (< (length x)
(length y))))))
Full code:
(define (get-coins coins target)
(let ((results '()))
(letrec ((get-coins-helper
(lambda (coins target result)
(cond ((= target 0) (set! results (cons result results)))
((< target 0) '())
(else (map (lambda (value)
(get-coins-helper coins
(- target value)
(cons value result)))
coins))))))
(get-coins-helper coins target '())
(if (null? results)
-1
(car (sort results (lambda (x y) (< (length x)
(length y)))))))))
Some tests:
> (get-coins '(2 3) 6)
'(3 3)
> (get-coins '(2 3) 1)
-1
Using fold to choose best solutions. The result is a list whose car is the number of coins and cdr is the list of chosen coins. In the event that no solutions are feasible, (+inf.0) is returned.
(use-modules (srfi srfi-1))
(define (get-coins coins target)
(fold (lambda (coin best)
(let [(target (- target coin))]
(cond [(zero? target)
(list 1 coin)]
[(positive? target)
(let* [(res (get-coins coins target))
(score' (1+ (car res)))]
(if (< score' (car best))
(cons score' (cons coin (cdr res)))
best))]
[(negative? target)
best])))
(list +inf.0)
coins))
(get-coins (list 2) 6)
$8 = (3 2 2 2)
(get-coins (list 2 3) 6)
$9 = (2 3 3)
(get-coins (list 9) 6)
$10 = (+inf.0)
If you read the question carefully, all you need to keep track of is the number of coins needed to reach the target amount. You don't have generate every possible combination of coins to reach the target, just the one that minimizes the number of coins. And you don't even have to remember what that particular combination is, just its length. This simplifies things a bit since there's no need to build any lists.
For each denomination of coin that can possibly be used to reach the goal (So no coins bigger than the difference between the goal and the current sum), get the counts for using one of them and for using none of them, and return the minimum (Or -1 if no options present themselves).
(define (get-coins coins target)
(calculate-coins coins 0 0 target))
;; Do all the work in a helper function
(define (calculate-coins coins coin-count amount target)
(cond
((= amount target) coin-count) ; Success
((null? coins) -1) ; Failure
((> (car coins) (- target amount)) ; Current coin denomination is too big; skip it
(calculate-coins (cdr coins) coin-count amount target))
(else
;; Cases to consider:
;; Adding one of the current coin to the total and leaving open using more
;; Not using any of the current coins
(let ((with-first
(calculate-coins coins (+ coin-count 1) (+ amount (car coins)) target))
(without-first
(calculate-coins (cdr coins) coin-count amount target)))
(cond
((= with-first -1) without-first)
((= without-first -1) with-first)
(else (min with-first without-first)))))))
If you do want to get every possible combination of coin, one way is to, for each list of combinations that use a given coin, use append to combine it with a list of previous ways:
(use-modules (srfi srfi-1))
(define (get-coins2 coins target)
(define (helper target) ; This time define a nested helper function
(fold
(lambda (coin ways)
(cond
((= coin target) (cons (list coin) ways))
((< coin target)
(append
(map (lambda (c) (cons coin c))
(helper (- target coin)))
ways))
(else ways)))
'()
coins))
(let* ((ways (helper target))
(table (make-hash-table (length ways))))
;; Store each combination as a key in a hash table to remove duplicates
(for-each (lambda (way) (hash-set! table (sort-list way <) #t)) ways)
(hash-map->list (lambda (k v) k) table)))
Examples:
scheme#(guile-user)> (load "coins.scm")
scheme#(guile-user)> (get-coins '(2) 6)
$1 = 3
scheme#(guile-user)> (get-coins2 '(2) 6)
$2 = ((2 2 2))
scheme#(guile-user)> (get-coins '(2 3) 6)
$3 = 2
scheme#(guile-user)> (get-coins2 '(2 3) 6)
$4 = ((2 2 2) (3 3))
scheme#(guile-user)> (get-coins '(9) 6)
$5 = -1
scheme#(guile-user)> (get-coins2 '(9) 6)
$6 = ()
scheme#(guile-user)> (get-coins2 '(2 3) 12)
$7 = ((3 3 3 3) (2 2 2 3 3) (2 2 2 2 2 2))
scheme#(guile-user)> (get-coins '(5 2 3 4) 21)
$8 = 5
scheme#(guile-user)> (get-coins2 '(5 2 3 4) 21)
$9 = ((2 2 2 5 5 5) (2 3 3 4 4 5) (2 4 5 5 5) (3 3 3 4 4 4) (2 2 3 4 5 5) (4 4 4 4 5) (2 2 4 4 4 5) (2 2 3 3 3 4 4) (2 2 2 2 2 3 4 4) (2 2 2 2 4 4 5) (3 3 3 3 4 5) (2 2 2 2 3 3 3 4) (2 2 2 2 2 2 2 3 4) (2 2 2 2 2 2 4 5) (3 3 3 3 3 3 3) (2 2 3 3 3 3 5) (2 2 2 2 2 2 3 3 3) (2 2 2 2 2 3 3 5) (3 3 5 5 5) (2 2 2 2 2 2 2 2 2 3) (2 2 2 2 3 5 5) (2 2 2 2 2 2 2 2 5) (2 3 4 4 4 4) (2 2 2 3 4 4 4) (2 3 3 3 3 3 4) (2 2 2 3 3 4 5) (2 2 2 3 3 3 3 3) (2 3 3 3 5 5) (3 4 4 5 5))
scheme#(guile-user)> (filter (lambda (way) (= (length way) 5)) (get-coins2 '(5 2 3 4) 21))
$10 = ((2 4 5 5 5) (4 4 4 4 5) (3 3 5 5 5) (3 4 4 5 5))
There are many ways to do it, here is a brute-force solution. It is not elegant but it is simple.
(define mk/pairs
(lambda (sum coin/list)
((lambda (s) (s s
(map (lambda (x) (iota (+ 1 (quotient sum x)))) coin/list)
(lambda (s) s) ))
(lambda (s l* ret)
(if (null? l*)
(ret '(()))
(s s (cdr l*)
(lambda (r)
(ret (apply
append
(map (lambda (x) (map (lambda (y) (cons y x)) (car l*)))
r))))))))))
(define cost
(lambda (s pair coin/list)
(let ((sum (apply + (map * pair coin/list))))
(and (= s sum) pair))))
(define solve
(lambda (sum coin/list)
(let ((pairs (mk/pairs sum coin/list)))
(let ((solutions
(sort (filter (lambda (x) x)
(map (lambda (p) (cost sum p coin/list)) pairs))
(lambda (p1 p2)
(< (apply + p1)
(apply + p2))))))
(if (null? solutions)
"fail"
(car solutions))))))
A test looks like so:
% mit-scheme < coins.scm
MIT/GNU Scheme running under GNU/Linux
1 ]=> (solve 8 '(2 3 1))
;Value: (1 2 0)
1 ]=> (solve 6 '(2 3))
;Value: (0 2)
meaning that you have 1 coin of 2 and 2 coins of 3 in the first example and 2 coins of 3 in the second example.
I have used standard R6RS, so you should be able to convert it directly from mit/scheme to guile.

how do I make a function to find the mean of a function in scheme

((define (sum list)
(if(null? list)
0
(+(car list)(sum(cdr list)))))
(define (mean list)
(if(null? list)
0
(/ (sum list) (length list))))
(mean (list 1 2 3 4))
so apparently the mean being returned is 2 1/2 but it should be 2 just 2 as 10/5 is 2 what should I do to make correct mean??
Your code is correct. The sum of (list 1 2 3 4) is 10 and that list has four elements, so the result will be 2 1/2.
You should also add some spaces to increase readability and don't use function names for the naming of variables (list, in this case). The improved version will look like this:
(define (sum lst)
(if (null? lst) 0
(+ (car lst)
(sum (cdr lst)))))
(define (mean lst)
(if (null? lst) 0
(/ (sum lst)
(length lst))))
Test:
(mean (list 1 2 3 4))
=> 2 1/2
Note that you can also return the sum of the list like this:
> (apply + (list 1 2 3 4))
10

How do foldl and foldr work, broken down in an example?

Okay, I am new with scheme/racket/lisp. I am practicing creating my own functions, syntax, and recursion, so I want to make my own foldl and foldr functions that do exactly what the predefined versions do. I can't do it because I just don't understand how these functions work. I have seen similar questions on here but I still don't get it. Some examples broken down would help! Here is my (incorrect) process:
(foldl - 0 '(1 2 3 4)) I do 0 -(4-3-2-1) and get 2 which is the right answer
(foldl - 0 '(4 3 2 1)) I do 0-(1-2-3-4) and get 8 but it should be -2.
(foldr - 0 '(1 2 3 4)) I do 0-(1-2-3-4) and get 8 again, but it should be -2.
(foldr - 0 '(4 3 2 1)) I do 0-(4-3-2-1) and get 2 which is the right answer.
What am I doing wrong?
Let's look at: (foldr - 0 '(1 2 3 4)).
Here the literal '(1 2 3 4) constructs a list whose elements are the numbers 1, 2, 3, and, 4. Let's make the construction of the list explicit:
(cons 1 (cons 2 (cons 3 (cons 4 empty))))
One can think of foldr as a function that replaces cons with a function f and empty with a value v.
Therefore
(foldr f 0 (cons 1 (cons 2 (cons 3 (cons 4 empty)))))
becomes
(f 1 (f 2 (f 3 (f 4 v)))))
If the function f is - and the value v is 0, you will get:
(- 1 (- 2 (- 3 (- 4 0)))))
And we can calculate the result:
(- 1 (- 2 (- 3 (- 4 0))))
= (- 1 (- 2 (- 3 4)))
= (- 1 (- 2 -1))
= (- 1 3)
= -2
Note that (foldr cons empty a-list) produces a copy of a-list.
The function foldl on the other hand uses the values from the other side:
> (foldl cons empty '(1 2 3 4))
'(4 3 2 1)
In other words:
(foldl f v '(1 2 3 4))
becomes
(f 4 (f 3 (f 2 (f 1 v)))).
If f is the function - and the value is 0, then we get:
(- 4 (- 3 (- 2 (- 1 0))))
= (- 4 (- 3 (- 2 1)))
= (- 4 (- 3 1))
= (- 4 2)
= 2
Note that (foldl cons empty a-list) produces the reverse of a-list.
You can illustrate what is going on in fold, if you create a procedure, which does the same like cons but reverses the arguments. I have called it snoc in the following example.
(define fldl
(lambda (proc a lst)
(if (pair? lst)
(fldl proc
(proc (car lst)
a)
(cdr lst))
a)))
(define fldr
(lambda (proc a lst)
(if (pair? lst)
(proc (car lst)
(fldr proc
a
(cdr lst)))
a)))
(define lst (list 1 2 3 4))
(fldl + 0 lst) ;; => 10
(fldl * 1 lst) ;; => 24
(fldl cons '() lst) ;; => (4 3 2 1)
(fldr + 0 lst) ;; => 10
(fldr * 1 lst) ;; => 24
(fldr cons '() lst) ;; => (1 2 3 4)
(define snoc (lambda (a b) (cons b a)))
(fldl snoc '() lst) ;; => ((((() . 1) . 2) . 3) . 4)
(fldr snoc '() lst) ;; => ((((() . 4) . 3) . 2) . 1)

Optional keyword argument and multiple arguments exercise

I have to write a function pow-increase which accepts an arbitrary number of arguments and one optional parameter. For each argument, it must calculate its power to some number, which is incremented for every argument, starting with the number 2, or, if the optional keyword argument is supplied, starts with that number.
Example:
> (pow-increase 2 2 2 2) ; 2^2 2^3 2^4 2^5
'(4 8 16 32)
> (pow-increase #start: 1 2 2 2 2) ; 2^1 2^2 2^3 2^4
'(2 4 8 16)
I've already written the function for the first call:
(define pow-increase
(lambda argList
(let* ([len (length argList)]
[exponents (range 2 (+ len 2) 1)])
(map (lambda (x) (expt (car x) (car(cdr x)))) (zip argList exponents)))))
Now I'd like to write the second version of the function (for the second call) but I don't know how to pass simultaneously an arbitrary number of arguments and an optional keyword argument. I've read here the syntax for optional arguments is: [optParamName value].
Thank you in advance for your help.
I'd go for
(define (pow-increase #:start (start 2) . lst)
(for/list ((e (in-list lst)) (i (in-naturals start)))
(expt e i)))
testing
> (pow-increase 2 2 2 2)
'(4 8 16 32)
> (pow-increase #:start 1 2 2 2 2)
'(2 4 8 16)
Note how elegant the code can become if you use Racket's for loops. If you want to stay with your initial version, the modification would be:
(define pow-increase
(lambda (#:start (start 2) . argList)
(let* ([len (length argList)]
[exponents (range start (+ len start) 1)])
(map (lambda (x) (expt (car x) (car (cdr x)))) (zip argList exponents)))))
but even then, you can simplify by getting rid of zip since map allows for more than one list:
(define pow-increase
(lambda (#:start (start 2) . argList)
(let* ([len (length argList)]
[exponents (range start (+ len start) 1)])
(map expt argList exponents))))

Insert-everywhere procedure

I am trying to write a procedure that takes a a symbol and a list and inserts the symbol at every possible position inside the given list (thus generating a list of lists). I have coded the following definitions, which I must implement:
1
(define (insert-at pos elmt lst)
(if (empty? lst) (list elmt)
(if (= 1 pos)
(cons elmt lst)
(cons (first lst)
(insert-at (- pos 1) elmt (rest lst))))))
2
(define (generate-all-pos start end)
(if (= start end)
(list end)
(cons start (generate-all-pos (+ start 1) end))))
1 takes a position in a list (number), a symbol and the list itself and inserts the symbol at the requested position.
2 takes a start and a target position (numbers) and creates a sorted list with numbers from start to target.
So far I have got this:
(define (insert-everywhere sym los)
(cond
[(empty? los) (list sym)]
[else (cons (insert-at (first (generate-all-pos (first los)
(first (foldl cons empty los)))) sym los) (insert-everywhere sym (rest los)))
]
)
)
Which results in
> (insert-everywhere 'r '(1 2 3))
(list (list 'r 1 2 3) (list 2 'r 3) (list 3 'r) 'r)
so I actually managed to move the 'r' around. I'm kind of puzzled about preserving the preceding members of the list. Maybe I'm missing something very simple but I've stared and poked at the code for quite some time and this is the cleanest result I've had so far. Any help would be appreciated.
Óscar López's answer shows how you can do this in terms of the procedures that you've already defined. I'd like to point out a way to do this that recurses down the input list. It uses an auxiliary function called revappend (I've taken the name from Common Lisp's revappend). revappend takes a list and a tail, and efficiently returns the same thing that (append (reverse list) tail) would.
(define (revappend list tail)
(if (null? list)
tail
(revappend (rest list)
(list* (first list) tail))))
> (revappend '(3 2 1) '(4 5 6))
'(1 2 3 4 5 6)
The reason that we're interested in such a function is that as we recurse down the input list, we can build up a list of the elements we've already seen, but it's in reverse order. That is, as we walk down (1 2 3 4 5), it's easy to have:
rhead tail (revappend rhead (list* item tail))
----------- ----------- -----------------------------------
() (1 2 3 4 5) (r 1 2 3 4 5)
(1) (2 3 4 5) (1 r 2 3 4 5)
(2 1) (3 4 5) (1 2 r 3 4 5)
(3 2 1) (4 5) (1 2 3 r 4 5)
(4 3 2 1) (5) (1 2 3 4 r 5)
(5 4 3 2 1) () (1 2 3 4 5 r)
In each of these cases, (revappend rhead (list* item tail)) returns a list with item inserted in one of the positions. Thus, we can define insert-everywhere in terms of rhead and tail, and revappend, if we build up the results list in reverse order, and reverse it at the end of the loop.
(define (insert-everywhere item list)
(let ie ((tail list)
(rhead '())
(results '()))
(if (null? tail)
(reverse (list* (revappend rhead (list* item tail)) results))
(ie (rest tail)
(list* (first tail) rhead)
(list* (revappend rhead (list* item tail)) results)))))
(insert-everywhere 'r '(1 2 3))
;=> '((r 1 2 3) (1 r 2 3) (1 2 r 3) (1 2 3 r))
What's interesting about this is that the sublists all share the same tail structure. That is, the sublists share the structure as indicated in the following “diagram.”
;=> '((r 1 2 3) (1 r 2 3) (1 2 r 3) (1 2 3 r))
; ----- +++ o
; +++ o
; o
The insert-everywhere procedure is overly complicated, a simple map will do the trick. Try this:
(define (insert-everywhere sym los)
(map (lambda (i)
(insert-at i sym los))
(generate-all-pos 1 (add1 (length los)))))
Also notice that in Racket there exists a procedure called range, so you don't need to implement your own generate-all-pos:
(define (insert-everywhere sym los)
(map (lambda (i)
(insert-at i sym los))
(range 1 (+ 2 (length los)))))
Either way, it works as expected:
(insert-everywhere 'r '(1 2 3))
=> '((r 1 2 3) (1 r 2 3) (1 2 r 3) (1 2 3 r))

Resources