Issue
I have an assignment to write a racket function that:
takes an origin, a destination (both as 3-character airport codes),
and the list of flight data and returns a list of lateness statistics
for all flights from the origin to the destination, with a the cons
cell (origin . destination) as the first element.
The data has to be formatted as six proportions, proportions of flights that are at least 1, 15, 30, 60, 120, and 180 minutes late.
In my code below, I wrote a tail-first recursive function that increments a value in a vector of length six every time a matching piece of flight data is found. It then, once the list of data has been recursively checked, a list of proportions is returned.
I'm getting the following error, indicating that part is void when the increment code is reached. Shouldn't part point to the generated vector throughout the function?
Error
vector-ref: contract violation
expected: vector?
given: #<void>
argument position: 1st
other arguments...: 3
Code
(require "ontime.rkt")
(define (ontime-stats-by-route orig dest data)
(define (aux orig dest data part)
(if (null? data)
(let ([sum (foldl + 0 (vector->list part))])
(list (cons orig dest)
(/ (vector-ref part 0) sum)
(/ (vector-ref part 1) sum)
(/ (vector-ref part 2) sum)
(/ (vector-ref part 3) sum)
(/ (vector-ref part 4) sum)
(/ (vector-ref part 5) sum)))
(if (and
(eq? orig (car (car (cdr (car data)))))
(eq? dest (car (cdr (car (cdr (car data)))))))
(let ([late (car (cdr (cdr (cdr (car data)))))])
(cond
[(>= late 180) (aux orig dest (cdr data)
(vector-set! part 5 (vector-ref part 5)))]
[(>= late 120) (aux orig dest (cdr data)
(vector-set! part 4 (vector-ref part 4)))]
[(>= late 60) (aux orig dest (cdr data)
(vector-set! part 3 (vector-ref part 3)))]
[(>= late 30) (aux orig dest (cdr data)
(vector-set! part 2 (vector-ref part 2)))]
[(>= late 15) (aux orig dest (cdr data)
(vector-set! part 1 (vector-ref part 1)))]
[(>= late 1) (aux orig dest (cdr data)
(vector-set! part 0 (vector-ref part 0)))]
[else (aux orig dest (cdr data) part)]))
(aux orig dest (cdr data) part))))
(let ([count (make-vector 6 0)])
(aux orig dest data count)))
(ontime-stats-by-route "BWI" "BDL" ontime)
The issue is that mutator functions like vector-set!, set-box!, etc. return #<void> because they're used for their mutation, not their return values. This is good because it encourages some separation between clearly functional code (which you can manipulate and reorder however you want) and clearly imperative code (which you have to be more careful with). This is also why these functions normally end with !.
So instead of passing (vector-set! part ....) in as the new part argument, you should do this mutation separately, and then pass part itself as the argument instead since it's now mutated:
(cond
[(>= late 180)
(vector-set! part 5 (vector-ref part 5))
(aux orig dest (cdr data) part)]
[(>= late 120)
(vector-set! part 4 (vector-ref part 4))
(aux orig dest (cdr data) part)]
[(>= late 60)
(vector-set! part 3 (vector-ref part 3))
(aux orig dest (cdr data) part)]
[(>= late 30)
(vector-set! part 2 (vector-ref part 2))
(aux orig dest (cdr data) part)]
[(>= late 15)
(vector-set! part 1 (vector-ref part 1))
(aux orig dest (cdr data) part)]
[(>= late 1)
(vector-set! part 0 (vector-ref part 0))
(aux orig dest (cdr data) part)]
[else
(aux orig dest (cdr data) part)])
Although, things like (vector-set! part 5 (vector-ref part 5)) aren't going to change the value at index 5 at all. Did you mean (vector-set! part 5 (add1 (vector-ref part 5))), given that you said you wanted to increment the values?
(cond
[(>= late 180)
(vector-set! part 5 (add1 (vector-ref part 5)))
(aux orig dest (cdr data) part)]
[(>= late 120)
(vector-set! part 4 (add1 (vector-ref part 4)))
(aux orig dest (cdr data) part)]
[(>= late 60)
(vector-set! part 3 (add1 (vector-ref part 3)))
(aux orig dest (cdr data) part)]
[(>= late 30)
(vector-set! part 2 (add1 (vector-ref part 2)))
(aux orig dest (cdr data) part)]
[(>= late 15)
(vector-set! part 1 (add1 (vector-ref part 1)))
(aux orig dest (cdr data) part)]
[(>= late 1)
(vector-set! part 0 (add1 (vector-ref part 0)))
(aux orig dest (cdr data) part)]
[else
(aux orig dest (cdr data) part)])
Related
I have to solve nest task using language Racket. By given list I have to create new list holding only elements that division by 10 has no leftover.
My code so far:
(define (brel x sp)
(cond ((null? sp) 0)
(( = (remainder (car sp) 10) 0) (car sp))
(else (brel x (cdr sp)))))
(define (spbr L)
(define (f l1)
(if (null? l1) '()
(cons (brel (car l1) L) (f (cdr l1)))))
(f L))
(spbr (list 50 5 3))
Give code currently count every repeats of elements in first list and add them in new one. What must I change to make it works?
You don't need a helper procedure, just build a new list with only the items that meet the condition:
(define (spbr L)
(cond ((null? L) '())
((= (remainder (car L) 10) 0)
(cons (car L) (spbr (cdr L))))
(else
(spbr (cdr L)))))
Using the filter procedure would be more idiomatic:
(define (spbr L)
(filter (lambda (e) (zero? (remainder e 10)))
L))
Either way, it works as expected:
(spbr '(50 5 3 70))
=> '(50 70)
I have a requirement to write a scheme procedure that takes a list as a parameter, which defines points awarded, player A score, and player B score. The function should determine who is the winner based on the scores:
For example, this the list of lists of scores I use below:
(define scores '(
(5 . (5 . 3)) ; points awarded = (car (car scores)) 5; player A score = cadr (car scores)) 5; player B score (cddr (car scores)) 3;
(5 . (6 . 2))
(5 . (8 . 4))
(5 . (5 . 1))))
So just to clarify, breaking down the first list in the list:
5 = points awarded (car (car scores)) ;
A = Player A Score (cadr (car scores)) ; (which is 5 on the first element, 6 on the 2nd, etc.)
B = Player B Score (cddr (car scores)) ; (which is 3 on the first element, 2 on the 2nd, etc.)
The problem is I have made a recursive function which blows up on the 1st iteration of the recursion. But I don't understand why?
#lang scheme
(define (game-winner scores)
(define A 0)
(define B 0)
(cond
((empty? scores) '()))
(if ( > (cadr (car scores)) (cddr (car scores)) )
(+ A (car (car scores)))
(+ B (car (car scores))))
(game-winner (cdr scores)))
OUTPUT:
car: contract violation
expected: pair?
given: ()
The part that confuses me is that when I simulate running through the 1st iteration of the recursion and get the values the function should have, I get correct values:
;first loop through function
(car (car scores)) ; 5
(cadr (car scores)) ; 5
(cddr (car scores)) ; 3
;second loop (1st recursive call)
(cadr (car (cdr scores))) ; 6
(cddr (car (cdr scores))) ; 2
So if I don't understand why it's blowing up? It should work in the same way as the first call before the recursion. But I obviously am missing something. Any ideas?
P.S.
if I just return the A or B instead of the recursive call I get 0:
(define (game-winner scores)
(define A 0)
(define B 0)
(cond
((empty? scores) '()))
(if ( > (cadr (car scores)) (cddr (car scores)) )
(+ A (car (car scores)))
(+ B (car (car scores))))
A)
OUTPUT:
0
How come the value of A (which should be 5) after the first call doesn't show when I oupout A? Is A only in scope of the if loop? If so, how do I get it to exist outside that scope?
based on feedback from #Sylwester I modified by procedure to:
#lang scheme
(define (game-winner scores)
(define A 0)
(define B 0)
(cond
((empty? scores) '())
(( > (cadr (car scores)) (cddr (car scores)))
(cons (+ A (car (car scores))) (game-winner (cdr scores))))
(cons (+ B (car (car scores))) (game-winner (cdr scores)))))
OUTPUT:
(5 5 5 5)
So I feel like I'm getting closer. But I need to be able to add these all together for A or for B and output the winner (A or B). How do I build on top of this to get that to work?
You code has a lot of dead code that is never used no matter what is the outcome and in the end the last expression will do (cdr scores) no matter if it's empty or not.
(define (game-winner scores)
;; Two constants that never change from 0
(define A 0)
(define B 0)
;; Dead code. Werther it's '() or #<undefined>
(cond
((empty? scores) '()))
;; Dead code. Becomes (+ 0 (car scores)) but never used
(if ( > (cadr (car scores)) (cddr (car scores)) )
(+ A (car (car scores))) ; + never mutates A
(+ B (car (car scores)))) ; + never mutates B
;; Infinite recursion. Happens no matter what is the outcome of the dead code
(game-winner (cdr scores)))
So when you write a cond or if it should handle all the things that happen so that it is the last expression:
(define (game-winner scores)
; local defines
(define some-var some-expression)
...
; one expression, the result of this is the result of the procedure.
(if (empty? scores)
'()
(if ....)))
EDIT
Here is an example of a recursion using arguments to accumulate the scores and in the end determine who has the highest score:
(define (game-winner scores)
(let loop ((scores scores) (a 0) (b 0))
(if (empty? scores)
(cond ((> a b) 'A)
((< a b) 'B)
(else 'TIE)))
(loop (cdr scores)
(+ a (cadar scores))
(+ b (cddar scores))))))
(game-winner scores)
; ==> A
The following is code to a problem that I have been working on for a few days. The problem I encountered is that for some reason when I call:
(apa-multi '(7 3 1 2) '(6 1 4))
the return is:
'(4 8 9 5 6 8)
The answer that it should output is
'(4 4 8 9 5 6 8)
When I call:
(apa-multi '(3 1 2) '(6 1 4))
The output is:
'(1 9 1 5 6 8)
which is correct.
I have debugged my code multiple times, and I can't seem to find out what the problem is (by the way, I know that the "remove-empty" function that I wrote is most likely unnecessary). Can anyone tell me where I am going wrong here? (My goal for this problem is to keep the arbitrary precision numbers in list format, and I can not create a function that converts numbers from list->num or num->list.) I believe that I have provided all of the necessary code for someone to work out what I was going for, but if not please let me know. The hint that I have for this is that " Multiplication of d = dndn−1 ...d1 by e = emem−1 ...e1 can be carried out by the rule de=d∗e1 +10∗(d∗em em−1...e2).)"
(define (remove-empty L)
(define (remove-empty-h L accum)
(cond ((null? L) accum)
((null? (car L))
(remove-empty (cdr L)))
(else (cons (car L) (remove-empty-h (cdr L) accum)))))
(remove-empty-h L '()))
(define (apa-add lst1 lst2)
(define (apa-add-h lst1 lst2 carry)
(cond ((and (null? lst1) (null? lst2))
(if (not (= 0 carry))
(list carry)
'()))
((null? lst1) (append (apa-add-h lst1 '() carry)
(list (+ (car (reverse-l lst2)) carry))
(reverse-l(cdr (reverse-l lst2)))))
((null? lst2) (append (apa-add-h '() lst2 carry)
(list (+ (car (reverse-l lst1)) carry)))
(reverse-l(cdr (reverse-l lst1))))
(else
(append (apa-add-h (cdr lst1) (cdr lst2) (quotient (+ (car lst1) (car lst2) carry) 10))
(list (modulo (+ (car lst1) (car lst2) carry) 10))))))
(apa-add-h (reverse-l lst1) (reverse-l lst2) 0))
(define (d-multiply lst factor)
(define (d-multiply-h lst factor carry)
(cond ((null? lst) (if (= carry 0)
'()
(list carry)))
((>= (+ (* (car lst) factor) carry) 10)
(append ;(list (check-null-and-carry-mult lst carry))
(d-multiply-h (cdr lst) factor (quotient (+ (* (car lst) factor) carry) 10))
(list (modulo (+ (* (car lst) factor) carry) 10))))
(else (append ;(list (check-null-and-carry-mult lst carry))
(d-multiply-h (cdr lst) factor (quotient(+ (* (car lst) factor) carry) 10))
(list (+ (* (car lst) factor) carry))))))
(remove-empty (d-multiply-h (reverse-l lst) factor 0)))
(define (nlength l)
(if (null? l)
0
(+ 1 (nlength (cdr l)))))
(define (apa-multi d e)
(define temp '())
(cond ((= (max (nlength e) (nlength d)) (nlength e))
(set! temp e)
(set! e d)
(set! d temp))
(else
(set! temp d)
(set! d e)
(set! e temp)))
(define (apa-multi-h d e)
(cond ((null? e) (list 0))
(else (append (apa-add (d-multiply d (car e))
(append (apa-multi-h d (cdr e)) (list 0)))))))
(apa-multi-h d (reverse-l e)))
The reason your code does not work is because your apa-add is broken. For example:
> (apa-add '(7 3 1 2) '(6 1 4))
'(9 2 6)
> (+ 7312 614)
7926
The rest of your code seems to work, at least for your 2 examples, if you use a working apa-add.
I admit I did not try to understand your code fully; the poor formatting and the set! procedures at the end made me want to start from scratch. So even if you could simple correct your apa-add, maybe have a look at my version anyway, because it is way shorter and probably easier to understand.
Building on my previous answer for apa-add multiplication is a matter of apa-adding, multiplying one list by a digit at a time, and adding zeroes at the end of the intermediary multiplications just as you'd do it manually:
(define (car0 lst) (if (empty? lst) 0 (car lst)))
(define (cdr0 lst) (if (empty? lst) empty (cdr lst)))
(define (apa-add l1 l2) ; apa-add (see https://stackoverflow.com/a/19597007/1193075)
(let loop ((l1 (reverse l1)) (l2 (reverse l2)) (carry 0) (res '()))
(if (and (null? l1) (null? l2) (= 0 carry))
res
(let* ((d1 (car0 l1)) (d2 (car0 l2)) (ad (+ d1 d2 carry)) (dn (modulo ad 10)))
(loop (cdr0 l1) (cdr0 l2) (quotient (- ad dn) 10) (cons dn res))))))
(define (mult1 n lst) ; multiply a list by one digit
(let loop ((lst (reverse lst)) (carry 0) (res '()))
(if (and (null? lst) (= 0 carry))
res
(let* ((c (car0 lst)) (m (+ (* n c) carry)) (m0 (modulo m 10)))
(loop (cdr0 lst) (quotient (- m m0) 10) (cons m0 res))))))
(define (apa-multi l1 l2) ; full multiplication
(let loop ((l2 (reverse l2)) (app '()) (res '()))
(if (null? l2)
res
(let* ((d2 (car l2)) (m (mult1 d2 l1)) (r (append m app)))
(loop (cdr l2) (cons '0 app) (apa-add r res))))))
Not sure why it doesn't work, all those appends and reverses are hard to follow, and not sure what's going on with all that set! stuff. Putting the state into a tail call is a lot easier to follow and usually more efficient to boot.
(define (apa-add . Lists)
(define (cdrs-no-null L)
(cond ((null? L) '())
((null? (cdar l)) (cdrs-no-null (cdr L)))
(else (cons (cdar l) (cdrs-no-null (cdr l))))))
(let loop ((carry 0) (Lists (map reverse Lists)) (sum '()))
(if (null? Lists)
(if (zero? carry) sum (cons carry sum))
(loop (quotient (fold + carry (map car Lists)) 10)
(cdrs-no-null Lists)
(cons (modulo (fold + carry (map car Lists)) 10) sum)))))
(define (apa-mult . Lists)
(define (mult-by-factor n order L)
(let loop ((order order) (L (reverse L)) (carry 0) (sum '()))
(cond ((> order 0) (loop (- order 1) L carry (cons 0 sum)))
((null? L) (if (zero? carry)
sum
(cons carry sum))) ;;bug here if carry > 9
(else (loop 0
(cdr L)
(quotient (+ carry (* n (car L))) 10)
(cons (modulo (+ carry (* n (car L))) 10) sum))))))
(define (apa-mult2 L1 L2)
(let ((rL1 (reverse L1))
(rL2 (reverse L2))
(zip-with-order
(lambda (L)
(let loop ((order 0) (L L) (accum '()))
(if (null? L)
accum
(loop (+ 1 order)
(cdr L)
(cons (cons (car L) order) accum)))))))
(fold apa-add '(0) (map (lambda (x)
(mult-by-factor (car x) (cdr x) L2))
(zip-with-order rl1)))))
(fold apa-mult2 '(1) Lists)))
(apa-mult '(3 1 2) '(6 1 4)))
;Value 7: (1 9 1 5 6 8)
(apa-mult '(2 0 0) '(3 1 2) '(6 1 4))
;Value 8: (3 8 3 1 3 6 0 0)
(apa-mult '(7 3 1 2) '(6 1 4))
;Value 9: (4 4 8 9 5 6 8)
I am writing a function to count the number of ways to make change in scheme given a list of denominations and an amount. My code is as follows, but it does not work as intended. Should I be using cons instead of the + operator? Should the third line down's base case be the empty list?
(define (change k l)
(cond ((= k 0) 1)
((or (< k 0) (null? l)) 0)
(else (+ (change k (cdr l))
(change (- k (car l))
(cdr l))))))
Test:
(change 11 (list 1 5 10 25))
If the returned value is just a number then forget about cons and '() for building the output, and only use car, cdr, null? for processing the input. Other than that, be aware that there's a small mistake in the last line of your code, here's the fixed version:
(define (change k l)
(cond ((= k 0) 1)
((or (< k 0) (null? l)) 0)
(else
(+ (change k (cdr l))
(change (- k (car l)) l))))) ; don't do (cdr l) here
Now it works as expected:
(change 11 (list 1 5 10 25))
=> 4
Given a list of numbers, say, (1 3 6 10 0), how do you compute differences (xi - xi-1), provided that you have x-1 = 0 ?
(the result in this example should be (1 2 3 4 -10))
I've found this solution to be correct:
(define (pairwise-2 f init l)
(first
(foldl
(λ (x acc-data)
(let ([result-list (first acc-data)]
[prev-x (second acc-data)])
(list
(append result-list (list(f x prev-x)))
x)))
(list empty 0)
l)))
(pairwise-2 - 0 '(1 3 6 10 0))
;; => (1 2 3 4 -10)
However, I think there should be more elegant though no less flexible solution. It's just ugly.
I'm new to functional programming and would like to hear any suggestions on the code.
Thanks.
map takes multiple arguments. So I would just do
(define (butlast l)
(reverse (cdr (reverse l))))
(let ((l '(0 1 3 6 10)))
(map - l (cons 0 (butlast l)))
If you want to wrap it up in a function, say
(define (pairwise-call f init l)
(map f l (cons init (butlast l))))
This is of course not the Little Schemer Way, but the way that avoids writing recursion yourself. Choose the way you like the best.
I haven't done scheme in dog's years, but this strikes me as a typical little lisper type problem.
I started with a base definition (please ignore misplacement of parens - I don't have a Scheme interpreter handy:
(define pairwise-diff
(lambda (list)
(cond
((null? list) '())
((atom? list) list)
(t (pairwise-helper 0 list)))))
This handles the crap cases of null and atom and then delegates the meat case to a helper:
(define pairwise-helper
(lambda (n list)
(cond
((null? list) '())
(t
(let ([one (car list)])
(cons (- one n) (pairwise-helper one (cdr list))))
))))
You could rewrite this using "if", but I'm hardwired to use cond.
There are two cases here: null list - which is easy and everything else.
For everything else, I grab the head of the list and cons this diff onto the recursive case. I don't think it gets much simpler.
After refining and adapting to PLT Scheme plinth's code, I think nearly-perfect solution would be:
(define (pairwise-apply f l0 l)
(if (empty? l)
'()
(let ([l1 (first l)])
(cons (f l1 l0) (pairwise-apply f l1 (rest l))))))
Haskell tells me to use zip ;)
(define (zip-with f xs ys)
(cond ((or (null? xs) (null? ys)) null)
(else (cons (f (car xs) (car ys))
(zip-with f (cdr xs) (cdr ys))))))
(define (pairwise-diff lst) (zip-with - (cdr lst) lst))
(pairwise-diff (list 1 3 6 10 0))
; gives (2 3 4 -10)
Doesn't map finish as soon as the shortest argument list is exhausted, anyway?
(define (pairwise-call fun init-element lst)
(map fun lst (cons init-element lst)))
edit: jleedev informs me that this is not the case in at least one Scheme implementation. This is a bit annoying, since there is no O(1) operation to chop off the end of a list.
Perhaps we can use reduce:
(define (pairwise-call fun init-element lst)
(reverse (cdr (reduce (lambda (a b)
(append (list b (- b (car a))) (cdr a)))
(cons (list init-element) lst)))))
(Disclaimer: quick hack, untested)
This is the simplest way:
(define (solution ls)
(let loop ((ls (cons 0 ls)))
(let ((x (cadr ls)) (x_1 (car ls)))
(if (null? (cddr ls)) (list (- x x_1))
(cons (- x x_1) (loop (cdr ls)))))))
(display (equal? (solution '(1)) '(1))) (newline)
(display (equal? (solution '(1 5)) '(1 4))) (newline)
(display (equal? (solution '(1 3 6 10 0)) '(1 2 3 4 -10))) (newline)
Write out the code expansion for each of the example to see how it works.
If you are interested in getting started with FP, be sure to check out How To Design Program. Sure it is written for people brand new to programming, but it has tons of good FP idioms within.
(define (f l res cur)
(if (null? l)
res
(let ((next (car l)))
(f (cdr l) (cons (- next cur) res) next))))
(define (do-work l)
(reverse (f l '() 0)))
(do-work '(1 3 6 10 0))
==> (1 2 3 4 -10)