Printing decimal numbers get rounded up in chicken-scheme - scheme

I have a scheme procedure that returns 0.24999999999999992 as a result. However, when I tried to print this result with chicken-scheme on my machine, it gets rounded to 0.25. How can I prevent rounding?
I tried running the same procedure on repl.it, and the print command here outputs the result without rounding.
If it helps, the code below:
(define (sum term a next b)
(if
(> a b)
0
(+ (term a) (sum term (next a) next b))
)
)
(define (integral-simpson f a b n)
(define h (/ (- b a) n))
(define (inc x) (+ x 1))
(define (term x)
(cond
((or (= x 0) (= x n)) (f (+ a (* x h))))
((even? x) (* 2 (f (+ a (* x h)))))
((odd? x) (* 4 (f (+ a (* x h)))))
)
)
(* (/ h 3)
(sum
term
a
inc
n
)
)
)
(define (cube x)
(* x x x)
)
(print (integral-simpson cube 0 1 100))

Try changing the print precision: (flonum-print-precision 17)

Related

How to duplicate a list in Scheme x times?

I am just starting to learn Scheme and using cons is a little confusing to me. I have a function duplicate (s number) where s is a list, and number is the number of times the list should be duplicated.
If I enter (duplicate '(1 2) 3), the output should be ((1 2) (1 2) (1 2))
My program looks like this, but when I run it, there is nothing in the output
(define (duplicate s number)
(cond [(null? s) '()]
[(> 0 number) (cons (list s) (duplicate s(- number 1)))]
))
What am I doing wrong here?
We want second input n become zero complete all list.
And we want output is a list so we use cons.
You can build your code by using minimum sample than add more complex data.
If input is (duplicate x 0) we want output is '().
If input is (duplicate x 1) we want output is '(x).
So your code should looks like this
(define (duplicate x n)
(cond
[(= n 0) '()]
[else
(cons x ...)]))
But we already know we want output is '(x) which is (cons x '()).
Obvious '() is (duplicate x 0)'s output. So we add (duplicate x (- n 1)) in second condition.
#lang racket
(define (duplicate x n)
(cond
[(= n 0) '()]
[else
(cons x (duplicate x (- n 1)))]))
;;; TEST
(duplicate '() 0)
(duplicate '() 3)
(duplicate '() 5) ; '(() () () () ())
(duplicate '(1 2) 5) ; '((1 2) (1 2) (1 2) (1 2) (1 2))
Or you can think like this way.
We have employee help us copy document.
employee-1 : We give him a number than he minus 1 than order employee-2 do his job
employee-2 : He copy a document than send message to employee-3
employee-3 : He supervision finish or not (number become zero). If not finish send message to employee-1.
So we want something like this
finish? -> no -> minus-1 -> copy -> finish? -> no -> minus-1 -> ...
#lang racket
(define x 1)
(define result '())
(define (employee-1 n)
(employee-2 (- n 1)))
(define (employee-2 n)
(begin
(set! result (cons x result))
(employee-3 n)))
(define (employee-3 n)
(if (= n 0)
result
(employee-1 n)))
;;; TEST
(employee-3 3) ; '(1 1 1)
Than we combine employee-1 to employee-3
(define x 1)
(define result '())
; (define (employee-1 n) (employee-2 (- n 1)))
(define (employee-2 n)
(begin
(set! result (cons x result))
(employee-3-v2 n)))
(define (employee-3-v2 n)
(if (= n 0)
result
(employee-2 (- n 1))))
;;; TEST
(employee-3-v2 3) ; '(1 1 1)
We use function input replace define global variable. So we have to remove set! and change input parameter.
; (define x 1)
; (define result '())
; (define (employee-1 n) (employee-2 (- n 1)))
(define (employee-2-v2 n x result)
(employee-3-v2 n x (cons x result)))
(define (employee-3-v2 n x result)
(if (= n 0)
result
(employee-2-v2 (- n 1) x result)))
;;; TEST
(employee-3-v2 3 1 '()) ; '(1 1 1)
Than we combine employee-2-v2 to employee-3-v2. Remember we have to change input parameter.
(define (employee-3-v3 n x result)
(if (= n 0)
result
(employee-3-v3 (- n 1) x (cons x result))))
;;; TEST
(employee-3-v3 3 'x '()) ; '(x x x)
Now we want remove not necessary input parameter result.
(define (employee-3-v4 n x)
(if (= n 0)
'()
(cons x (employee-3-v4 (- n 1) x))))
;;; TEST
(build-list 10 (λ (n) (employee-3-v4 n 'x)))
#|
output:
'(()
(x)
(x x)
(x x x)
(x x x x)
(x x x x x)
(x x x x x x)
(x x x x x x x)
(x x x x x x x x)
(x x x x x x x x x))
|#

Extended Euclidian Algorithm in Scheme

I'm trying to write a code for extended Euclidian Algorithm in Scheme for an RSA implementation.
The thing about my problem is I can't write a recursive algorithm where the output of the inner step must be the input of the consecutive outer step. I want it to give the result of the most-outer step but as it can be seen, it gives the result of the most inner one. I wrote a program for this (it is a bit messy but I couldn't find time to edit.):
(define ax+by=1
(lambda (a b)
(define q (quotient a b))
(define r (remainder a b))
(define make-list (lambda (x y)
(list x y)))
(define solution-helper-x-prime (lambda (a b q r)
(if (= r 1) (- 0 q) (solution-helper-x-prime b r (quotient b r) (remainder b r)))
))
(define solution-helper-y-prime (lambda (a b q r)
(if (= r 1) (- r (* q (- 0 q) )) (solution-helper-y-prime b r (quotient b r) (remainder b r))
))
(define solution-first-step (lambda (a b q r)
(if (= r 1) (make-list r (- 0 q))
(make-list (solution-helper-x-prime b r (quotient b r) (remainder b r)) (solution-helper-y-prime b r (quotient b r) (remainder b r))))
))
(display (solution-first-step a b q r))
))
All kinds of help and advice would be greatly appreciated. (P.S. I added a scrrenshot of the instructions that was given to us but I can't see the image. If there is a problem, please let me know.)
This is a Diophantine equation and is a bit tricky to solve. I came up with an iterative solution adapted from this explanation, but had to split the problem in parts - first, obtain the list of quotients by applying the extended Euclidean algorithm:
(define (quotients a b)
(let loop ([a a] [b b] [lst '()])
(if (<= b 1)
lst
(loop b (remainder a b) (cons (quotient a b) lst)))))
Second, go back and solve the equation:
(define (solve x y lst)
(if (null? lst)
(list x y)
(solve y (+ x (* (car lst) y)) (cdr lst))))
Finally, put it all together and determine the correct signs of the solution:
(define (ax+by=1 a b)
(let* ([ans (solve 0 1 (quotients a b))]
[x (car ans)]
[y (cadr ans)])
(cond ((and (= a 0) (= b 1))
(list 0 1))
((and (= a 1) (= b 0))
(list 1 0))
((= (+ (* a (- x)) (* b y)) 1)
(list (- x) y))
((= (+ (* a x) (* b (- y))) 1)
(list x (- y)))
(else (error "Equation has no solution")))))
For example:
(ax+by=1 1027 712)
=> '(-165 238)
(ax+by=1 91 72)
=> '(19 -24)
(ax+by=1 13 13)
=> Equation has no solution

Implementation of Simpson's Rule (SICP Exercise 1.29)

Following is my code for SICP exercise 1.29. The exercise asks us to implement
Simpson's Rule using higher order procedure sum. It's supposed to be more
accurate than the original integral procedure. But I don't know why it's not
the case in my code:
(define (simpson-integral f a b n)
(define h (/ (- b a) n))
(define (next x) (+ x (* 2 h)))
(* (/ h 3) (+ (f a)
(* 4 (sum f (+ a h) next (- b h)))
(* 2 (sum f (+ a (* 2 h)) next (- b (* 2 h))))
(f b))))
Some explanations of my code: As
h/3 * (y_{0} + 4*y_{1} + 2*y_{2} + 4*y_{3} + 2*y_{4} + ... + 2*y_{n-2} + 4*y_{n-1} + y_{n})
equals
h/3 * (y_{0}
+ 4 * (y_{1} + y_{3} + ... + y_{n-1})
+ 2 * (y_{2} + y_{4} + ... + y_{n-2})
+ y_{n})
I just use sum to compute y_{1} + y_{3} + ... + y_{n-1} and y_{2} +
y_{4} + ... + y_{n-2}.
Complete code here:
#lang racket
(define (cube x) (* x x x))
(define (sum term a next b)
(if (> a b)
0
(+ (term a)
(sum term (next a) next b))))
(define (integral f a b dx)
(define (add-dx x) (+ x dx))
(* (sum f (+ a (/ dx 2.0)) add-dx b)
dx))
(define (simpson-integral f a b n)
(define h (/ (- b a) n))
(define (next x) (+ x (* 2 h)))
(* (/ h 3) (+ (f a)
(* 4 (sum f (+ a h) next (- b h)))
(* 2 (sum f (+ a (* 2 h)) next (- b (* 2 h))))
(f b))))
Some tests(The exact value should be 0.25):
> (integral cube 0 1 0.01)
0.24998750000000042
> (integral cube 0 1 0.001)
0.249999875000001
> (simpson-integral cube 0 1.0 100)
0.23078806666666699
> (simpson-integral cube 0 1.0 1000)
0.24800798800666748
> (simpson-integral cube 0 1.0 10000)
0.2499999999999509
In your solution the x-values are computed as follows:
h = (b-a)/n
x1 = a+1
x3 = x1 +2*h
x5 = x3 +2*h
...
This means rounding errors slowly accumulate.
It happens when (b-a)/n is not representable as floating point.
If we instead compute xi as a+ (i*(b-a))/n you will get more accurate results.
This variant of your solution uses the above method to compute the xi.
(define (simpson-integral3 f a b n)
(define h (/ (- b a) n))
(define (next i) (+ i 2))
(define (f* i) (f (+ a (/ (* i (- b a)) n))))
(* (/ h 3)
(+ (f a)
(* 4 (sum f* 1 next n))
(* 2 (sum f* 2 next (- n 1)))
(f b))))
There's a problem in how you're constructing the terms, the way you're alternating between even terms (multiplied by 2) and odd terms (multiplied by 4) is not correct. I solved this problem by passing an additional parameter to sum to keep track of the current term's even-or-odd nature, there are other ways but this worked for me, and the accuracy got improved:
(define (sum term a next b i)
(if (> a b)
0
(+ (term a i)
(sum term (next a) next b (+ i 1)))))
(define (simpson-integral f a b n)
(let* ((h (/ (- b a) n))
(term (lambda (x i)
(if (even? i)
(* 2.0 (f x))
(* 4.0 (f x)))))
(next (lambda (x) (+ x h))))
(* (+ (f a)
(sum term a next b 1)
(f b))
(/ h 3.0))))
(simpson-integral cube 0 1 1000)
=> 0.2510004999999994

Miller-Rabin Scheme implementation unpredictable output

I am new to Scheme. I have tried and implemented probabilistic variant of Rabin-Miller algorithm using PLT Scheme. I know it is probabilistic and all, but I am getting the wrong results most of the time. I have implemented the same thing using C, and it worked well (never failed a try). I get the expected output while debugging, but when I run, it almost always returns with an incorrect result. I used the algorithm from Wikipedia.
(define expmod( lambda(b e m)
;(define result 1)
(define r 1)
(let loop()
(if (bitwise-and e 1)
(set! r (remainder (* r b) m)))
(set! e (arithmetic-shift e -1))
(set! b (remainder (* b b) m))
(if (> e 0)
(loop)))r))
(define rab_mil( lambda(n k)
(call/cc (lambda(breakout)
(define s 0)
(define d 0)
(define a 0)
(define n1 (- n 1))
(define x 0)
(let loop((count 0))
(if (=(remainder n1 2) 0)
(begin
(set! count (+ count 1))
(set! s count)
(set! n1 (/ n1 2))
(loop count))
(set! d n1)))
(let loop((count k))
(set! a (random (- n 3)))
(set! a (+ a 2))
(set! x (expmod a d n))
(set! count (- count 1))
(if (or (= x 1) (= x (- n 1)))
(begin
(if (> count 0)(loop count))))
(let innerloop((r 0))
(set! r (+ r 1))
(if (< r (- s 1)) (innerloop r))
(set! x (expmod x 2 n))
(if (= x 1)
(begin
(breakout #f)))
(if (= x (- n 1))
(if (> count 0)(loop count)))
)
(if (= x (- s 1))
(breakout #f))(if (> count 0) (loop count)))#t))))
Also, Am I programming the right way in Scheme? (I am not sure about the breaking out of loop part where I use call/cc. I found it on some site and been using it ever since.)
Thanks in advance.
in general you are programming in a too "imperative" fashion; a more elegant expmod would be
(define (expmod b e m)
(define (emod b e)
(case ((= e 1) (remainder b m))
((= (remainder e 2) 1)
(remainder (* b (emod b (- e 1))) m)
(else (emod (remainder (* b b) m) (/ e 2)))))))
(emod b e))
which avoids the use of set! and just implements recursively the rules
b^1 == b (mod m)
b^k == b b^(k-1) (mod m) [k odd]
b^(2k) == (b^2)^k (mod m)
Similarly the rab_mil thing is programmed in a very non-scheme fashion. Here's an alternative implementation. Note that there is no 'breaking' of the loops and no call/cc; instead the breaking out is implemented as a tail-recursive call which really corresponds to 'goto' in Scheme:
(define (rab_mil n k)
;; calculate the number 2 appears as factor of 'n'
(define (twos-powers n)
(if (= (remainder n 2) 0)
(+ 1 (twos-powers (/ n 2)))
0))
;; factor n to 2^s * d where d is odd:
(let* ((s (twos-powers n 0))
(d (/ n (expt 2 s))))
;; outer loop
(define (loop k)
(define (next) (loop (- k 1)))
(if (= k 0) 'probably-prime
(let* ((a (+ 2 (random (- n 2))))
(x (expmod a d n)))
(if (or (= x 1) (= x (- n 1)))
(next)
(inner x next))))))
;; inner loop
(define (inner x next)
(define (i r x)
(if (= r s) (next)
(let ((x (expmod x 2 n)))
(case ((= x 1) 'composite)
((= x (- n 1)) (next))
(else (i (+ 1 r) x))))
(i 1 x))
;; run the algorithm
(loop k)))

SICP Exercise 1.3 request for comments

I'm trying to learn scheme via SICP. Exercise 1.3 reads as follow: Define a procedure that takes three numbers as arguments and returns the sum of the squares of the two larger numbers. Please comment on how I can improve my solution.
(define (big x y)
(if (> x y) x y))
(define (p a b c)
(cond ((> a b) (+ (square a) (square (big b c))))
(else (+ (square b) (square (big a c))))))
Using only the concepts presented at that point of the book, I would do it:
(define (square x) (* x x))
(define (sum-of-squares x y) (+ (square x) (square y)))
(define (min x y) (if (< x y) x y))
(define (max x y) (if (> x y) x y))
(define (sum-squares-2-biggest x y z)
(sum-of-squares (max x y) (max z (min x y))))
big is called max. Use standard library functionality when it's there.
My approach is different. Rather than lots of tests, I simply add the squares of all three, then subtract the square of the smallest one.
(define (exercise1.3 a b c)
(let ((smallest (min a b c))
(square (lambda (x) (* x x))))
(+ (square a) (square b) (square c) (- (square smallest)))))
Whether you prefer this approach, or a bunch of if tests, is up to you, of course.
Alternative implementation using SRFI 95:
(define (exercise1.3 . args)
(let ((sorted (sort! args >))
(square (lambda (x) (* x x))))
(+ (square (car sorted)) (square (cadr sorted)))))
As above, but as a one-liner (thanks synx # freenode #scheme); also requires SRFI 1 and SRFI 26:
(define (exercise1.3 . args)
(apply + (map! (cut expt <> 2) (take! (sort! args >) 2))))
What about something like this?
(define (p a b c)
(if (> a b)
(if (> b c)
(+ (square a) (square b))
(+ (square a) (square c)))
(if (> a c)
(+ (square a) (square b))
(+ (square b) (square c)))))
I did it with the following code, which uses the built-in min, max, and square procedures. They're simple enough to implement using only what's been introduced in the text up to that point.
(define (sum-of-highest-squares x y z)
(+ (square (max x y))
(square (max (min x y) z))))
Using only the concepts introduced up to that point of the text, which I think is rather important, here is a different solution:
(define (smallest-of-three a b c)
(if (< a b)
(if (< a c) a c)
(if (< b c) b c)))
(define (square a)
(* a a))
(define (sum-of-squares-largest a b c)
(+ (square a)
(square b)
(square c)
(- (square (smallest-of-three a b c)))))
(define (sum-sqr x y)
(+ (square x) (square y)))
(define (sum-squares-2-of-3 x y z)
(cond ((and (<= x y) (<= x z)) (sum-sqr y z))
((and (<= y x) (<= y z)) (sum-sqr x z))
((and (<= z x) (<= z y)) (sum-sqr x y))))
(define (f a b c)
(if (= a (min a b c))
(+ (* b b) (* c c))
(f b c a)))
Looks ok to me, is there anything specific you want to improve on?
You could do something like:
(define (max2 . l)
(lambda ()
(let ((a (apply max l)))
(values a (apply max (remv a l))))))
(define (q a b c)
(call-with-values (max2 a b c)
(lambda (a b)
(+ (* a a) (* b b)))))
(define (skip-min . l)
(lambda ()
(apply values (remv (apply min l) l))))
(define (p a b c)
(call-with-values (skip-min a b c)
(lambda (a b)
(+ (* a a) (* b b)))))
And this (proc p) can be easily converted to handle any number of arguments.
With Scott Hoffman's and some irc help I corrected my faulty code, here it is
(define (p a b c)
(cond ((> a b)
(cond ((> b c)
(+ (square a) (square b)))
(else (+ (square a) (square c)))))
(else
(cond ((> a c)
(+ (square b) (square a))))
(+ (square b) (square c)))))
You can also sort the list and add the squares of the first and second element of the sorted list:
(require (lib "list.ss")) ;; I use PLT Scheme
(define (exercise-1-3 a b c)
(let* [(sorted-list (sort (list a b c) >))
(x (first sorted-list))
(y (second sorted-list))]
(+ (* x x) (* y y))))
Here's yet another way to do it:
#!/usr/bin/env mzscheme
#lang scheme/load
(module ex-1.3 scheme/base
(define (ex-1.3 a b c)
(let* ((square (lambda (x) (* x x)))
(p (lambda (a b c) (+ (square a) (square (if (> b c) b c))))))
(if (> a b) (p a b c) (p b a c))))
(require scheme/contract)
(provide/contract [ex-1.3 (-> number? number? number? number?)]))
;; tests
(module ex-1.3/test scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(planet "text-ui.ss" ("schematics" "schemeunit.plt" 2)))
(require 'ex-1.3)
(test/text-ui
(test-suite
"ex-1.3"
(test-equal? "1 2 3" (ex-1.3 1 2 3) 13)
(test-equal? "2 1 3" (ex-1.3 2 1 3) 13)
(test-equal? "2 1. 3.5" (ex-1.3 2 1. 3.5) 16.25)
(test-equal? "-2 -10. 3.5" (ex-1.3 -2 -10. 3.5) 16.25)
(test-exn "2+1i 0 0" exn:fail:contract? (lambda () (ex-1.3 2+1i 0 0)))
(test-equal? "all equal" (ex-1.3 3 3 3) 18))))
(require 'ex-1.3/test)
Example:
$ mzscheme ex-1.3.ss
6 success(es) 0 failure(s) 0 error(s) 6 test(s) run
0
It's nice to see how other people have solved this problem. This was my solution:
(define (isGreater? x y z)
(if (and (> x z) (> y z))
(+ (square x) (square y))
0))
(define (sumLarger x y z)
(if (= (isGreater? x y z) 0)
(sumLarger y z x)
(isGreater? x y z)))
I solved it by iteration, but I like ashitaka's and the (+ (square (max x y)) (square (max (min x y) z))) solutions better, since in my version, if z is the smallest number, isGreater? is called twice, creating an unnecessarily slow and circuitous procedure.
(define (sum a b) (+ a b))
(define (square a) (* a a))
(define (greater a b )
( if (< a b) b a))
(define (smaller a b )
( if (< a b) a b))
(define (sumOfSquare a b)
(sum (square a) (square b)))
(define (sumOfSquareOfGreaterNumbers a b c)
(sumOfSquare (greater a b) (greater (smaller a b) c)))
I've had a go:
(define (procedure a b c)
(let ((y (sort (list a b c) >)) (square (lambda (x) (* x x))))
(+ (square (first y)) (square(second y)))))
;exercise 1.3
(define (sum-square-of-max a b c)
(+ (if (> a b) (* a a) (* b b))
(if (> b c) (* b b) (* c c))))
I think this is the smallest and most efficient way:
(define (square-sum-larger a b c)
(+
(square (max a b))
(square (max (min a b) c))))
Below is the solution that I came up with. I find it easier to reason about a solution when the code is decomposed into small functions.
; Exercise 1.3
(define (sum-square-largest a b c)
(+ (square (greatest a b))
(square (greatest (least a b) c))))
(define (greatest a b)
(cond (( > a b) a)
(( < a b) b)))
(define (least a b)
(cond ((> a b) b)
((< a b) a)))
(define (square a)
(* a a))

Resources