Solutions to the first homework assignment


2.2.7:1 (duple n x) returns a list containing n copies of x.

(define duple
  (lambda (n x)
    (if (zero? n)
        '()
        (cons x (duple (- n 1) x)))))

2.2.7:2(invert lst), where lst is a list of 2-lists, retuns a list with each 2-list reversed.

(define invert
  (lambda (lst)
    (map (lambda (elm) (list (cadr elm) (car elm))) lst)))

2.2.7:3(list-index s los) returns the zero-based index of the first occurrence of s in los, or -1 if there is no occurence of s in los.

(define list-index
  (lambda (s los)
    (list-index-helper s los 0)))

(define list-index-helper
  (lambda (s los level)
    (if (null? los)
        -1
        (if (eq? s (car los))
            level
            (list-index-helper s (cdr los) (+ level 1))))))
level is a kind of accumulator that stores the value of the index as the recursion proceeds. Since it needs to be initialized, the helping procedure is employed.
2.2.7:4(vector-index s vos) retuns the zero-based index of the first occurence of s in vos, or -1 if there is no occurence of s in vos.

(define vector-index
  (lambda (s vos)
    (vector-index-helper s vos 0)))

(define vector-index-helper
  (lambda (s vos index)
    (if (<= (vector-length vos) index)
        -1
        (if (eq? s (vector-ref vos index))
            index
            (vector-index-helper s vos (+ index 1))))))

2.2.7:5(ribassoc s los v fail-value) returns the value in v that is associated with s, or fail-value if there is no associated value.

(define ribassoc
  (lambda (s los v fail-value)
    (ribassoc-helper s los v fail-value 0)))

(define ribassoc-helper
  (lambda (s los v fail-value index)
    (if (null? los)
        fail-value
        (if (eq? s (car los))
            (vector-ref v index)
            (ribassoc-helper s (cdr los) v fail-value (+ index 1))))))

2.2.7:6(filter-in p lst), where p, is a predicate, returns the list of those elements in lst that satisfy the predicate.

(define filter-in
  (lambda (p lst)
    (if (null? lst)
        '()
        (if (p (car lst))
            (cons (car lst) (filter-in p (cdr lst)))
            (filter-in p (cdr lst))))))

2.2.7:7 (product los1 los2) returns the Cartesian product of the two lists.

(define product
  (lambda (los1 los2)
    (if (null? los1)
        '()
        (append (map (lambda (selection) (list (car los1) selection)) los2)
                (product (cdr los1) los2)))))

2.2.7:8(swapper s1 s2 slst) returns slst with all occurrences of s1 and s2 interchanged.

(define swapper
  (lambda (s1 s2 slist)
     (if (list? slist)
         (map (lambda (x) (swapper s1 s2 x)) slist)
         (if (eq? slist s1)
             s2
             (if (eq? slist s2)
                 s1
                 slist)))))

2.2.7:9(rotate los) "cycles" a list once to the right.

(define rotate
  (lambda (los)
    (if (null? los)
        '()
        (cons (last los) (all-but-last los)))))

(define last
  (lambda (los)
    (if (null? (cdr los))
        (car los)
        (last (cdr los)))))

(define all-but-last
  (lambda (los)
    (if (null? (cdr los))
        '()
        (cons (car los) (all-but-last (cdr los))))))

2.2.8:1(down lst) wraps parentheses around each top-level element of lst.

(define down
  (lambda (lst)
    (map list lst)))

2.2.8:2 (up lst) removes a pair of parentheses from each top-level element of lst. If a top-level element is not a list, it is included in the result, as is. The value of (up (down lst)) is equivalent to lst, but (down (up lst)) is not necessarily lst.
(define up
  (lambda (lst)
    (if (null? lst)
        '()
        (if (list? (car lst))
            (append (car lst) (up (cdr lst)))
            (cons (car lst) (up (cdr lst)))))))

2.2.8:3 (count-occurrences s slst) retuns the number of occurrences of s in slst.

(define count-occurrences
  (lambda (s slst)
    (apply + (map (lambda (se) (count-occurrences-in-se s se)) slst))))

(define count-occurrences-in-se
  (lambda (s se)
    (if (symbol? se)
        (if (eq? s se) 1 0)
        (count-occurrences s se))))

2.2.8:4(flatten '(a b c)) removes all the inner parentheses in the list.

(define flatten
  (letrec ([h
	     (lambda (ls)
	       (cond
		 [(null? ls) '()]
		 [(list? (car ls))
		  (append (h (car ls))
		    (h (cdr ls)))]
		 [else (cons (car ls)
			 (h (cdr ls)))]))])
    h))

2.2.8:5(merge lon1 lon2) merges the two ordered lists in ascending order.

(define (merge lon1 lon2)
  (if (null? lon1)
      lon2
      (if (null? lon2)
          lon1
          (if (<= (car lon1) (car lon2))
              (cons (car lon1) (merge (cdr lon1) lon2))
              (cons (car lon2) (merge lon1 (cdr lon2)))))))

2.2.9:1 Given a number and a binary search tree that contains that number, construct a list of Ls and Rs describing the path from the root to the node containing the number.

(define path
  (lambda (n bst)
    (if (< n (car bst))
        (cons 'L (path n (cadr bst)))
        (if (< (car bst) n)
            (cons 'R (path n (caddr bst)))
            '()))))

2.2.9.2 Given a symbol, an s-list, and an error value, construct a Scheme expression denoting a procedure that takes any s-list of the same structure as the given one and returns the value in the position corresponding to the leftmost occurrence of the symbol in the original s-list. If the symbol does not occur in the original s-list, return the error value.
(define car&cdr 
  (lambda (s slst errvalue)
    (car&cdr-helper s slst errvalue '())))

(define car&cdr-helper
  (lambda (s slst errvalue stack)
    (if (null? slst)
        errvalue
        ((lambda (car-result)
           (if (eq? car-result errvalue)
               (car&cdr-helper s (cdr slst) errvalue (cons 'cdr stack))
               car-result))
         (car&cdr-helper-se s (car slst) errvalue (cons 'car stack))))))

(define car&cdr-helper-se
  (lambda (s se errvalue stack)
    (if (symbol? se)
        (if (eq? se s)
            (list 'lambda '(lst) (unstack stack 'lst))
            errvalue)
        (car&cdr-helper s se errvalue stack))))

(define unstack
  (lambda (stack base)
    (if (null? stack)
        base
        (list (car stack) (unstack (cdr stack) base)))))

2.2.9:3 The same as the earier one, only the constructed expression consists of procedure compositions.

(define car&cdr2
  (lambda (s slst errvalue)
    (car&cdr2-helper s slst errvalue '())))

(define car&cdr2-helper
  (lambda (s slst errvalue stack)
    (if (null? slst)
        errvalue
        (if (eq? s (car slst))
            (form-composition (cons 'car stack))
            (if (symbol? (car slst))
                (car&cdr2-helper s (cdr slst) errvalue (cons 'cdr stack))
                ((lambda (car-result)
                   (if (eq? car-result errvalue)
                       (car&cdr2-helper s
                                        (cdr slst)
                                        errvalue
                                        (cons 'cdr stack))
                       car-result))
                 (car&cdr2-helper s
                                  (car slst)
                                  errvalue
                                  (cons 'car stack))))))))

(define form-composition
  (lambda (stack)
    (if (null? (cdr stack))
        (car stack)
        (list 'compose (car stack) (form-composition (cdr stack))))))

2.2.9:4 A generalized compose procedure.

(define compose
  (lambda list-of-procedures
    (lambda (argument)
      (if (null? list-of-procedures)
          argument
          ((car list-of-procedures)
           ((apply compose (cdr list-of-procedures)) argument))))))

2.2.9:5 A procedure to sort a list of numbers.

(define sort1
  (lambda (lon)
    (if (null? lon)
        '()
        (insert1 (car lon) (sort1 (cdr lon))))))

(define insert1
  (lambda (new sorted)
    (if (null? sorted)
        (list new)
        (if (<= new (car sorted))
            (cons new sorted)
            (cons (car sorted) (insert1 new (cdr sorted)))))))

2.2.9:6 A procedure to sort a list of numbers with a given binary predicate.

(define sort2
  (lambda (predicate lon)
    (if (null? lon)
        '()
        (insert2 predicate (car lon) (sort2 predicate (cdr lon))))))

(define insert2
  (lambda (predicate new sorted)
    (if (null? sorted)
        (list new)
        (if (predicate new (car sorted))
            (cons new sorted)
            (cons (car sorted) (insert2 predicate new (cdr sorted)))))))

Vikram Subramaniam, 1995