In the webpage of Rosetta Code (http://rosettacode.org/wiki/First_power_of_2_that_has_leading_decimal_digits_of_12#C) there is the following challenge: Find the first power of 2 that has leading decimal digits of 12.
I have written several versions in Common Lisp, but I fail miserably in terms of performance compared to what other languages report.
The following code is one of the many versions that I have tried.
(defun log10 (x) (/ (log x) (log 10)))
(defun first-digits (n l)
(let* ((len-n (1+ (floor (log10 n))))
(tens (expt 10 (- len-n l))) )
(truncate n tens) ))
(defun p (rem n)
(do* ((len-rem (1+ (floor (log10 rem))))
(i 0 (1+ i))
(k 1 (* 2 k)) )
((= n 0) (1- i))
(when (= rem (first-digits k len-rem))
(decf n) )))
The performance is really poor, but I refuse to admit that Common Lisp is slower than any competitors. Any idea of how to achieve the run time of a few seconds reported by C#, C++, etc.?
Here is an answer which is now substantially equivalent to yours (based on the idea in this maths SE answer, but a little more general and a little more optimized. In particular:
it lets you specify both the number you want to raise to a power;
it lets you specify the base you want to work in (so not just 10);
it knows that (log x b) is the log of x in base b;
it computes the log you need just once;
it reorganizes some of the float operations to avoid overflows (at some point your version will call (expt 10 n) with a big enough n thay you'll get a floating point overflow.
I think (in fact I'm reasonably sure) that the remaining thing that is making it slow is float consing. It ought to be possible to prevail upon a compiler to avoid this, and I spent a small amount of time trying but to no avail.
Anyway, here it is.
(defun p (L n &key (b 2) (base 10.0d0))
;; nth occurence of power of b with leading digits L in base:
;; returns power (p below)
(let ((k-1 (floor (log L base))) ;(digits of L in base) - 1
(logb (log (float b 1.0d0) base))) ;log of b in base
(do* ((p 0 (1+ p)) ;power
(d 1 (floor (expt base (+ (rem (* p logb) 1) k-1)))) ;digits
(c (if (= L 1) 1 0) ;count of hits
(if (= L d) (1+ c) c)))
((= c n) p))))
Below is an earlier, useless answer: I've left it for posterity.
Note that the first part what's below deals with only the two-leading-digit case because I didn't bother looking at the original rosetta code thing: see the end for a generalisation.
First of all to pull out the first two decimal digits of something, you want to start by divide it by a suitable power of 10 that the result is a two digit number. That means taking logs, but you can cheat: if you know the number of bits, b, in the number then the number is 2^b + change (assuming it's a positive integer), and knowing the number of bits is very very quick. And then if 10^x = 2^y then x = y/(log_2 10) where log_2 is log base 2. And this is a constant.
So you can write this function after fiddling around with pen and paper for a bit:
(defun leading-two-digits (n)
(truncate (truncate n (expt 10 (1- (truncate (integer-length n)
(load-time-value (log 10 2))))))
10))
Note the use of load-time-value to compute the (log 10 2) just once. And note also that this relies on either having correct integer arithmetic or at least a function which will tell you what the number of bits in a number would be if you did have.
So now
> (leading-two-decimal-digits 59468049869823987435)
5
9
OK, looks good (extensive testing...).
So now you just need to start from 1 and successively multiply by the base, looking for the leading two digits being what you care about. As a hack if the base is 2 you can just left shift: my original function assumed the base was 2 and always left shifted, this one has a configurable base but still special-cases 2, which I suspect may no longer help at all.
(defun nth-ld-power (n &key (b 2) (leading 1) (second 2))
;; iterate is tfeb.github.io/tfeb-lisp-hax/, also should be in
;; Quicklisp
(iterate looking ((v 1) ;value
(p 0) ;power (so we can report it)
(c 0)) ;hit count
(multiple-value-bind (d1 d2) (leading-two-decimal-digits v)
(if (and (= d1 leading) (= d2 second))
(let ((c+ (1+ c)))
(if (= c+ n)
(values v p)
(looking (if (= b 2) (ash v 1) (* v b)) (1+ p) c+)))
(looking (if (= b 2) (ash v 1) (* v b)) (1+ p) c)))))
Again you would want to deal with the multiple-leading-digits case by passing a list of leading digits, but.
OK, so now:
> (time (nth-ld-power 2))
Timing the evaluation of (nth-ld-power 2)
User time = 0.000
System time = 0.000
Elapsed time = 0.000
Allocation = 2848 bytes
0 Page faults
GC time = 0.000
1208925819614629174706176
80
> (time (nth-ld-power 10))
Timing the evaluation of (nth-ld-power 10)
User time = 0.000
System time = 0.000
Elapsed time = 0.000
Allocation = 40704 bytes
0 Page faults
GC time = 0.000
124330809102446660538845562036705210025114037699336929360115994223289874253133343883264
286
OK, this is too quick to measure, let's make it do some real work:
> (time (nth-ld-power 1000))
Timing the evaluation of (nth-ld-power 1000)
User time = 3.264
System time = 0.039
Elapsed time = 3.384
Allocation = 845193424 bytes
517 Page faults
GC time = 0.020
12[...long number truncated here ...]
28745
So that's at least reasonable performance, I think. These figures were for LispWorks on a 2013 macbook. Obviously you can rewrite it without Tim's iterate, but I like it.
Here is a generalisation to the n-digit case.
(defun leading-decimal-digits (n m)
;; Return M leading digits from N: no sanity check
(iterate peel ((q (truncate n (expt 10 (- (truncate (integer-length n)
(load-time-value (log 10 2)))
(- m 1)))))
(digits '()))
(multiple-value-bind (qq d) (truncate q 10)
(cond
((zerop qq)
(cons d digits))
((< qq 10)
(list* qq d digits))
(t
(peel qq (cons d digits)))))))
(defun nth-power-with-leading-decimal-digits (n b leading)
;; Find the N'th occurrence of a power of B whose leading digits are
;; LEADING (a list of digits). Return the value of B^P and P, the
;; power.
(let ((nleading (length leading)))
(iterate looking ((v 1) ;value
(p 0) ;power (so we can report it)
(c 0)) ;hit count
(if (equal (leading-decimal-digits v nleading) leading)
(let ((c+ (1+ c)))
(if (= c+ n)
(values v p)
(looking (if (= b 2) (ash v 1) (* v b)) (1+ p) c+)))
(looking (if (= b 2) (ash v 1) (* v b)) (1+ p) c)))))
So:
> (nth-power-with-leading-decimal-digits 2 2 '(1 2 8))
12855504354071922204335696738729300820177623950262342682411008
203
> (nth-power-with-leading-decimal-digits 2 3 '(2 7 8))
278954761343915929031866324148580803686773879062609352173281933430969939572023921519256921927359964084535215107090906022143908601839272147120823008337941481521208646465304746378648054338849857759629806700446921838039313884792762356955010344065298744426691826196079923777796821513452648753573059469525738664313409324728161550430310432705576201607066435772343529511415605105251217669677767280155388600975280964482318641251059803074701681895639266095014303466041595626938522373004626313927779288797843485898785327074755040298312905780373591994824646107875196292150692772609024142420597241695173176699988995274347532223981851419958515807471788303361043192244700492703668505222371093498892685289816397935636213340656919509760640657215827785179171568543835684943671352357398679232652259639784388841436515656182938820127024910154405205830179436914341715546500034485031465189386918271898229029201
1860
2^203 is the second occurrence of a power of 2 beginning with 128, and 3^1860 is the second occurrence of a power of 3 beginning 278. The second one took 0.017 seconds.
Related
Im making a scheme program that calculates
cos(x) = 1-(x^2/2!)+(x^4/4!)-(x^6/6!).......
whats the most efficient way to finish the program and how would you do the alternating addition and subtraction, thats what I used the modulo for but doesnt work for 0 and 1 (first 2 terms). x is the intial value of x and num is the number of terms
(define cosine-taylor
(lambda (x num)
(do ((i 0 (+ i 1)))
((= i num))
(if(= 0 (modulo i 2))
(+ x (/ (pow-tr2 x (* i 2)) (factorial (* 2 i))))
(- x (/ (pow-tr2 x (* i 2)) (factorial (* 2 i))))
))
x))
Your questions:
whats the most efficient way to finish the program? Assuming you want use the Taylor series expansion and simply sum up the terms n times, then your iterative approach is fine. I've refined it below; but your algorithm is fine. Others have pointed out possible loss of precision issues; see below for my approach.
how would you do the alternating addition and subtraction? Use another 'argument/local-variable' of odd?, a boolean, and have it alternate by using not. When odd? subtract when not odd? add.
(define (cosine-taylor x n)
(let computing ((result 1) (i 1) (odd? #t))
(if (> i n)
result
(computing ((if odd? - +) result (/ (expt x (* 2 i)) (factorial (* 2 i))))
(+ i 1)
(not odd?)))))
> (cos 1)
0.5403023058681398
> (cosine-taylor 1.0 100)
0.5403023058681397
Not bad?
The above is the Scheme-ish way of performing a 'do' loop. You should easily be able to see the correspondence to a do with three locals for i, result and odd?.
Regarding loss of numeric precision - if you really want to solve the precision problem, then convert x to an 'exact' number and do all computation using exact numbers. By doing that, you get a natural, Scheme-ly algorithm with 'perfect' precision.
> (cosine-taylor (exact 1.0) 100)
3982370694189213112257449588574354368421083585745317294214591570720658797345712348245607951726273112140707569917666955767676493702079041143086577901788489963764057368985531760218072253884896510810027045608931163026924711871107650567429563045077012372870953594171353825520131544591426035218450395194640007965562952702049286379961461862576998942257714483441812954797016455243/7370634274437294425723020690955000582197532501749282834530304049012705139844891055329946579551258167328758991952519989067828437291987262664130155373390933935639839787577227263900906438728247155340669759254710591512748889975965372460537609742126858908788049134631584753833888148637105832358427110829870831048811117978541096960000000000000000000000000000000000000000000000000
> (inexact (cosine-taylor (exact 1.0) 100))
0.5403023058681398
we should calculate the terms in iterative fashion to prevent the loss of precision from dividing very large numbers:
(define (cosine-taylor-term x)
(let ((t 1.0) (k 0))
(lambda (msg)
(case msg
((peek) t)
((pull)
(let ((p t))
(set! k (+ k 2))
(set! t (* (- t) (/ x (- k 1)) (/ x k)))
p))))))
Then it should be easy to build a function to produce an n-th term, or to sum the terms up until a term is smaller than a pre-set precision value:
(define t (cosine-taylor-term (atan 1)))
;Value: t
(reduce + 0 (map (lambda(x)(t 'pull)) '(1 2 3 4 5)))
;Value: .7071068056832942
(cos (atan 1))
;Value: .7071067811865476
(t 'peek)
;Value: -2.4611369504941985e-8
A few suggestions:
reduce your input modulo 2pi - most polynomial expansions converge very slowly with large numbers
Keep track of your factorials rather than computing them from scratch each time (once you have 4!, you get 5! by multiplying by 5, etc)
Similarly, all your powers are powers of x^2. Compute x^2 just once, then multiply the "x power so far" by this number (x2), rather than taking x to the n'th power
Here is some python code that implements this - it converges with very few terms (and you can control the precision with the while(abs(delta)>precision): statement)
from math import *
def myCos(x):
precision = 1e-5 # pick whatever you need
xr = (x+pi/2) % (2*pi)
if xr > pi:
sign = -1
else:
sign = 1
xr = (xr % pi) - pi/2
x2 = xr * xr
xp = 1
f = 1
c = 0
ans = 1
temp = 0
delta = 1
while(abs(delta) > precision):
c += 1
f *= c
c += 1
f *= c
xp *= x2
temp = xp / f
c += 1
f *= c
c += 1
f *= c
xp *= x2
delta = xp/f - temp
ans += delta
return sign * ans
Other than that I can't help you much as I am not familiar with scheme...
For your general enjoyment, here is a stream implementation. The stream returns an infinite sequence of taylor terms based on the provided func. The func is called with the current index.
(define (stream-taylor func)
(stream-map func (stream-from 0)))
(define (stream-cosine x)
(stream-taylor (lambda (n)
(if (zero? n)
1
(let ((odd? (= 1 (modulo n 2))))
;; Use `exact` if desired...
;; and see #WillNess above; save 'last'; use for next; avoid expt/factorial
((if odd? - +) (/ (expt x (* 2 n)) (factorial (* 2 n)))))))))
> (stream-fold + 0 (stream-take 10 (stream-cosine 1.0)))
0.5403023058681397
Here's the most streamlined function I could come up with.
It takes advantage of the fact that the every term is multiplied by (-x^2) and divided by (i+1)*(i+2) to come up with the text term.
It also takes advantage of the fact that we are computing factorials of 2, 4, 6. etc. So it increments the position counter by 2 and compares it with 2*N to stop iteration.
(define (cosine-taylor x num)
(let ((mult (* x x -1))
(twice-num (* 2 num)))
(define (helper iter prev-term prev-out)
(if (= iter twice-num)
(+ prev-term prev-out)
(helper (+ iter 2)
(/ (* prev-term mult) (+ iter 1) (+ iter 2))
(+ prev-term prev-out))))
(helper 0 1 0)))
Tested at repl.it.
Here are some answers:
(cosine-taylor 1.0 2)
=> 0.5416666666666666
(cosine-taylor 1.0 4)
=> 0.5403025793650793
(cosine-taylor 1.0 6)
=> 0.5403023058795627
(cosine-taylor 1.0 8)
=> 0.5403023058681398
(cosine-taylor 1.0 10)
=> 0.5403023058681397
(cosine-taylor 1.0 20)
=> 0.5403023058681397
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 8 years ago.
Improve this question
I found a interesting thing. Passing argument may deserve consideration, especially in which situation time is important. the code like below.
(define (collatz-num n)
(define (collatz-iter n m)
(cond
((= n 1)
m)
((even? n)
(collatz-iter (/ n 2) (+ m 1)))
(else
(collatz-iter (+ (* 3 n) 1) (+ m 1)))))
(collatz-iter n 1))
(define (collatz-iter n m)
(cond
((= n 1)
m)
((even? n)
(collatz-iter (/ n 2) (+ m 1)))
(else
(collatz-iter (+ (* 3 n) 1) (+ m 1)))))
(define (euler14 n limit)
(define (help-iter m len n limit)
(let ((collatz (collatz-iter n 1)))
(cond
((> n limit)
(list m len))
((> collatz len)
(help-iter n collatz (+ n 2) limit))
(else
(help-iter m len (+ n 2) limit)))))
(help-iter 0 0 n limit))
for collatz-iter
> (time (euler14 1 1000000))
cpu time: 1596 real time: 1596 gc time: 0
for collatz-num
> (time (euler14 1 1000000))
cpu time: 1787 real time: 1789 gc time: 0
My question:
How big is the cost of passing argument in scheme
In function euler14, I let limit as argument of help-iter, will it save some time this way? as I have seen somewhere, the free variable will have cost.
Maybe I am too mean.
Again. this is very implementation specific!
I tested your code and since it does consume memory and do a lot of computations the order in which I tested the two interfered with the second result. I separated the two tests in each file and run each 40 times separately and looked at average running time for both. The differences were num: 1059.75 and iter: 1018.85. 4% difference on average, but might as well be 12% when picking two samples. I'd guess the running time of the same program might differ in more than 4% on average so the difference between these are irrelevant in one run.
You have an extra application in your code so to check how much impact an argument has I made this little test. The usage of the arguments in the base case is so that Scheme won't optimize them away:
(define (three-params x y z)
(if (zero? x)
(cons y z)
(three-params (- x 1) x x)))
(define (two-params x y)
(if (zero? x)
(cons x y)
(two-params (- x 1) x)))
(define (one-param x)
(if (zero? x)
(cons x x)
(one-param (- x 1))))
(define numtimes 100000000)
(time (one-param numtimes))
(time (two-params numtimes #f))
(time (three-params numtimes #f #f))
Comment out 2 of the three last lines and make 3 files. Compile them if you can.
The do the average of several runs. I choose 50 and in Ikarus I get the following averages:
agvms diffms
one 402.4
two 417.82 15.42
three 433.14 15.32
two2 551.38 133.56 (with an extra addition compared to two)
Just looking at the 50 results I see that the times overlap between one, two, and three, but statistically it looks like the average argument cost 0,15ns. if, zero?, - and cons and gc cost a lot more even if they are primitives. Neither extra applications nor extra arguments should be your concern. Sometimes a different implementation optimizes your code differently so changing from racket to ikarus, gambit or chicken might improve you code in production.
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
>
The following function computes the Fibonacci series by tail recursive and squaring:
(defun fib1 (n &optional (a 1) (b 0) (p 0) (q 1))
(cond ((zerop n) b)
((evenp n)
(fib1 (/ n 2)
a
b
(+ (* p p) (* q q))
(+ (* q q) (* 2 p q))))
(t
(fib1 (1- n)
(+ (* b q) (* a (+ p q)))
(+ (* b p) (* a q))
p
q))))
Basically it reduces every odd input to a even one, and reduces every even input by half. For example,
F(21)
= F(21 1 0 0 1)
= F(20 1 1 0 1)
= F(10 1 1 1 1)
= F(5 1 1 2 3)
= F(4 8 5 2 3)
= F(2 8 5 13 21)
= F(1 8 5 610 987)
= F(0 17711 10946 610 987)
= 10946
When I saw this I thought it might be better to combine the even and odd cases (since odd minus one = even), so I wrote
(defun fib2 (n &optional (a 1) (b 0) (p 0) (q 1))
(if (zerop n) b
(fib2 (ash n -1)
(if (evenp n) a (+ (* b q) (* a (+ p q))))
(if (evenp n) b (+ (* b p) (* a q)))
(+ (* p p) (* q q))
(+ (* q q) (* 2 p q)))))
and hoping this will make it faster, as the equations above now becomes
F(21)
= F(21 1 0 0 1)
= F(10 1 1 1 1)
= F(5 1 1 2 3)
= F(2 8 5 13 21)
= F(1 8 5 610 987)
= F(0 17711 10946 1346269 2178309)
= 10946
However, it turned out to be much slower (takes about 50% more time in e.g. Clozure CL, CLisp and Lispworks) when I check the time needed for Fib(1000000) by the following code (Ignore the progn, I just don't want my screen filled with numbers.)
(time (progn (fib1 1000000)()))
(time (progn (fib2 1000000)()))
I can only see fib2 may do more evenp than fib1, so why is it that much slower?
EDIT: I think n.m. get it right, and I edited the second group of formulae. E.g. in the example of F(21) above, fib2 actually computes F(31) and F(32) in p and q, which is never used. So in F(1000000), fib2 computes F(1048575) and F(1048576).
Lazy evaluation rocks, that's a very good point. I guess in Common Lisp only some macro like "and" and "or" are evaluated lazily?
The following modified fib2 (defined for n>0) actually runs faster:
(defun fib2 (n &optional (a 1) (b 0) (p 0) (q 1))
(if (= n 1) (+ (* b p) (* a q))
(fib2 (ash n -1)
(if (evenp n) a (+ (* b q) (* a (+ p q))))
(if (evenp n) b (+ (* b p) (* a q)))
(+ (* p p) (* q q))
(+ (* q q) (* 2 p q)))))
Insert printing of the intermediate results. Pay attention to p and q towards the end of the computation.
You will notice that fib2 computes much larger values for p and q at the last step. These two values account for all the performance difference.
The ironic thing is that these expensive values are unused. This is why Haskell doesn't suffer from this performance problem: the unused values are not actually computed.
If nothing else, fib2 has more conditionals (while computing the arguments). That may well change how the code flow is done. Conditionals imply jumps, implies pipeline stalls.
It would probably be instructive to look at the generated code (try (disassemble #'fib1) and (disassemble #'fib2) and see if there's any blatant differences). It might also be worth to change the optimization settings, there's usually a fair few optimizations that are not done unless you request heavy optimization for speed.
I was trying to implement Fermat's primality test in Scheme.
I wrote a procedure fermat2(initially called fermat1) which returns true
when a^p-1 congruent 1(mod p) (please read it correctly guys!!)
a
every prime p number should satisfy the procedure (And hence Fermat's little theorem .. )
for any a
But when I tried to count the number of times this procedure yields true for a fixed number of trials ... ( using countt procedure, described in code) I got shocking results ans
So I changed the procedure slightly (I don't see any logical change .. may be I'm blind) and named it fermat1(replacing older fermat1 , now old fermat1 ->fermat2) and it worked .. the prime numbers passed the test all the times ...
why on earth the procedure fermat2 called less number of times ... what is actually wrong??
if it is wrong why don't I get error ... instead that computation is skipped!!(I think so!)
all you have to do , to understand what I'm trying to tell is
(countt fermat2 19 100)
(countt fermat1 19 100)
and see for yourself.
Code:
;;Guys this is really weird
;;I might not be able to explain this
;;just try out
;;(countt fermat2 19 100)
;;(countt fermat1 19 100)
;;compare both values ...
;;did you get any error using countt with fermat2,if yes please specify why u got error
;;if it was because of reminder procedure .. please tell your scheme version
;;created on 6 mar 2011 by fedvasu
;;using mit-scheme 9.0 (compiled from source/microcode)
;; i cant use a quote it mis idents (unfriendly stack overflow!)
;;fermat-test based on fermat(s) little theorem a^p-1 congruent to 1 (mod p) p is prime
;;see MIT-SICP,or Algorithms by Vazirani or anyother number theory book
;;this is the correct logic of fermat-test (the way it handles 0)
(define (fermat1 n)
(define (tryout a x)
;; (display "I've been called\n")
(= (remainder (fast-exp a (- x 1)) x) 1))
;;this exercises the algorithm
;;1+ to avoid 0
(define temp (random n))
(if (= temp 0)
(tryout (1+ temp) n)
(tryout temp n)))
;;old fermat-test
;;which is wrong
;;it doesnt produce any error!!
;;the inner procedure is called only selective times.. i dont know when exactly
;;uncomment the display line to see how many times tryout is called (using countt)
;;i didnt put any condition when it should be called
;;rather it should be every time fermat2 is called
;;how is it so??(is it to avoid error?)
(define (fermat2 n)
(define (tryout a x)
;; (display "I've been called\n")
(= (remainder (fast-exp a (- x 1)) x) 1))
;;this exercises the algorithm
;;1+ to avoid 0
(tryout (1+ (random n)) n))
;;this is the dependency procedure for fermat1 and fermat2
;;this procedure calculates base^exp (exp=nexp bcoz exp is a keyword,a primitive)
;;And it is correct :)
(define (fast-exp base nexp)
;;this is iterative procedure where a*b^n = base^exp is constant always
;;A bit tricky though
(define (logexp a b n)
(cond ((= n 0) a);;only at the last stage a*b^n is not same as base^exp
((even? n) (logexp a (square b) (/ n 2)))
(else (logexp (* a b) b (- n 1)))))
(logexp 1 base nexp))
;;utility procedure which takes a procedure and its argument and an extra
;; argument times which tells number of times to call
;;returns the number of times result of applying proc on input num yielded true
;;counting the number times it yielded true
;;procedure yields true for fixed input,
;;by calling it fixed times)
;;uncommenting display line will help
(define (countt proc num times)
(define (pcount p n t c)
(cond ((= t 0)c)
((p n );; (display "I'm passed by fermat1\n")
(pcount p n (- t 1) (+ c 1)));;increasing the count
(else c)))
(pcount proc num times 0))
I had real pain .. figuring out what it actually does .. please follow the code and tell why this dicrepieancies?
Even (countt fermat2 19 100) called twice returns different results.
Let's fix your fermat2 since it's shorter. Definition is: "If n is a prime number and a is any positive integer less than n, then a raised to the nth power is congruent to a modulo n.". That means f(a, n) = a^n mod n == a mod n. Your code tells f(a, n) = a^(n-1) mod n == 1 which is different. If we rewrite this according to definition:
(define (fermat2 n)
(define (tryout a x)
(= (remainder (fast-exp a x) x)
(remainder a x)))
(tryout (1+ (random n)) n))
This is not correct yet. (1+ (random n)) returns numbers from 1 to n inclusive, while we need [1..n):
(define (fermat2 n)
(define (tryout a x)
(= (remainder (fast-exp a x) x)
(remainder a x)))
(tryout (+ 1 (random (- n 1))) n))
This is correct version but we can improve it's readability. Since you're using tryout only in scope of fermat2 there is no need in parameter x to pass n - latter is already bound in scope of tryout, so final version is
(define (fermat n)
(define (tryout a)
(= (remainder (fast-exp a n) n)
(remainder a n)))
(tryout (+ 1 (random (- n 1)))))
Update:
I said that formula used in fermat2 is incorrect. This is wrong because if a*k = b*k (mod n) then a = b (mod n). Error as Vasu pointed was in generating random number for test.