(define fibo ; fibonacci
(lambda (n)
(cond ((= n 0) 0)
((= n 1) 1)
((= n 2) 1)
(else (+ (fibo (- n 1)) (fibo(- n 2))
)))))
(time (fibo 20))
(define (fiboN n) ; fibonacci
(delay (cond ((= n 0) 0)
((= n 1) 1)
((= n 2) 1)
(else (+ (force (fiboN (- n 1))) (force (fiboN(- n 2))))))))
(time force( force (fiboN 20)))
Given the two fibonacci functions above, I expected that the second would run faster since scheme applies memoization on forced delayed objects.
Yet the second fiboN runs slower. Why would that be? Am I wrong about automatic memoization in Scheme?
You're confounding memoization with delayed (a.k.a. lazy) evaluation - take a look at this explanation to understand the difference between the two concepts.
Your second implementation of fiboN is delayed, of course, but it's not memoizing anything - sure, once we force a value it won't have to be forced again, but it doesn't change the fact that this is a recursive function that gets called over and over again for values that we already obtained, and the extra cost of delaying/forcing each value will make it slower than the first implementation.
Here's a possible implementation that really uses memoization, the trick is to save already-calculated values somewhere where we can access them efficiently - a hash table in this example:
(define fiboN
(let ((memo (make-hash '((0 . 0) (1 . 1)))))
(lambda (n)
(unless (hash-has-key? memo n)
(hash-set! memo n (+ (fiboN (- n 1)) (fiboN (- n 2)))))
(hash-ref memo n))))
And the results show that this is much faster:
(time (fiboN 100))
cpu time: 0 real time: 1 gc time: 0
354224848179261915075
Related
I have to make a function that finds the "cost" of a Fibonacci number. My Fibonacci code is
(define fib (lambda (n) (cond
((< n 0) 'Error)
((= n 0) 0)
((= n 1) 1)
(else (+ (fib (- n 1)) (fib (- n 2)))))))
Each + or - that is used to evaluate a fib number is worth $1. Each < or > is worth $0.01. For example, 1 is worth $0.01, 2 is worth $3.03, etc. I don't know how to count the number of +, -, <, and >. Do I need the fib code in my fibCost code?
I'm not sure whether or not you wanted the solution to include the original code or not. There are direct ways of computing the cost, but I think it's interesting to look at ways that are similar to instrumenting the existing code. That is, what can we change so that something very much like the original code will compute what we want?
First, we can replace the arithmetic operators with a bit of indirection. That is, instead of calling (+ x y), you can call (op + 100 x y), which increments the total-cost variable.
(define (fib n)
(let* ((total-cost 0)
(op (lambda (fn cost . args)
(set! total-cost (+ total-cost cost))
(apply fn args))))
(let fib ((n n))
(cond
((op < 1 n 0) 'error)
((= n 0) 1)
((= n 1) 1)
(else (op + 100
(fib (op - 100 n 1))
(fib (op - 100 n 2))))))
total-cost))
That doesn't let us keep the original code, though. We can do better by defining local versions of the arithmetic operators, and then using the original code:
(define (fib n)
(let* ((total-cost 0)
(op (lambda (fn cost)
(lambda args
(set! total-cost (+ total-cost cost))
(apply fn args))))
(< (op < 1))
(+ (op + 100))
(- (op - 100)))
(let fib ((n n))
(cond
((< n 0) 'error)
((= n 0) 1)
((= n 1) 1)
(else (+ (fib (- n 1))
(fib (- n 2))))))
total-cost))
> (fib 1)
1
> (fib 2)
303
> (fib 3)
605
> (fib 4)
1209
What's nice about this approach is that if you start using macros to do some source code manipulation, you could actually use this as a sort of poor-man's profiler, or tracing system. (I'd suggest sticking with the more robust tools provided by the implementation, of course, but there are times when a technique like this can be useful.)
Additionally, this doesn't even have to compute the Fibonnaci number anymore. It's still computed because we do (apply fn args), but if we remove that, then we never even call the original arithmetic operation.
The quick and dirty solution would be to define a counter variable each time the cost procedure is started, and update it with the corresponding value at each branch of the recursion. For example:
(define (fib-cost n)
(let ((counter 0)) ; counter initialized with 0 at the beginning
(let fib ((n n)) ; inner fibonacci procedure
; update counter with the corresponding cost
(set! counter (+ counter 0.01))
(when (> n 1)
(set! counter (+ counter 3)))
(cond ((< n 0) 'Error)
((= n 0) 0)
((= n 1) 1)
(else (+ (fib (- n 1)) (fib (- n 2))))))
counter)) ; return the counter at the end
Answering your second question - no, we don't need the whole fib code; given that we're not interested in the actual value of fibonacci, the above can be further simplified to just make the required calls and ignore the returned values:
(define (fib-cost n)
(let ((counter 0)) ; counter initialized with 0 at the beginning
(let fib ((n n)) ; inner fibonacci procedure
; update counter with the corresponding cost
(set! counter (+ counter 0.01))
(when (> n 1)
(fib (- n 1))
(fib (- n 2))
(set! counter (+ counter 3))))
counter)) ; return the counter at the end
You have +/- just anytime you call the code recursively, in the else Part. So, easily anytime you enter the else part, you should count 3 of them. One for f(n-1), one for f(n-2) and one for f(n-1) + f(n-2).
Just for fun, a solution using syntactic extensions (aka "macros").
Let's define the following:
(define-syntax-rule (define-cost newf oldf thiscost totalcost)
(define (newf . parms)
(set! totalcost (+ totalcost thiscost))
(apply oldf parms)))
Now we create procedures based on the original procedures you want to have a cost:
(define-cost +$ + 100 cost)
(define-cost -$ - 100 cost)
(define-cost <$ < 1 cost)
so using +$ will do an addition and increase a cost counter by 1, and so on.
Now we adapt your inititial procedure to use the newly defined ones:
(define fib
(lambda (n)
(cond
((<$ n 0) 'Error)
((= n 0) 0)
((= n 1) 1)
(else
(+$ (fib (-$ n 1)) (fib (-$ n 2)))))))
For convenience, we create a macro to return both the result of a procedure and its cost:
(define-syntax-rule (howmuch f . args)
(begin
(set! cost 0)
(cons (apply f 'args) cost)))
then a cost variable
(define cost #f)
and off we go
> (howmuch fib 1)
'(1 . 1)
> (howmuch fib 2)
'(1 . 303)
> (howmuch fib 10)
'(55 . 26577)
> (howmuch fib 1)
'(1 . 1)
I am working through SICP. In exercise 1.28 about the Miller-Rabin test. I had this code, that I know is wrong because it does not follow the instrcuccions of the exercise.
(define (fast-prime? n times)
(define (even? x)
(= (remainder x 2) 0))
(define (miller-rabin-test n)
(try-it (+ 1 (random (- n 1)))))
(define (try-it a)
(= (expmod a (- n 1) n) 1))
(define (expmod base exp m)
(cond ((= exp 0) 1)
((even? exp)
(if (and (not (= exp (- m 1))) (= (remainder (square exp) m) 1))
0
(remainder (square (expmod base (/ exp 2) m)) m)))
(else
(remainder (* base (expmod base (- exp 1) m)) m))))
(cond ((= times 0) true)
((miller-rabin-test n) (fast-prime? n (- times 1)))
(else false)))
In it I test if the square of the exponent is congruent to 1 mod n. Which according
to what I have read, and other correct implementations I have seen is wrong. I should test
the entire number as in:
...
(square
(trivial-test (expmod base (/ exp 2) m) m))
...
The thing is that I have tested this, with many prime numbers and large Carmicheal numbers,
and it seems to give the correct answer, though a bit slower. I don't understand why this
seems to work.
Your version of the function "works" only because you are lucky. Try this experiment: evaluate (fast-prime? 561 3) a hundred times. Depending on the random witnesses that your function chooses, sometimes it will return true and sometimes it will return false. When I did that I got 12 true and 88 false, but you may get different results, depending on your random number generator.
> (let loop ((k 0) (t 0) (f 0))
(if (= k 100) (values t f)
(if (fast-prime? 561 3)
(loop (+ k 1) (+ t 1) f)
(loop (+ k 1) t (+ f 1)))))
12
88
I don't have SICP in front of me -- my copy is at home -- but I can tell you the right way to perform a Miller-Rabin primality test.
Your expmod function is incorrect; there is no reason to square the exponent. Here is a proper function to perform modular exponentiation:
(define (expm b e m) ; modular exponentiation
(let loop ((b b) (e e) (x 1))
(if (zero? e) x
(loop (modulo (* b b) m) (quotient e 2)
(if (odd? e) (modulo (* b x) m) x)))))
Then Gary Miller's strong pseudoprime test, which is a strong version of your try-it test for which there is a witness a that proves the compositeness of every composite n, looks like this:
(define (strong-pseudoprime? n a) ; strong pseudoprime base a
(let loop ((r 0) (s (- n 1)))
(if (even? s) (loop (+ r 1) (/ s 2))
(if (= (expm a s n) 1) #t
(let loop ((r r) (s s))
(cond ((zero? r) #f)
((= (expm a s n) (- n 1)) #t)
(else (loop (- r 1) (* s 2)))))))))
Assuming the Extended Riemann Hypothesis, testing every a from 2 to n-1 will prove (an actual, deterministic proof, not just a probabilistic estimate of primality) the primality of a prime n, or identify at least one a that is a witness to the compositeness of a composite n. Michael Rabin proved that if n is composite, at least three-quarters of the a from 2 to n-1 are witnesses to that compositeness, so testing k random bases demonstrates, but does not prove, the primality of a prime n to a probability of 4−k. Thus, this implementation of the Miller-Rabin primality test:
(define (prime? n k)
(let loop ((k k))
(cond ((zero? k) #t)
((not (strong-pseudoprime? n (random (+ 2 (- n 3))))) #f)
(else (loop (- k 1))))))
That always works properly:
> (let loop ((k 0) (t 0) (f 0))
(if (= k 100) (values t f)
(if (prime? 561 3)
(loop (+ k 1) (+ t 1) f)
(loop (+ k 1) t (+ f 1)))))
0
100
I know your purpose is to study SICP rather than to program primality tests, but if you're interested in programming with prime numbers, I modestly recommend this essay at my blog, which discusses the Miller-Rabin test, among other topics. You should also know there are better (faster, less likely to report erroneous result) primality tests available than randomized Miller-Rabin.
It seems to me, you still got correct answer, because in each iteration of expmod you check conditions for previous iteration. You could try to debug exp value using display function inside expmod. Really, your code is not very different from this one.
I am wondering how to write a function calculating the sum of proper divisors of a integer greater than 1.
(define (sum-of-proper-divisors n)
(cond
[(= n 1) 1]
[(= 0 (remainder n (sub1 n)))
(+ (remainder n (sub1 n)) (sum-of-proper-divisors (sub1 (sub1 n))))]
[else (sum-of-proper-divisors (sub1 n))]))
This is the code that I wrote, however, it does not work. It will never stop evaluating because it will always do n-1. And I don't know how to fix this. Also, there might be other problems. How to put the restriction that makes the function stop evaluating when the divisor becomes 1?
You're confusing the number n whose divisors you want to find, with said divisors. Notice that n never changes, what must be modified at each step is the current integer being tested (a possible divisor). For that you'll need to pass around two parameters:
(define (sum-of-proper-divisors n i)
(cond
[(= i 1) 1]
[(= (remainder n i) 0)
(+ i (sum-of-proper-divisors n (sub1 i)))]
[else (sum-of-proper-divisors n (sub1 i))]))
Call it like this, at the beginning i must be one unit less than n:
(sum-of-proper-divisors 10 9)
=> 8
If having two parameters bothers you there are several ways to pass a single parameter, for instance using a named let:
(define (sum-of-proper-divisors n)
(let loop ((i (sub1 n)))
(cond
[(= i 1) 1]
[(= (remainder n i) 0)
(+ i (loop (sub1 i)))]
[else (loop (sub1 i))])))
So i'm trying to solve the collatz function iteratively in scheme but my test cases keep showing up as
(define (collatz n)
(define (collatz-iter n counter)
(if (<= n 1)
1
(if (even? n) (collatz-iter (/ n 2) (+ counter 1))
(collatz-iter (+ (* n 3) 1) (+ counter 1))
)
)
)
)
However, my test cases keep resulting in "#[constant 13 #x2]". What did I write wrong, if anything?
You forgot to call collatz-iter. Also, it's not clear what do you intend to do with counter, you just increment it, but never actually use its value - your procedure will always return 1 (assuming that the Collatz conjecture is true, which seems quite possible).
I'm guessing you intended to return the counter, so here's how to fix your procedure:
(define (collatz n)
(define (collatz-iter n counter)
(if (<= n 1)
counter ; return the counter
(if (even? n)
(collatz-iter (/ n 2) (+ counter 1))
(collatz-iter (+ (* n 3) 1) (+ counter 1)))))
(collatz-iter n 1)) ; call collatz-iter
And this is how it works for the examples in wikipedia:
(collatz 6)
=> 9
(collatz 11)
=> 15
(collatz 27)
=> 112
So basically we're counting the length of the Collatz sequence for a given number.
You should indent your code properly. With proper formatting, it's
(define (collatz n)
(define (collatz-iter n counter)
(if (<= n 1)
1
(if (even? n)
(collatz-iter (/ n 2) (+ counter 1))
(collatz-iter (+ (* n 3) 1) (+ counter 1))))))
which clearly has no body forms to execute, just an internal definition. You need to add a call to collatz-iter, like this:
(define (collatz n)
(define (collatz-iter n counter)
(if (<= n 1)
1
(if (even? n)
(collatz-iter (/ n 2) (+ counter 1))
(collatz-iter (+ (* n 3) 1) (+ counter 1)))))
(collatz-iter n 1))
(I'm not sure what your initial counter value should be. I'm assuming 1 is reasonable, but perhaps it should be zero?) Better yet, since the body it just a call to collatz-iter, you can make this a named let, which is more like your original code:
(define (collatz n)
(let iter ((n n) (counter 1))
(if (<= n 1)
1
(if (even? n)
(iter (/ n 2) (+ counter 1))
(iter (+ (* n 3) 1) (+ counter 1))))))
It's sort of like combining the internal definition with the single call to the local function. Once you've done this, though, you'll see that it always returns 1, when it eventually gets to the base case (assuming the Collatz conjecture is true, of course). Fixing this, you'll end up with:
(define (collatz n)
(let iter ((n n) (counter 1))
(if (<= n 1)
counter
(if (even? n)
(iter (/ n 2) (+ counter 1))
(iter (+ (* n 3) 1) (+ counter 1))))))
When I try to run your code in Racket I get the error:
no expression after a sequence of internal definitions
This is telling us that the collatz function conatains the collatz-iter definition, but no expression to call it (other than the recursive calls in collatz-iter). That can be fixed by adding a call to (collatz-iter n 0) as the last line in collatz.
However, when you run the program it always returns 1. Not very interesting. If instead you change it to return the value of counter you can see how many steps it took for the sequence to reach 1.
(define (collatz n)
(define (collatz-iter n counter)
(if (<= n 1)
counter
(if (even? n) (collatz-iter (/ n 2) (+ counter 1))
(collatz-iter (+ (* n 3) 1) (+ counter 1))
)
)
)
(collatz-iter n 0)
)
We can check it against a few examples given on the Wikipedia Collatz conjecture article.
> (collatz 6)
8
> (collatz 11)
14
> (collatz 27)
111
>
How to write a scheme program consumes n and sum as parameters, and show all the numbers(from 1 to n) that could sum the sum? Like this:
（find 10 10）
((10)
(9 , 1)
(8 , 2)
(7 , 3)
(7 ,2 , 1)
(6 ,4)
(6 , 3, 1)
(5 , 4 , 1)
(5 , 3 , 2)
(4 ,3 ,2 ,1))
I found one:
(define (find n sum)
(cond ((<= sum 0) (list '()))
((<= n 0) '())
(else (append
(find (- n 1) sum)
(map (lambda (x) (cons n x))
(find (- n 1) (- sum n)))))))
But it's inefficient,and i want a better one. Thank you.
The algorithm you are looking for is known as an integer partition. I have a couple of implementations at my blog.
EDIT: Oscar properly chastized me for my incomplete answer. As penance, I offer this answer, which will hopefully clarify a few things.
I like Oscar's use of streams -- as the author of SRFI-41 I should. But expanding the powerset only to discard most of the results seems a backward way of solving the problem. And I like the simplicity of GoZoner's answer, but not its inefficiency.
Let's start with GoZoner's answer, which I reproduce below with a few small changes:
(define (fs n s)
(if (or (<= n 0) (<= s 0)) (list)
(append (if (= n s) (list (list n))
(map (lambda (xs) (cons n xs))
(fs (- n 1) (- s n))))
(fs (- n 1) s))))
This produces a list of the output sets:
> (fs 10 10)
((10) (9 1) (8 2) (7 3) (7 2 1) (6 4) (6 3 1) (5 4 1) (5 3 2) (4 3 2 1))
A simple variant of that function produces the count instead of a list of sets, which shall be the focus of the rest of this answer:
(define (f n s)
(if (or (<= s 0) (<= n 0)) 0
(+ (if (= n s) 1
(f (- n 1) (- s n)))
(f (- n 1) s))))
And here is a sample run of the function, including timings on my ancient and slow home computer:
> (f 10 10)
10
> (time (f 100 100)
(time (f 100 ...))
no collections
1254 ms elapsed cpu time
1435 ms elapsed real time
0 bytes allocated
444793
That's quite slow; although it is fine for small inputs, it would be intolerable to evaluate (f 1000 1000), as the algorithm is exponential. The problem is the same as with the naive fibonacci algorithm; the same sub-problems are re-computed again and again.
A common solution to that problem is memoization. Fortunately, we are programming in Scheme, which makes it easy to encapsulate memoization in a macro:
(define-syntax define-memoized
(syntax-rules ()
((_ (f args ...) body ...)
(define f
(let ((results (make-hash hash equal? #f 997)))
(lambda (args ...)
(let ((result (results 'lookup (list args ...))))
(or result
(let ((result (begin body ...)))
(results 'insert (list args ...) result)
result)))))))))
We use hash tables from my Standard Prelude and the universal hash function from my blog. Then it is a simple matter to write the memoized version of the function:
(define-memoized (f n s)
(if (or (<= s 0) (<= n 0)) 0
(+ (if (= n s) 1
(f (- n 1) (- s n)))
(f (- n 1) s))))
Isn't that pretty? The only change is the addition of -memoized in the definition of the function; all of the parameters and the body of the function are the same. But the performance improves greatly:
> (time (f 100 100))
(time (f 100 ...))
no collections
62 ms elapsed cpu time
104 ms elapsed real time
1028376 bytes allocated
444793
That's an order-of-magnitude improvement with virtually no effort.
But that's not all. Since we know that the problem has "optimal substructure" we can use dynamic programming. Memoization works top-down, and must suspend the current level of recursion, compute (either directly or by lookup) the lower-level solution, then resume computation in the current level of recursion. Dynamic programming, on the other hand, works bottom-up, so sub-solutions are always available when they are needed. Here's the dynamic programming version of our function:
(define (f n s)
(let ((fs (make-matrix (+ n 1) (+ s 1) 0)))
(do ((i 1 (+ i 1))) ((< n i))
(do ((j 1 (+ j 1))) ((< s j))
(matrix-set! fs i j
(+ (if (= i j)
1
(matrix-ref fs (- i 1) (max (- j i) 0)))
(matrix-ref fs (- i 1) j)))))
(matrix-ref fs n s)))
We used the matrix functions of my Standard Prelude. That's more work than just adding -memoized to an existing function, but the payoff is another order-of-magnitude reduction in run time:
> (time (f 100 100))
(time (f 100 ...))
no collections
4 ms elapsed cpu time
4 ms elapsed real time
41624 bytes allocated
444793
> (time (f 1000 1000))
(time (f 1000 ...))
3 collections
649 ms elapsed cpu time, including 103 ms collecting
698 ms elapsed real time, including 132 ms collecting
15982928 bytes allocated, including 10846336 bytes reclaimed
8635565795744155161506
We’ve gone from 1254ms to 4ms, which is a rather astonishing range of improvement; the final program is O(ns) in both time and space. You can run the program at http://programmingpraxis.codepad.org/Y70sHPc0, which includes all the library code from my blog.
As a special bonus, here is another version of the define-memoized macro. It uses a-lists rather than hash tables, so it's very much slower than the version given above, but when the underlying computation is time-consuming, and you just want a simple way to improve it, this may be just what you need:
(define-syntax define-memoized
(syntax-rules ()
((define-memoized (f arg ...) body ...)
(define f
(let ((cache (list)))
(lambda (arg ...)
(cond ((assoc `(,arg ...) cache) => cdr)
(else (let ((val (begin body ...)))
(set! cache (cons (cons `(,arg ...) val) cache))
val)))))))))
This is a good use of quasi-quotation and the => operator in a cond clause for those who are just learning Scheme. I can't remember when I wrote that function -- I've had it laying around for years -- but it has saved me many times when I just needed a quick-and-dirty memoization and didn't care to worry about hash tables and universal hash functions.
This answer will appear tomorrow at my blog. Please drop in and have a look around.
This is similar to, but not exactly like, the integer partition problem or the subset sum problem. It's not the integer partition problem, because an integer partition allows for repeated numbers (here we're only allowing for a single occurrence of each number in the range).
And although it's more similar to the subset sum problem (which can be solved more-or-less efficiently by means of dynamic programming), the solution would need to be adapted to generate all possible subsets of numbers that add to the given number, not just one subset as in the original formulation of that problem. It's possible to implement a dynamic programming solution using Scheme, but it'll be a bit cumbersome, unless a matrix library or something similar is used for implementing a mutable table.
Here's another possible solution, this time generating the power set of the range [1, n] and checking each subset in turn to see if the sum adds to the expected value. It's still a brute-force approach, though:
; helper procedure for generating a list of numbers in the range [start, end]
(define (range start end)
(let loop ((acc '())
(i end))
(if (< i start)
acc
(loop (cons i acc) (sub1 i)))))
; helper procedure for generating the power set of a given list
(define (powerset set)
(if (null? set)
'(())
(let ((rest (powerset (cdr set))))
(append (map (lambda (element) (cons (car set) element))
rest)
rest))))
; the solution is simple using the above procedures
(define (find n sum)
(filter (lambda (s) (= sum (apply + s)))
(powerset (range 1 n))))
; test it, it works!
(find 10 10)
=> '((1 2 3 4) (1 2 7) (1 3 6) (1 4 5) (1 9) (2 3 5) (2 8) (3 7) (4 6) (10))
UPDATE
The previous solution will produce correct results, but it's inefficient in memory usage because it generates the whole list of the power set, even though we're interested only in some of the subsets. In Racket Scheme we can do a lot better and generate only the values as needed if we use lazy sequences, like this (but be aware - the first solution is still faster!):
; it's the same power set algorithm, but using lazy streams
(define (powerset set)
(if (stream-empty? set)
(stream '())
(let ((rest (powerset (stream-rest set))))
(stream-append
(stream-map (lambda (e) (cons (stream-first set) e))
rest)
rest))))
; same algorithm as before, but using lazy streams
(define (find n sum)
(stream-filter (lambda (s) (= sum (apply + s)))
(powerset (in-range 1 (add1 n)))))
; convert the resulting stream into a list, for displaying purposes
(stream->list (find 10 10))
=> '((1 2 3 4) (1 2 7) (1 3 6) (1 4 5) (1 9) (2 3 5) (2 8) (3 7) (4 6) (10))
Your solution is generally correct except you don't handle the (= n s) case. Here is a solution:
(define (find n s)
(cond ((or (<= s 0) (<= n 0)) '())
(else (append (if (= n s)
(list (list n))
(map (lambda (rest) (cons n rest))
(find (- n 1) (- s n))))
(find (- n 1) s)))))
> (find 10 10)
((10) (9 1) (8 2) (7 3) (7 2 1) (6 4) (6 3 1) (5 4 1) (5 3 2) (4 3 2 1))
I wouldn't claim this as particularly efficient - it is not tail recursive nor does it memoize results. Here is a performance result:
> (time (length (find 100 100)))
running stats for (length (find 100 100)):
10 collections
766 ms elapsed cpu time, including 263 ms collecting
770 ms elapsed real time, including 263 ms collecting
345788912 bytes allocated
444793
>