In response to the following exercise from the SICP,
Exercise 1.3. Define a procedure that takes three numbers as arguments
and returns the sum of the squares of the two larger numbers.
I wrote the following (correct) function:
(define (square-sum-larger a b c)
(cond ((or (and (> a b) (> b c)) (and (> b a) (> a c))) (+ (* a a) (* b b)))
((or (and (> a c) (> c b)) (and (> c a) (> a b))) (+ (* a a) (* c c)))
((or (and (> b c) (> c a)) (and (> c b) (> b a))) (+ (* b b) (* c c)))))
Unfortunately, that is one of the ugliest functions I've written in my life. How do I
(a) Make it elegant, and
(b) Make it work for an arbitrary number of inputs?
I found an elegant solution (though it only works for 3 inputs):
(define (square-sum-larger a b c)
(+
(square (max a b))
(square (max (min a b) c))))
If you're willing to use your library's sort function, this becomes easy and elegant.
(define (square-sum-larger . nums)
(define sorted (sort nums >))
(let ((a (car sorted))
(b (cadr sorted)))
(+ (* a a) (* b b))))
In the above function, nums is a "rest" argument, containing a list of all arguments passed to the function. We just sort that list in descending order using >, then square the first two elements of the result.
I don't know if it's elegant enough but for a 3 argument version you can use procedure abstraction to reduce repetition:
(define (square-sum-larger a b c)
(define (square x)
(* x x))
(define (max x y)
(if (< x y) y x))
(if (< a b)
(+ (square b) (square (max a c)))
(+ (square a) (square (max b c)))))
Make it work for an arbitrary number of inputs.
(define (square-sum-larger a b . rest)
(let loop ((a (if (> a b) a b)) ;; a becomes largest of a and b
(b (if (> a b) b a)) ;; b becomes smallest of a and b
(rest rest))
(cond ((null? rest) (+ (* a a) (* b b)))
((> (car rest) a) (loop (car rest) a (cdr rest)))
((> (car rest) b) (loop a (car rest) (cdr rest)))
(else (loop a b (cdr rest))))))
A R6RS-version using sort and take:
#!r6rs
(import (rnrs)
(only (srfi :1) take))
(define (square-sum-larger . rest)
(apply +
(map (lambda (x) (* x x))
(take (list-sort > rest) 2))))
You don't need to bother sorting you just need the find the greatest two.
(define (max-fold L)
(if (null? L)
#f
(reduce (lambda (x y)
(if (> x y) x y))
(car L)
L)))
(define (remove-num-once x L)
(cond ((null? L) #f)
((= x (car L)) (cdr L))
(else (cons (car L) (remove-once x (cdr L))))))
(define (square-sum-larger . nums)
(let ((max (max-fold nums)))
(+ (square max)
(square (max-fold (remove-num-once max nums))))))
(square-sum-larger 1 8 7 4 5 6 9 2)
;Value: 145
Im want to make a function where rootcheck has a list L as input, L always is 3 atoms (a b c) where a is coefficient of x^2, b coef of x and c is the constant. it checks if the equation is quadratic, using discriminant (b^2 - 4ac) and should output this (num 'L) where num is the number of roots and L is a list that contains the roots themselves (using quadratic formula), L is empty in case of no roots. here is my code:
(define roots-2
(lambda (L)
(let ((d (- (* (cdr L) (cdr L)) (4 (car L) (caddr L))))))
(cond ((< d 0) (cons(0 null)))
((= d 0) (cons(1 null)))
(else((> d 0) (cons(2 null)))))
))
its giving me no expression in body error.
also I tried to code the quadratic function and even tried some that are online, one compiled fint but gave me an error when I inserted input this is the code for the quadratic function, NOT MINE!
(define quadratic-solutions
(lambda (a b c) (list (root1 a b c) (root2 a b c))))
(define root1
(lambda (a b c) (/ (+ (- b) (sqrt (discriminant a b c)))
(* 2 a))))
(define root2
(lambda (a b c) (/ (- (- b) (sqrt (discriminant a b c)))
(*2 a))))
(define discriminant
(lambda (a b c) (- (square b) (* 4 (* a c)))))
There are several mistakes in the code:
Some parentheses are incorrectly placed, use a good IDE to detect such problems. This is causing the error reported, the let doesn't have a body
You forgot to multiply in the 4ac part
You're incorrectly accessing the second element in the list
The else part must not have a condition
The output list is not correctly constructed
This should fix the errors, now replace null with the actual call to the function that calculates the roots for the second and third cases (the (< d 0) case is fine as it is):
(define roots-2
(lambda (L)
(let ((d (- (* (cadr L) (cadr L)) (* 4 (car L) (caddr L)))))
(cond ((< d 0) (list 0 null))
((= d 0) (list 1 null))
(else (list 2 null))))))
for the quadractic function part, I found a code online and tweaked it to provide both roots of a quadratic equation. returns a list of both roots
(define (solve-quadratic-equation a b c)
(define disc (sqrt (- (* b b)
(* 4.0 a c))))
(list (/ (+ (- b) disc) (* 2.0 a))
(/ (- (- b) disc) (* 2.0 a))
))
This question already has answers here:
Closed 10 years ago.
Possible Duplicate:
multiplicative inverse of modulo m in scheme
I have written a code for finding to solve x and y as a pair.
I need to write a modular-inverse code that finds the multiplicative inverse of e modulo n, using ax + by = 1.
Blockquote
(define (ax+by=1 a b)
(if (= b 0)
(cons 1 0)
(let* ((q (quotient a b))
(r (remainder a b))
(e (ax+by=1 b r))
(s (car e))
(t (cdr e)))
(cons t (- s (* q t))))))
Edit : Problem Solved with the function below.
Blockquote
(define inverse-mod (lambda (a m)
(if (not (= 1 (gcd a m)))
(display "**Error** No inverse exists.")
(if (> 0(car (ax+by=1 a m)))
(+ (car (ax+by=1 a m)) m)
(car (ax+by=1 a m))))))
Consider the Extended Euclidean Algorithm
This uses the extended euclidean algorithm to find the modular inverse:
(define (inverse x m)
(let loop ((x x) (b m) (a 0) (u 1))
(if (zero? x)
(if (= b 1) (modulo a m)
(error 'inverse "must be coprime"))
(let* ((q (quotient b x)))
(loop (modulo b x) x u (- a (* u q)))))))
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)))
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))