I understand the logic behind how Kadane's Algorithm (maximum sum of all sequential sub-arrays in an array) works in "pseudo-code," and I'm sure I could implement it as a function in C or C++. However, I'm trying to implement it using lists in Scheme (Racket; the file extension is .rkt), which I have no experience with.
The end result I'm looking for is...
Input: (maxsum `(1 4 -2 1))
Output: 5
So far I've developed two helper functions I may be able to use within the maxsum function.
(1) size: returns the number of elements in a list.
(define size
(lambda (list)
(cond
[(not (list? list)) 0]
[(null? list) 0]
[else (+ 1 (size (cdr list)))]
)
)
)
(2) sum: returns the sum of all elements in a list.
(define sum
(lambda (list)
(cond
[(not (list? list)) 0]
[(null? list) 0]
[else (+ (car list) (sum (cdr list)))]
)
)
)
How would I go about defining/designing the maxsum function?
Here is a version patterned after the Phyton code on wikipedia:
(define (maxsum lst)
(define (aux lst max-ending-here max-so-far)
(if (null? lst)
max-so-far
(let ((new-max-ending-here (max 0 (+ (car lst) max-ending-here))))
(aux (cdr lst) new-max-ending-here (max max-so-far new-max-ending-here)))))
(aux lst 0 0))
(maxsum '(1 4 -2 1)) ; => 5
(maxsum '(-2 1 -3 4 -1 2 1 -5 4)) ; => 6
It is tail recursive, so it will be compiled into an efficient iterative program.
Almost literal translation of [Python code][1] to Racket:
(define (max_subarray A)
(define-values (max_ending_here max_so_far) (values 0 0))
(for ((x (in-list A)))
(set! max_ending_here (max 0 (+ max_ending_here x)))
(set! max_so_far (max max_so_far max_ending_here)))
max_so_far)
Testing:
(max_subarray `(1 4 -2 1))
(max_subarray '(-2 1 -3 4 -1 2 1 -5 4))
Output:
5
6
Please note that recursive functions are generally preferred over iterative ones in Racket and use of "set!" is discouraged here.
Following uses higher functions like apply and map for different steps:
(define (maxsum lst)
(define subarrays
(for*/list ((start (length lst))
(len (range 1 (- (add1(length lst)) start))))
(take (drop lst start) len)))
(define sumlist (map (λ (x) (apply + x)) subarrays))
(apply max sumlist))
Following is more verbose form:
(define (maxsum lst)
(define subarrays
(for*/list ((start (length lst))
(len (range 1 (- (add1(length lst)) start))))
(take (drop lst start) len)))
(displayln "\n----- SUBARRAYS ---------")
(displayln subarrays)
(define sumlist (map (λ (x) (apply + x)) subarrays))
(displayln "----- SUMS OF SUBARRAYS ---------")
(displayln sumlist)
(display "MAX SUM:")
(apply max sumlist))
Testing:
(maxsum `(1 4 -2 1))
(maxsum '(-2 1 -3 4 -1 2 1 -5 4))
Output:
----- SUBARRAYS ---------
((1) (1 4) (1 4 -2) (1 4 -2 1) (4) (4 -2) (4 -2 1) (-2) (-2 1) (1))
----- SUMS OF SUBARRAYS ---------
(1 5 3 4 4 2 3 -2 -1 1)
MAX SUM:5
----- SUBARRAYS ---------
((-2) (-2 1) (-2 1 -3) (-2 1 -3 4) (-2 1 -3 4 -1) (-2 1 -3 4 -1 2) (-2 1 -3 4 -1 2 1) (-2 1 -3 4 -1 2 1 -5) (-2 1 -3 4 -1 2 1 -5 4) (1) (1 -3) (1 -3 4) (1 -3 4 -1) (1 -3 4 -1 2) (1 -3 4 -1 2 1) (1 -3 4 -1 2 1 -5) (1 -3 4 -1 2 1 -5 4) (-3) (-3 4) (-3 4 -1) (-3 4 -1 2) (-3 4 -1 2 1) (-3 4 -1 2 1 -5) (-3 4 -1 2 1 -5 4) (4) (4 -1) (4 -1 2) (4 -1 2 1) (4 -1 2 1 -5) (4 -1 2 1 -5 4) (-1) (-1 2) (-1 2 1) (-1 2 1 -5) (-1 2 1 -5 4) (2) (2 1) (2 1 -5) (2 1 -5 4) (1) (1 -5) (1 -5 4) (-5) (-5 4) (4))
----- SUMS OF SUBARRAYS ---------
(-2 -1 -4 0 -1 1 2 -3 1 1 -2 2 1 3 4 -1 3 -3 1 0 2 3 -2 2 4 3 5 6 1 5 -1 1 2 -3 1 2 3 -2 2 1 -4 0 -5 -1 4)
MAX SUM:6
Related
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.
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)))))
I am writing a scheme program in dr racket that takes a list of numbers representing a matrix sets an item in the list to the number given. So far it works for case row 1 column 1 and knows where to place the number but any other case it makes lists of lists. I have attempted to make a function to help but still receive the same error. Any help would be greatly appreciated.
The error I'm getting:
(setCell Matrix 2 2 9)
((2 4 6 8) (1 (9 5 7)) (2 9 0 1))
I need
(setCell Matrix 2 2 9)
((2 4 6 8) (1 9 5 7) (2 9 0 1))
Any help would be greatly appreciated.
(define Matrix '(( 2 4 6 8 )( 1 3 5 7)( 2 9 0 1)))
;getCell Matrix Row Column
;if i want row 2 col 2
(define (getCell Matrix Row Column)
(if (= Row 1)
(if (= Column 1)
(car (car Matrix))
(getCell (cons (cdr (car Matrix)) ()) Row (- Column 1))
)
(getCell (cdr Matrix) (- Row 1) Column)
)
)
;> (getCell Matrix 1 1)
;2
;(define Matrix '(( 2 4 6 8 )( 1 3 5 7)( 2 9 0 1)))
;setCell Matrix Row Column Item
(define (setCell Matrix Row Column Item)
(if (= Row 1)
(if (= Column 1)
(helpMe Matrix Item)
(cons
(cons (car (car Matrix))
(setCell (cons (cdr (car Matrix)) ()) Row (- Column 1) Item))
(cdr Matrix))
)
(cons (car Matrix) (setCell (cdr Matrix) (- Row 1) Column Item))
)
)
(define (helpMe Matrix Item)
(cons (cons Item (cdr (car Matrix))) (cdr Matrix)))
;ERROR:
;>(setCell Matrix 2 2 9)
;((2 4 6 8) (1 (9 5 7)) (2 9 0 1))
;> (setCell Matrix 1 1 9)
;((9 4 6 8) (1 3 5 7) (2 9 0 1))
This is a common problem.
The basic idea is coordinate, data structure shape, make a good abstraction, visting all element, given coordinate get corresponding value.
In here we define upper left element is (1,1) (so we have to minus 1)
First we want build a same matrix. Second each value determine by function f. And f input is coordinate (i,j) so f is a function call upgrade function. You can set any rule. Like a common question is ask you build diagonal matrix the rule will be i=j. (It a beautiful abstraction)
It's means we must make this coordinate
(0,0) (0,1) (0,2) ... (0,(length (first m))
(1,0) (1,1) (1,2) ... (1,(length (first m))
(2,0 ...
...
(length of matrix),0) ... ((length of matrix),(length (first m)))
Then we send coordinate to f. So we can let f return original value in input matrix but when i = row and j = column we return new value (item). The same idea you can build vector or orthers not just list. The same idea can use to build triangle circle or something else not just rectangle.
#lang racket
(define (setCell m row column item)
(local ((define index-i (- row 1))
(define index-j (- column 1))
(define (f i j)
(if (and (= i index-i) (= j index-j))
item
(list-ref (list-ref m i) j))))
(build-list (length m) (lambda (i) (build-list (length (first m)) (lambda (j) (f i j)))))))
;;; TEST
(define k
'((1 2 3)
(1 2 3)
(1 2 3)))
(setCell k 1 1 100)
(setCell k 2 3 100)
(define k2
'((1 2 3)
(1 2 3)))
(setCell k2 1 3 100)
(setCell k2 2 3 100)
I am writing a scheme program in dr racket that takes a list of numbers representing a matrix sets an item in the list to the number given.
#lang racket
(define matrix-id (build-list 4 (λ (x) (build-list 4 (λ (y) (if (= x y) 1 2))))))
;; => '((1 0 0 0) (0 1 0 0) (0 0 1 0) (0 0 0 1))
;; [X] Number Number X [List-of [Lis-of X]] -> [List-of [Lis-of X]]
(define (set-mat row col item mat)
(for/list ([l mat] [i (length mat)])
(for/list ([e l] [j (length l)])
(if (and (= i row) (= j col))
item
e))))
(set-mat 1 1 'fef matrix-id)
;; => '((1 0 0 0) (0 fef 0 0) (0 0 1 0) (0 0 0 1))
I'm trying to implement a recursive function (sums cero) that given a list of integers, it prints all possible secuences of consecutive numbers that sum up 0
Example 1:
(sum-zero ‘(4 2 -3 -1 0 4))
=> (-3 -1 0 4)
(0)
Example 2:
(sum-zero ‘(3 4 -7 3 1 3 1 -4 -2 -2))
=> (3 4 -7)
(4 -7 3)
(-7 3 1 3)
(3 1 -4)
(3 1 3 1 -4 -2 -2)
(3 4 -7 3 1 3 1 -4 -2 -2)
You function needs to have a helper that has arguments for 1. the list of available numbers, 2. the current numbers, 3. the list of results of combination that sum to zero so far. Here is how I would have done it, with some parts left out to keep us from doing your homework:
(define (sum-zero lst)
;; insert e such that the resulting list i ssorted
;; (insert 3 '(1 3 4)) ; ==> (1 3 3 4)
(define (insert e lst)
<implement>)
;; main logic
(define (helper lst acc res)
(if (null? lst)
res
(let* ((new-acc (insert (car lst) acc))
(res (if <should add new-acc to res>
(cons new-acc res)
res)))
;; call the helper skipping the current element in the result
;; and use that as the result on the secon call the includes it
(helper (cdr lst)
new-acc
(helper (cdr lst) acc res)))))
;; notice () is already in the results
(helper lst '() '(())))
Testing it is straightforward. I got some more results than you though but I believe it is correct:
(sum-zero '(3 4 -7 3 1 3 1 -4 -2 -2))
; ==> ((-7 -4 -2 -2 1 1 3 3 3 4)
; (-7 -4 -2 3 3 3 4)
; (-7 -2 -2 1 1 3 3 3)
; (-7 -4 1 1 3 3 3)
; (-7 -2 3 3 3)
; (-7 -2 -2 1 3 3 4)
; (-7 -4 1 3 3 4)
; (-7 -2 1 1 3 4)
; (-7 3 4)
; (-4 -2 1 1 4)
; (-4 -2 -2 1 3 4)
; (-2 -2 4)
; (-4 4)
; (-7 1 3 3)
; (-4 -2 -2 1 1 3 3)
; (-4 -2 3 3)
; (-2 1 1)
; (-2 -2 1 3)
; (-4 1 3)
; ())
I can see how it does it on
(foldl * 1 '(1 2 3 4 5)) == 120
(foldr * 1 '(1 2 3 4 5)) == 120
but I can't figure out how it gets 2 for
(foldl - 1 '(1 2 3 4 5)) == 2
I would've thought (foldl - 1 '(1 2 3 4 5)) would be ((((1-1)-2)-3)-4)-5), a negative number. What did I miss?
I can tho see why
(foldl + 1 '(1 2 3 4 5)) == 16
(foldl - 1 '(1 2 3 4 5)) is actually equivalent to (- 5 (- 4 (- 3 (- 2 (- 1 1))))), or, in infix, 5 - (4 - (3 - (2 - (1 - 1)))).
Likewise, (foldr - 1 '(1 2 3 4 5)) is actually equivalent to (- 1 (- 2 (- 3 (- 4 (- 5 1))))), or, in infix, 1 - (2 - (3 - (4 - (5 - 1)))).