I'm learning Scheme using racket. I made the following program but it gives a contract violation error.
expected: (exact-nonnegative-integer? . -> . any/c)
given: '()
The program finds a list of all numbers in an interval which are divisible by 3 or 5.
#lang racket
;;Global Definitions
(define upper-bound 10)
(define lower-bound 0)
;;set-bounds: Int, Int -> ()
(define (set-bounds m n)
(set! upper-bound (max m n))
(set! lower-bound (min m n)))
;;get-numbers: () -> (Int)
(define (get-numbers)
(build-list upper-bound '()))
;;make-list: Int, (Int) -> (Int)
(define (build-list x y)
(cond
[(= x lower-bound) y]
[(= (modulo x 5) 0) (build-list (sub1 x) (cons x y))]
[(= (modulo x 3) 0) (build-list (sub1 x) (cons x y))]
[else (build-list (sub1 x) y)]))
EDIT: I made the changes suggested by Oscar Lopez.
An alternative method can be with the use of for/list to create the list:
(define (build-list ub lst)
(for/list ((i (range lb ub))
#:when (or (= 0 (modulo i 3))
(= 0 (modulo i 5))))
i))
Usage:
(define lb 0)
(build-list 10 '())
Output:
'(0 3 5 6 9)
Edit:
Actually lst is not needed here:
(define (build-list ub)
(for/list ((i (range lb ub))
#:when (or (= 0 (modulo i 3))
(= 0 (modulo i 5))))
i))
So one can call:
(build-list 10)
Following is a modification of the recursion method (uses 'named let'):
(define (build-list2 ub)
(let loop ((x ub) (lst '()))
(cond
[(= x lb) lst]
[(= (modulo x 5) 0) (loop (sub1 x) (cons x lst))]
[(= (modulo x 3) 0) (loop (sub1 x) (cons x lst))]
[else (loop (sub1 x) lst)])))
Also, if you always have to call your function with an empty list '(), you can put this as default in your argument list:
(build-list x (y '()))
Then you can call with simplified command:
(build-list 10)
You should test first the condition where the recursion stops - namely, when x equals the lower-bound:
(define (build-list x y)
(cond
[(= x lower-bound) y]
[(= (modulo x 5) 0) (build-list (sub1 x) (cons x y))]
[(= (modulo x 3) 0) (build-list (sub1 x) (cons x y))]
[else (build-list (sub1 x) y)]))
Related
(defun modsum2 (n)
(let ((summ 0))
(if (>= n 3)
(if (or (zerop (mod n 3)) (zerop (mod n 5)))
(progn (setq summ (+ n summ))
(modsum2 (1- n)))
(modsum2 (1- n)))
(print summ))))
I am trying to get the sum of multiples of 3 and 5 below the given number. But the code always returns to 0. What is the problem with it?
(defun modsum2 (n)
(let ((summ 0))
(if (>= n 3)
(if (or (zerop (mod n 3)) (zerop (mod n 5)))
(progn (setq summ (+ n summ))
(modsum2 (1- n)))
(modsum2 (1- n)))
(print summ))))
Right, now you got it indented. Let's trace it:
* (trace modsum2)
(MODSUM2)
* (modsum2 4)
0: (MODSUM2 4)
1: (MODSUM2 3)
2: (MODSUM2 2)
0 2: MODSUM2 returned 0
1: MODSUM2 returned 0
0: MODSUM2 returned 0
0
You can see that 0 gets printed when the argument to n is 2. Since the print form is also the last form, the function returns its value. (print 0) returns 0. Since the return value is in your function used, it just gets returned from each recursive call.
A typical way to repair it would be to have a local recursive function using labels inside the let. You then need to call the function. Later you would need to return the summ.
;; your function has some flaws
(defun modsum2 (n)
(let ((summ 0)) ;; in every call, `summ` is put to `0`!
(if (>= n 3) ;; for n = 2, the alternative `(print summ)` is executed
(if (or (zerop (mod n 3)) (zerop (mod n 5)))
(progn (setq summ (+ n summ))
(modsum2 (1- n)))
(modsum2 (1- n)))
(print summ)))) ;; for n = 2 already this is called
;; since summ is set to `0` for this last modsum2 call, it prints 0
;; tail call recursion with inner function
(defun modsum2 (n)
(let ((summ 0))
(labels ((.modsum2 (.n)
(cond ((zerop .n) summ)
((or (zerop (mod .n 3)) (zerop (mod .n 5)))
(setq summ (+ .n summ))
(.modsum2 (1- .n)))
(t (.modsum2 (1- .n))))))
(print (.modsum2 n)))))
;; tail call recursion with optional accumulator for the proper start
(defun modsum2 (n &optional (acc 0))
(cond ((zerop n) acc)
((or (zerop (mod n 3))
(zerop (mod n 5)))
(modsum2 (1- n) (+ acc n)))
(t (modsum2 (1- n) acc))))
;; using loop
(defun modsum2 (n)
(loop for x from 1 to n
when (or (zerop (mod x 3)) (zerop (mod x 5)))
sum x into res
finally (return res)))
;; which is equivalent to (thanks #Rainer Joswig):
(defun modsum2 (n)
(loop for x from 1 to n
when (or (zerop (mod x 3)) (zerop (mod x 5)))
sum x))
;; using reduce or apply
(defun modsum2 (n)
(reduce #'+ (remove-if-not #'(lambda (x) (or (zerop (mod x 3))
(zerop (mod x 5))))
(loop for x from 1 to n))))
;; instead of `reduce`, `apply` would work, too.
You’re doing far too much work. Just do inclusion-exclusion:
(defun modsum2 (max)
(let ((a (floor max 3))
(b (floor max 5))
(c (floor max 15)))
(/ (- (+ (* 3 a (1+ a))
(* 5 b (1+ b)))
(* 15 c (1+ c)))
2)))
To extend this a bit to more than just 3,5:
(defun multsum (k max)
"The sum of multiples of `k' below `max'"
(let ((a (floor max k)))
(* k a (1+ a))))
(defun subsequences-reduce (f items)
(unless items (return ()))
(loop for (item . rest) on items
collect (cons 1 item)
nconc (loop for (len . val) in (subsequences-reduce f rest)
collect (cons (1+ len) (funcall f item val)))))
(defun modsum (max &rest nums)
(loop for (len . lcm) in (subsequences-reduce #'lcm nums)
sum (* (if (oddp len) 1 -1) (multsum lcm max))))
(defun modsum2 (max) (modsum max 3 5))
I have solved the same problem last week for project euler. I have noticed the way I wrote it does not included in answers. Dropping it here, it might be useful.
;;finds the multiple of 3's and 5's below the number n
;;since "or" turns t, whenever one of its arguments returns t. No need to substract multiple of 15.
(defun modsum2 (n)
(cond ((< n 3) 0)
(t (do ((i 3 (1+ i))
(summ 0))
((> i n) summ)
(cond ((or (zerop (mod i 3))
(zerop (mod i 5)))
(setq summ (+ summ i))))))))
This is what my wason-deck produces:
((15 . D) (35 . H) (3 . B) (19 . K) (L . 15) (A . 16) (T . 23) (R . 53)
(N . 13) (M . 7) (I . 52) (35 . Q) (S . 19) (Y . 29) (45 . G) (44 . W)
(11 . V) (J . 25) (21 . F) (39 . Z) (25 . X) (50 . E) (5 . P) (33 . C)
(O . 34))
this being a list of pairs representing a Wason deck. (See this, Example 6). In the deck there should be all the letters of the alphabet matched with even or odd numbers depending on whether a vowel or consonant respectively. I randomly shuffle and flip the cards as you can see. Then I (optionally) randomly pollute the deck by occasionally breaking the vowel:even, consonant:odd rule. Here's the code I've come up with:
(defun wason-deck (&optional (p 0))
"This `consolst` and `vowlist` building is unnecessary, but a good exercise"
(let* ((alphab '(a b c d e f g h i j k l m n o p q r s t u v w x y z))
(consonents '(b c d f g h j k l m n p q r s t v w x y z))
(consolst (remove 'NIL (mapcar (lambda (x) (find x consonents)) alphab)))
(vowlst (remove 'NIL (mapcar (lambda (x) (find x '(a e i o))) alphab)))
(wdeck '()))
(labels ((make-consodeck ()
(mapcar (lambda (x) (let ((num (random 54)))
(cons x (if (evenp num)
(1+ num)
num)))) consolst))
(make-voweldeck ()
(mapcar (lambda (x) (let ((num (random 54)))
(cons x (if (oddp num)
(1+ num)
num)))) vowlst))
(swap (slst el1 el2)
(let ((tmp (elt slst el1)))
(setf (elt slst el1) (elt slst el2))
(setf (elt slst el2) tmp)))
(shuffle (slst)
(loop for i in (reverse (range (length slst) :min 1))
do (let ((j (random (+ i 1))))
(swap slst i j)))
slst)
(flip (flst)
(mapcar (lambda (x) (let ((num (random 2)))
(if (zerop num)
(cons (cdr x) (car x))
x))) flst)))
(setf wdeck (flip (shuffle (append (make-consodeck) (make-voweldeck)))))
(if (zerop p) wdeck
(mapcar (lambda (x) (let ((num (random 6)))
(cond ((and (zerop num) (numberp (car x))) (cons (1+ (car x)) (cdr x)))
((and (zerop num) (numberp (cdr x))) (cons (car x) (1+ (cdr x))))
(t x)))) wdeck)))))
It works, but what I fear is not really knowing what I'm doing, i.e., I've misused labels as well as done a setf in the code. If some of the more senior people could tell me whether this is totally off in the wrong direction or not.
Addendum:
This is what I've got after the suggestions from below:
(defun wason-deck3 (&optional (p 0))
(let* ((consonents '(b c d f g h j k l m n p q r s t v w x y z))
(vowels '(a e i o u))
(conso-deck (mapcar (lambda (x)
(cons x (1+ (* 2 (random 27)))))
consonents))
(vowel-deck (mapcar (lambda (x)
(cons x (* 2 (random 27))))
vowels))
(wdeck '()))
(labels
((shuffle (slst)
(loop :for i :from (1- (length slst)) :downto 1
:do (rotatef (nth i slst)
(nth (random (1+ i)) slst)))
slst)
(flip (flst)
(mapcar (lambda (x) (let ((num (random 2)))
(if (zerop num)
(cons (cdr x) (car x))
x))) flst)))
(setf wdeck (flip (shuffle (append conso-deck vowel-deck)))))
(if (zerop p) wdeck
(mapcar (lambda (x) (let ((num (random 6)))
(cond ((and (zerop num) (numberp (car x))) (cons (1+ (car x)) (cdr x)))
((and (zerop num) (numberp (cdr x))) (cons (car x) (1+ (cdr x))))
(t x)))) wdeck))))
Please add any new suggestions.
Using labels is totally OK, and your code is not entirely unreasonable.
A few pointers:
I'd represent characters as characters: '(#\a #\b #\c …)
I'd take my list exercises elsewhere, or at least use set-difference.
When you create a function for just one call, you might as well just save the result:
(let ((consonant-deck (mapcar (lambda (c)
(cons c (1+ (* 2 (random 27)))))
consonants))
(vowel-deck (mapcar (lambda (c)
(cons c (* 2 (random 27))))
vowels)))
…)
For swapping, there is rotatef: (rotatef (nth i list) (nth j list)). Such things are rather expensive on lists, so I'd prefer to use a vector for this. Then it comes in handy that a string is just a vector of characters…
Loop can do counting for you, you don't need to create lists:
(loop :for i :from (1- (length list)) :downto 1
:do (rotatef (nth i list)
(nth (random (1+ i)) list)))
(Using keywords as loop keywords is optional, but indentation should be like this.)
If you put the labels around the let, you can immediately bind wdeck, so that you do not need to setf it afterwards.
You do not need this function for the exercise that you linked to.
I am trying to build the built-in procedure build-list in Racket.
The built-in function works like this:
(build-list 10 (lambda (x) (* x x)))
>> '(0 1 4 9 16 25 36 49 64 81)
My implementation is a recursive definition for a recursive procedure:
(define (my-build-list-recur list-len proc)
(if (= list-len 0)
'()
(cons (proc (sub1 list-len)) (my-build-list-recur (sub1 list-len) proc))))
When I call my implementation, I have:
(my-build-list-recur 10 (lambda (x) (* x x)))
>> '(81 64 49 36 25 16 9 4 1 0)
As you might have seen, I get the same result, but in a reverse order.
What can I do to have the result in the same order as the native function?
P.S.: I have done an implementation using a recursive definition for an iterative procedure which works perfectly. I am struggling now to generate the same result with the totally recursive procedure. I already know how to solve this doubt with long tail recursion.
This is my implementation with long tail recursion:
(define (my-build-list list-len proc)
(define (iter list-len accu n)
(if (= (length accu) list-len)
(reverse accu)
(iter list-len (cons (proc n) accu) (add1 n))))
;(trace iter)
(iter list-len '() 0))
Ok so you're looking for an answer that does not use state variables and a tail call. You want for a recursive procedure that also evolves a recursive process. Not sure why you want this other than just to see how the definition would differ. You should also read about tail recursion modulo cons (here, and on wikipedia) – it's relevant to this question.
;; recursive procedure, recursive process
(define (build-list n f)
(define (aux m)
(if (equal? m n)
empty
(cons (f m) (aux (add1 m)))))
(aux 0))
(build-list 5 (λ (x) (* x x)))
;; => '(0 1 4 9 16)
Notice how the aux call is no longer in tail position – ie, cons cannot finish evaluating until it has evaluated the aux call in its arguments. The process will look something like this, evolving on the stack:
(cons (f 0) ...)
(cons (f 0) (cons (f 1) ...))
(cons (f 0) (cons (f 1) (cons (f 2) ...)))
(cons (f 0) (cons (f 1) (cons (f 2) (cons (f 3) ...))))
(cons (f 0) (cons (f 1) (cons (f 2) (cons (f 3) (cons (f 4) ...)))))
(cons (f 0) (cons (f 1) (cons (f 2) (cons (f 3) (cons (f 4) empty)))))
(cons (f 0) (cons (f 1) (cons (f 2) (cons (f 3) (cons (f 4) '())))))
(cons (f 0) (cons (f 1) (cons (f 2) (cons (f 3) '(16)))))
(cons (f 0) (cons (f 1) (cons (f 2) '(9 16))))
(cons (f 0) (cons (f 1) '(4 9 16)))
(cons (f 0) '(1 4 9 16))
'(0 1 4 9 16)
You'll see that the cons calls are left hanging open until ... is filled in. And the last ... isn't filled in with empty until m is equal to n.
If you don't like the inner aux procedure, you can use a default parameter, but this does leak some of the private API to the public API. Maybe it's useful to you and/or maybe you don't really care.
;; recursive procedure, recursive process
(define (build-list n f (m 0))
(if (equal? m n)
'()
(cons (f m) (build-list n f (add1 m)))))
;; still only apply build-list with 2 arguments
(build-list 5 (lambda (x) (* x x)))
;; => '(0 1 4 9 16)
;; if a user wanted, they could start `m` at a different initial value
;; this is what i mean by "leaked" private API
(build-list 5 (lambda (x) (* x x) 3)
;; => '(9 16)
Stack-safe implementations
Why you'd specifically want a recursive process (one which grows the stack) is strange, imo, especially considering how easy it is to write a stack-safe build-list procedure which doesn't grow the stack. Here's some recursive procedures with a linear iterative processes.
The first one is extremely simple but does leak a little bit of private API using the acc parameter. You could easily fix this using an aux procedure like we did in the first solution.
;; recursive procedure, iterative process
(define (build-list n f (acc empty))
(if (equal? 0 n)
acc
(build-list (sub1 n) f (cons (f (sub1 n)) acc))))
(build-list 5 (λ (x) (* x x)))
;; => '(0 1 4 9 16)
Check out the evolved process
(cons (f 4) empty)
(cons (f 3) '(16))
(cons (f 2) '(9 16))
(cons (f 1) '(4 9 16))
(cons (f 0) '(1 4 9 16))
;; => '(0 1 4 9 16)
This is insanely better because it can constantly reuse one stack frame until the entire list is built. As an added advantage, we don't need to keep a counter that goes from 0 up to n. Instead, we build the list backwards and count from n-1 to 0.
Lastly, here's another recursive procedure that evolves a linear iterative process. It utilizes a named-let and continuation passing style. The loop helps prevent leaking the API this time.
;; recursive procedure, iterative process
(define (build-list n f)
(let loop ((m 0) (k identity))
(if (equal? n m)
(k empty)
(loop (add1 m) (λ (rest) (k (cons (f m) rest)))))))
(build-list 5 (λ (x) (* x x)))
;; => '(0 1 4 9 16)
It cleans up a little tho if you use compose and curry:
;; recursive procedure, iterative process
(define (build-list n f)
(let loop ((m 0) (k identity))
(if (equal? n m)
(k empty)
(loop (add1 m) (compose k (curry cons (f m)))))))
(build-list 5 (λ (x) (* x x)))
;; => '(0 1 4 9 16)
The process evolved from this procedure is slightly different, but you'll notice that it also doesn't grow the stack, creating a sequence of nested lambdas on the heap instead. So this would be sufficient for sufficiently large values of n:
(loop 0 identity) ; k0
(loop 1 (λ (x) (k0 (cons (f 0) x))) ; k1
(loop 2 (λ (x) (k1 (cons (f 1) x))) ; k2
(loop 3 (λ (x) (k2 (cons (f 2) x))) ; k3
(loop 4 (λ (x) (k3 (cons (f 3) x))) ; k4
(loop 5 (λ (x) (k4 (cons (f 4) x))) ; k5
(k5 empty)
(k4 (cons 16 empty))
(k3 (cons 9 '(16)))
(k2 (cons 4 '(9 16)))
(k1 (cons 1 '(4 9 16)))
(k0 (cons 0 '(1 4 9 16)))
(identity '(0 1 4 9 16))
'(0 1 4 9 16)
I am trying to convert a binary number entered as "1010" for 10 using recursion. I can't seem to wrap my head around the syntax for getting this to work.
(define (mod N M)
(modulo N M))
(define (binaryToDecimal b)
(let ([s 0])
(helper b s)))
(define (helper b s)
(if (= b 0)
(begin (+ s 0))
(begin (* + (mod b 2) (expt 2 s) helper((/ b 10) + s 1)))))
Thanks!
Here's a simple recursive solution:
(define (bin->dec n)
(if (zero? n)
n
(+ (modulo n 10) (* 2 (bin->dec (quotient n 10))))))
testing:
> (bin->dec 1010)
10
> (bin->dec 101)
5
> (bin->dec 10000)
16
If you want "1010" to translate to 10 (or #b1010, #o12 or #xa) you implement string->number
(define (string->number str radix)
(let loop ((acc 0) (n (string->list str)))
(if (null? n)
acc
(loop (+ (* acc radix)
(let ((a (car n)))
(- (char->integer a)
(cond ((char<=? a #\9) 48) ; [#\0-#\9] => [0-9]
((char<? a #\a) 55) ; [#\A-#\Z] => [10-36]
(else 87))))) ; [#\a-#\z] => [10-36]
(cdr n)))))
(eqv? #xAAF (string->number "aAf" 16)) ; ==> #t
It processes the highest number first and everytime a new digit is processed it multiplies the accumulated value with radix and add the new "ones" until there are not more chars. If you enter "1010" and 2 the accumulated value from beginning to end is 0, 0*2+1, 1*2+0, 2*2+1, 5*2+0 which eventually would make sure the digits numbered from right to left 0..n becomes Sum(vn*radic^n)
Now, if you need a procedure that only does base 2, then make a wrapper:
(define (binstr->number n)
(string->number n 2))
(eqv? (binstr->number "1010") #b1010) ; ==> #t
I'm confused as to how def and let bind variables differently. Can someone explain to me why this works:
(def leven
(memoize
(fn [x y]
(cond (empty? x) (count y)
(empty? y) (count x)
:else (min (+ (leven (rest x) y) 1)
(+ (leven x (rest y)) 1)
(+ (leven (rest x) (rest y)) (if (= (first x) (first y)) 0 1)))))))
But when I try to declare the function as let it fails to compile:
(def leven
(let [l (memoize (fn [x y]
(cond (empty? x) (count y)
(empty? y) (count x)
:else (min (+ (l (rest x) y) 1)
(+ (l x (rest y)) 1)
(+ (l (rest x) (rest y)) (if (= (first x) (first y)) 0 1))))))]
(l x y)))
EDIT: This works, using the technique showed by Ankur.
(defn leven [x y]
(let [l (memoize (fn [f x y]
(cond (empty? x) (count y)
(empty? y) (count x)
:else (min (+ (f f (rest x) y) 1)
(+ (f f x (rest y)) 1)
(+ (f f (rest x) (rest y)) (if (= (first x) (first y)) 0 1))))))
magic (partial l l)]
(magic x y)))
Below is such an example to do what you have asked for. I am using factorial just for the sake of simplicity and added println in factorial to make sure the memoization is working fine
(let [fact (memoize (fn [f x]
(println (str "Called for " x))
(if (<= x 1) 1 (* x (f f (- x 1))))))
magic (partial fact fact)]
(magic 10)
(magic 11))
First calculate factorial of 10 and then 11 in which case it should not again call factorial for 10 till 1 as that has been memoized.
Called for 10
Called for 9
Called for 8
Called for 7
Called for 6
Called for 5
Called for 4
Called for 3
Called for 2
Called for 1
Called for 11
39916800
The let form binds names sequentially so in your second function definition the name l doesn't exist when you try to refer to it. You can either use letfn (with some minor mods) or give the defined function a name and instead refer to that instead, like so:
(def leven
(let [l (memoize (fn SOME-NAME [x y]
(cond
(empty? x) (count y)
(empty? y) (count x)
:else (min (+ (SOME-NAME (rest x) y) 1)
(+ (SOME-NAME x (rest y)) 1)
(+ (SOME-NAME (rest x) (rest y)) (if (= (first x) (first y)) 0 1))))))]
l))
As you might notice I change the return from the let to be l itself since that is what you want leven bound to. The (l x y) was problematic because it referred to bindings only local to the function and not accessible to the let.