Implement exercises till 2.23

ex-2_17-23.scm

@@ -0,0 +1,137 @@
+(load "util.scm")
+
+(display "ex-2.17\n")
+
+(define (last-pair a)
+  (if (null? (cdr a))
+    (car a)
+    (last-pair (cdr a))))
+
+(define a (list 1 2 3 4))
+(assert (last-pair a) 4)
+
+(display "\nex-2.18\n")
+
+; Recursive solution probably less efficient because of calls to append and
+; list.
+(define (reverse l)
+  (if (null? l)
+    l
+    (append (reverse (cdr l)) (list (car l)))))
+
+; Iterative solution. Probably much more efficient.
+(define (reverse l)
+  (define (list-iter acc l)
+    (if (null? l)
+      acc
+      (list-iter (cons (car l) acc) (cdr l))))
+  (list-iter (list) l))
+
+(display (reverse a))
+
+(display "\n\nex-2.19\n")
+
+(define us-coins (list 50 25 10 5 1))
+(define uk-coins (list 100 50 20 10 5 2 1 0.5))
+
+(define no-more? null?)
+(define first-denomination car)
+(define except-first-denomination cdr)
+
+(define (cc amount coin-values)
+  (cond ((= amount 0) 1)
+        ((or (< amount 0) (no-more? coin-values)) 0)
+        (else
+         (+ (cc amount
+                (except-first-denomination coin-values))
+            (cc (- amount
+                   (first-denomination coin-values))
+                coin-values)))))
+
+(display (cc 100 us-coins)) (newline)
+
+; The order of the values in the list do not change the result because the
+; procedure tries all potential combinations of using and not using the coins.
+(display (cc 100 (reverse us-coins)))
+
+(display "\n\nex-2.20\n")
+
+;  (define (same-parity? a b) (= (modulo a 2) (modulo b 2)))
+
+(define (same-parity x . xs)
+  (define (same-parity-iter parity-first rest)
+    (cond ((null? rest) (list))
+          ((= parity-first (modulo (car rest) 2)) (cons (car rest) (same-parity-iter parity-first (cdr rest))))
+          (else (same-parity-iter parity-first (cdr rest)))))
+  (same-parity-iter (modulo x 2) (cons x xs)))
+
+(display (same-parity -1 2 3 4 5 6 7)) (newline)
+(display (same-parity 2 3 -4 5 6 7)) (newline)
+
+(display "\nex-2.21\n")
+
+(define (square-list items)
+  (if (null? items)
+      nil
+      (cons (square (car items)) (square-list (cdr items)))))
+
+(display (square-list a)) (newline)
+
+(define (square-list items)
+  (map (lambda (x) (* x x)) items))
+
+(display (square-list a)) (newline)
+
+(display "\nex-2.22\n")
+
+(define (square-list items)
+  (define (iter things answer)
+    (if (null? things)
+        answer
+        (iter (cdr things)
+              (cons (square (car things))
+                    answer))))
+  (iter items nil))
+
+; Louis adds the first element (squared) to the accumulator for each iteration
+; step. That means later elements are prepended later, hence the order of the
+; list is reversed.
+
+(display (square-list a)) (newline)
+
+(define (square-list items)
+  (define (iter things answer)
+    (if (null? things)
+        answer
+        (iter (cdr things)
+              (cons answer
+                    (square (car things))))))
+  (iter items nil))
+
+(display (square-list a)) (newline)
+
+; Changing the arguments does not work either, because it results in building a
+; reverse list of lists, e.g.: ((((nil 16) 9) 4) 1)
+; The only solution would be to use append which is inefficient.
+
+(define (square-list items)
+  (define (iter things answer)
+    (if (null? things)
+        answer
+        (iter (cdr things)
+              (append answer (list (square (car things)))))))
+  (iter items nil)))
+
+(display (square-list a)) (newline)
+
+(display "\nex-2.23")
+
+(define (for-each proc xs)
+  (cond
+    ((null? xs) ())
+    (else (proc (car xs)) (for-each proc (cdr xs)))))
+
+(for-each (lambda (x) (newline) (display x))
+          (list 57 321 88))
+(newline)
+

ex-2_18-xx.scm

@@ -0,0 +1,40 @@
+(load "util.scm")
+
+(display "\nex-2.24\n")
+
+(define x (cons (list 1 2) (list 3 4)))
+
+(define (display-spaces n)
+  (cond ((= n 0) ())
+        (else (display " ") (display-spaces (- n 1)))))
+
+; Procedure to print a tree (in an ugly way)
+(define (display-tree tree level)
+  (if (null? tree)
+    ()
+    (cond
+      ((pair? (car tree))
+        (display-spaces level) (display tree) (newline)
+        (display-spaces (+ level 1)) (display (car tree)) (newline)
+        (display-tree (car tree) (+ level 1))
+        (display-tree (cdr tree) level))
+      (else
+        (display-spaces level)
+        (display (car tree))
+        (newline)
+        (display-tree (cdr tree) level)))))
+
+(display-tree x 0)
+
+
+(display "\nex-2.25\n")
+
+(display "\nex-2.26\n")
+
+(display "\nex-2.27\n")
+
+(display "\nex-2.28\n")
+
+(display "\nex-2.29\n")
+
+(display "\nex-2.30\n")

util.scm

@@ -13,4 +13,5 @@
 (define (average a b) (/ (+ a b) 2.0))
 (define (id n) n)
 (define (inc n) (+ n 1))
+(define nil '())