Representation of pairs - scheme

I am trying to write a representation of pairs that does not use cons, car or cdr but still follows the property of pairs, i.e., (car (cons x y)) should be x and (cdr (cons x y)) should be y.
So here is one solution that I got from the SICP book:
(define (special-cons x y)
(lambda (m) (m x y)))
I was able to write another solution but it can only allow numbers:
(define (special-cons a b)
(* (expt 2 a)
(expt 3 b)))
(define (num-divs n d)
(define (iter x result)
(if (= 0 (remainder x d))
(iter (/ x d) (+ 1 result))
result))
(iter n 0))
(define (special-car x)
(num-divs x 2))
(define (special-cdr x)
(num-divs x 3))
Is there any other solution that allows for pairs for any object x and object y?

What about structs (Racket) or record-types (R6RS)?
In Racket:
#lang racket
(struct cell (x y))
(define (ccons x y) (cell x y))
(define (ccar cl) (cell-x cl))
(define (ccdr cl) (cell-y cl))
(define (cpair? cl) (cell? cl))
(define x (ccons 1 2))
(cpair? x)
=> #t
(ccar (ccons 1 2))
=> 1
(ccdr (ccons 3 4))
=> 4

This is a good way of doing it.
#lang racket
(define (my-cons x y)
(lambda (p)
(if (= p 1) x y)))
(define (my-car pair)
(pair 1))
(define (my-cdr pair)
(pair 2))
Here is the test
> (my-car (my-cons 1 '(2 3 4)))
1
> (my-cdr (my-cons 1 '(2 3 4)))
'(2 3 4)

The classic Ableson and Sussman procedural implementation from Structure and Interpretation of Computer Programs (section 2.1.3):
(define (cons x y)
(define (dispatch m)
(cond ((= m 0) x)
((= m 1) y)
(else (error "Argument not 0 or 1 -- CONS" m))))
dispatch)
(define (car z)
(z 0))
(define (cdr z)
(z 1))
Rptx's solution is roughly equivalent, and this is presented for reference.

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

How to make this function elegant

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

Normal order vs Applicative order in Scheme

I got this program:
(define a 2)
(define (goo x)
(display x) (newline)
(lambda (y) (/ x y)))
(define (foo x)
(let ((f (goo a)))
(if (= x 0)
x
(f x))))
and I asked to compare the evaluation results between the applicative and normal order on the expression (foo (foo 0)).
As I know, in applicative order, (display x) in function goo will print x and after it the program will collapse because y isn't defined. But when I run it in Scheme nothing happens. What is the reason?
(foo 0) evaluates to this code:
(define (goo 2)
(display 2) (newline)
(lambda (y) (/ 2 y)))
(define (foo x)
(let ((f (goo 2)))
(if (= 0 0)
0
((lambda (y) (/ 2 y)) 0))))
and prints 2, returning 0. While (foo 4) evaluates to:
(define (goo 2)
(display 2) (newline)
(lambda (y) (/ 2 y)))
(define (foo 4)
(let ((f (goo 2)))
(if (= 4 0)
4
((lambda (y) (/ 2 y)) 4))))
and prints 2, returning 0.5.

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