diff --git a/ex-1_29-34.scm b/ex-1_29-34.scm index 26b4aca..83a35ca 100644 --- a/ex-1_29-34.scm +++ b/ex-1_29-34.scm @@ -1,21 +1,4 @@ -; utils -(define (inc n) (+ n 1)) -(define (cube n) (* n n n)) -(define (square n) (* n n)) -(define (identity n) n) -(define (even? n) (= (remainder n 2) 0)) -(define (odd? n) (= (remainder n 2) 1)) -(define (divides? a b) (= (remainder b a) 0)) -(define (gcd a b) (if (= b 0) a (gcd b (remainder a b)))) - -; copied prime? from 1.21 -(define (find-divisor n test-divisor) - (cond ((> (square test-divisor) n) n) - ((divides? test-divisor n) test-divisor) - (else (find-divisor n (+ test-divisor 1))))) -(define (smallest-divisor n) - (find-divisor n 2)) -(define (prime? n) (if (= n 1) #f (= n (smallest-divisor n)))) +(load "util.scm") (display "ex-1.29") (newline) diff --git a/ex-2_33-xx.scm b/ex-2_33-43.scm similarity index 54% rename from ex-2_33-xx.scm rename to ex-2_33-43.scm index d13ef7b..a1d2d7c 100644 --- a/ex-2_33-xx.scm +++ b/ex-2_33-43.scm @@ -107,7 +107,7 @@ (display (fold-right list nil (list 1 2 3))) (newline) ; (1 (2 (3 ()) (display (fold-left list nil (list 1 2 3))) (newline) ; (() 1) 2) 3) -(display "\nex-2.39\n") +(display "\nex-2.39 - reverse via foldl and foldr\n") (define (reverse-l sequence) (fold-left (lambda (x y) (cons y x)) nil sequence)) @@ -119,5 +119,109 @@ (display (reverse-r (list 1 2 3 4))) (newline) (display (reverse-l (list 1 2 3 4))) (newline) -(display "\nex-2.40\n") +(display "\nex-2.40 - prime pairs\n") + +(define (flatmap proc seq) + (accumulate append nil (map proc seq))) + +; Two versions for remove from me and the official one +(define (remove x s) + (cond + ((null? s) s) + ((= x (car s)) (cdr s)) + (else (cons (car s) (remove x (cdr s)))))) + +(define (remove x s) + (accumulate (lambda (current rest) + (if (= current x) rest (cons current rest))) + nil s)) + +(define (remove item sequence) + (filter (lambda (x) (not (= x item))) + sequence)) + +(define (prime-sum? p) (prime? (+ (car p) (cadr p)))) + +(define (prime-sum-pairs n) + (map make-pair-sum + (filter prime-sum? + (flatmap + (lambda (i) + (map (lambda (j) (list i j)) + (enumerate-interval 1 (- i 1)))) + (enumerate-interval 1 n))))) + +(define (permutations s) + (if (null? s) ; empty set? + (list nil) ; sequence containing empty set + (flatmap (lambda (x) + (map (lambda (p) (cons x p)) + (permutations (remove x s)))) + s))) + +(define (make-pair-sum p) + (list (car p) (cadr p) (+ (car p) (cadr p)))) + +(display (permutations (list 1 2))) (newline) +(display (prime-sum-pairs 3)) (newline) + +; Here starts the actual exercise +(define (unique-pairs n) + (flatmap + (lambda (a) (map (lambda (b) (list a b)) (enumerate-interval 1 (- a 1)))) + (enumerate-interval 1 n))) + +(display (unique-pairs 3)) (newline) + +(define (prime-sum-pairs n) + (map make-pair-sum + (filter prime-sum? (unique-pairs n)))) + +(display (prime-sum-pairs 3)) (newline) + + +(display "\nex-2.41 - unique triples\n") + +(define (unique-triples n) + (flatmap + (lambda (c) + (flatmap (lambda (b) + (map (lambda (a) (list a b c)) + (enumerate-interval 1 (- b 1)))) + (enumerate-interval 1 (- c 1)))) + (enumerate-interval 1 n))) + + +(define (add-lower-numbers xs) + (flatmap + (lambda (x) + (map (lambda (i) (cons i x)) + (enumerate-interval 1 (- (car x) 1)))) + xs)) + +(define (unique-tuples n k) + (define (add-element tuples k) + (if (= k 0) + tuples + (add-element (add-lower-numbers tuples) (- k 1)))) + (add-element (map list (enumerate-interval 1 n)) (- k 1))) + +(define (list-sum l) + (accumulate + 0 l)) + +(define (unique-sum-triples n s) + (filter (lambda (t) (= (list-sum t) s)) (unique-triples n))) + +(display (unique-sum-triples 6 10)) (newline) + +(define (unique-sum-triples n s) + (filter (lambda (t) (= (list-sum t) s)) (unique-tuples n 3))) + +(display (unique-sum-triples 6 10)) (newline) + +(display "\nex-2.42\n") + + +(display "\nex-2.43\n") + diff --git a/ex-2_44-52.scm b/ex-2_44-52.scm new file mode 100644 index 0000000..f79f94c --- /dev/null +++ b/ex-2_44-52.scm @@ -0,0 +1,21 @@ +(load "util.scm") + +(display "\nex-2.44\n") + +(display "\nex-2.45\n") + +(display "\nex-2.46\n") + +(display "\nex-2.47\n") + +(display "\nex-2.48\n") + +(display "\nex-2.49\n") + +(display "\nex-2.50\n") + +(display "\nex-2.51\n") + +(display "\nex-2.52\n") + + diff --git a/util.scm b/util.scm index 269058c..24258ba 100644 --- a/util.scm +++ b/util.scm @@ -12,6 +12,25 @@ (define (average a b) (/ (+ a b) 2.0)) (define (id n) n) +(define identity id) (define (inc n) (+ n 1)) (define nil '()) +(define (divides? a b) (= (remainder b a) 0)) +(define (cube n) (* n n n)) +(define (even? n) (= (remainder n 2) 0)) +(define (odd? n) (= (remainder n 2) 1)) +; copied prime? from 1.21 +(define (find-divisor n test-divisor) + (cond ((> (square test-divisor) n) n) + ((divides? test-divisor n) test-divisor) + (else (find-divisor n (+ test-divisor 1))))) +(define (smallest-divisor n) + (find-divisor n 2)) +(define (prime? n) (if (= n 1) #f (= n (smallest-divisor n)))) + +; https://mitpress.mit.edu/sites/default/files/sicp/full-text/book/book-Z-H-15.html +(define (enumerate-interval low high) + (if (> low high) + nil + (cons low (enumerate-interval (+ low 1) high))))