Trying to write hyper-operations in scheme - algorithm

I am trying to write a hyperoperation program in MIT/GNU-Scheme however am having some trouble, I have written individual ones up to n=5 working but would like to make one that functions does them all. I will include some of my failed attempts below.
(define hyp (lambda (n x y)
(hypiter n x x y)))
(define hypiter (lambda (lev an cou lim)
(if (= lev 1) an
(hypiter lev (hyp (- lev 1) an cou) cou lim))))
(define hyper (lambda (n x y)
(hyper n x x y)))
(define hyperiter (lambda (lev an cou lim)
(if (= lev 1) (+ an cou)
(hyper (- lev 1) an cou))))
(define h (lambda (n a b)
(cond
((= n 1) (+ a b))
((= b 1) (- n 1))
(else (h (- n 1) (h (- n 1) a a) (- b 1)))))))
(define hyperoperation (lambda (n a b)
(cond
((= n 0) (+ 1 b))
((and (= n 1) (= b 0)) a)
((and (= n 2) (= b 0)) 0)
((and (>= n 3) (= b 0)) 1)
(else (hyperoperation (- b 1) a (hyperoperation n a (- b 1)))))))

According to the definition in wikipedia, there is an error in the last line of your last definition. It should be:
(else (hyperoperation (- n 1) a (hyperoperation n a (- b 1))))))
instead of:
(else (hyperoperation (- b 1) a (hyperoperation n a (- b 1)))))))
So a possible correct recursive definition could be:
(define (hyperoperation n a b)
(cond ((= n 0) (+ b 1))
((= b 0) (cond ((= n 1) a)
((= n 2) 0)
(else 1)))
(else (hyperoperation (- n 1) a (hyperoperation n a (- b 1))))))

Related

How to do modulo in scheme

How would I do the following in sicp/scheme/dr. racket?
(define (even? n) (= (% n 2) 0))
Currently it seems like that's not a primitive symbol: %: unbound identifier in: %.
This may be the stupidest way in the world to do it, but without a % or bitwise-&1 I am doing (without logs or anything else):
(define (even? n)
(if (< (abs n) 2)
(= n 0)
(even? (- n 2))))
mod is modulo in scheme:
(define (even? n)
(= (modulo n 2) 0))
I think it's a good practice to get comfortable writing your own procedures when it feels like they are "missing". You could implement your own mod as -
(define (mod a b)
(if (< a b)
a
(mod (- a b) b)))
(mod 0 3) ; 0
(mod 1 3) ; 1
(mod 2 3) ; 2
(mod 3 3) ; 0
(mod 4 3) ; 1
(mod 5 3) ; 2
(mod 6 3) ; 0
(mod 7 3) ; 1
(mod 8 3) ; 2
But maybe we make it more robust by supporting negative numbers and preventing caller from divi
(define (mod a b)
(if (= b 0)
(error 'mod "division by zero")
(rem (+ b (rem a b)) b)))
(define (rem a b)
(cond ((= b 0)
(error 'rem "division by zero"))
((< b 0)
(rem a (neg b)))
((< a 0)
(neg (rem (neg a) b)))
((< a b)
a)
(else
(rem (- a b) b))))

How to write a power function in Lisp(scheme)? What's wrong with my program here?

(define (pow b n)
"YOUR-DOC-HERE"
(cond ((= n 0) 1)
((even? n) (pow (pow b (/ n 2)) 2))
((odd? n) (* b (pow (pow b (/ (- n 1) 2)) 2)))))
(define (pow b n)
"YOUR-DOC-HERE"
(cond ((= n 0) 1)
((even? n) (* (pow b (/ n 2)) (pow b (/ n 2))))
((odd? n) (* b (pow b (/ (- n 1) 2)) (pow b (/ (- n 1) 2))))))
Here are two versions of my code for a power function with logarithmic efficiency. However, the first function would have a maximum recursion depth exceeded error and the second, though works, doesn't seem to function at a required efficiency. I am new to Scheme and I wonder what's wrong with these implementations?
Your 1st version uses itself to square every value, which creates an infinite loop in the even? clause.
Your 2nd version calls pow twice in each clause which reverses any gain from the logarithmic algorithm.
Your can fix it using let like this:
(define (pow b n)
"Recursive power in logarithmic depth."
(let ((square (lambda (x) (* x x))))
(cond ((= n 0) 1)
((even? n) (square (pow b (/ n 2))))
((odd? n) (* b (square (pow b (/ (- n 1) 2))))))))
or like this:
(define (pow b n)
"Recursive power in logarithmic depth."
(cond ((= n 0) 1)
((even? n)
(let ((x (pow b (/ n 2))))
(* x x)))
((odd? n)
(let ((x (square (pow b (/ (- n 1) 2)))))
(* b x x)))))

Scheme:R5RS:: Make it ten-thousandth place value

(define m (expt 2 32))
(define a 22695477)
(define c 1.0)
(define (integers-starting-from n)
(stream-cons n (integers-starting-from (+ n 1))))
(define (prng seed)
(define xn (remainder (+ c (* a seed)) m))
(define prn (/ (remainder (+ c (* a seed)) m) m))
(stream-cons prn
(prng xn)))
When I run this code my current output is
(stream->list (prng 3) 5)
> (0.015852607786655426 0.4954120593611151 0.998752823099494 0.7253396362066269 0.03071586787700653)
But Output has to be
(stream->list (prng 3) 5)
> (0.01585 0.4954 0.9988 0.7253 0.0307)
How do I make output to ten-thousandth place value?
Here's one way, if you're using Racket:
(define (prng seed)
(define xn (remainder (+ c (* a seed)) m))
(define prn (/ (remainder (+ c (* a seed)) m) m))
(stream-cons (truncate prn 4)
(prng xn)))
(define (truncate num precision)
(string->number (~r num #:precision precision)))
Now the output will be:
'(0.0159 0.4954 0.9988 0.7253 0.0307)

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

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)))

Resources