;                            CS 441
;                          Assignment 1
;
;                        February 15, 1996

(define sub1
  (lambda (n)
    (- n 1)))

(define add1
  (lambda (n)
    (+ n 1)))

; Problem 2.2.7

; #1

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

; #2

(define invert
  (lambda (l)
    (if (null? l)
	'()
	(cons (list (cadar l) (caar l))
              (invert (cdr l))))))

; #3

(define list-index
  (lambda (s l)
    (cond ((null? l) -1)
	  ((eq? (car l) s) 0)
          (else
            (let ((i (list-index s (cdr l))))
              (if (= -1 i)
                  -1
                  (add1 i)))))))

; #4

(define vector-index
  (lambda (s v)
    (vector-index-help 0 s v)))

(define vector-index-help
  (lambda (n s v)
    (cond ((eq? (vector-length v) n) -1)
	  ((eq? (vector-ref v n) s) n)
	  (else (vector-index-help (add1 n) s v)))))

; #5

(define ribassoc
  (lambda (s l v fail-value)
    (if (= -1 (list-index s l))
	fail-value
	(vector-ref v (list-index s l)))))

; #6

(define filter
  (lambda (p l)
    (cond ((null? l) '())
	  ((p (car l)) (cons (car l) (filter p (cdr l))))
	  (else (filter p (cdr l))))))

; #7

(define product
  (lambda (l1 l2)
    (if (null? l1)
	'()
	(append
          (product-help (car l1) l2)
          (product (cdr l1) l2)))))

(define product-help
  (lambda (x l)
    (if (null? l)
	'()
	(cons (list x (car l))
              (product-help x (cdr l))))))

; #8

(define swapper
  (lambda (s1 s2 l)
    (if (null? l)
        '()
        (cons
          (if (symbol? (car l))
              (cond ((eq? (car l) s1) s2)
                    ((eq? (car l) s2) s1)
                    (else (car l)))
              (swapper s1 s2 (car l)))
          (swapper s1 s2 (cdr l))))))

; #9

(define rotate
  (lambda (l)
    (if (or (null? l) (null? (cdr l)))
        l
        (let ((r (rotate (cdr l))))
          (cons (car r) (cons (car l) (cdr r)))))))


; Problem 2.2.8

; #1

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

; #2

(define up
  (lambda (lst)
    (cond ((null? lst) '())
	  ((list? (car lst)) (append (car lst) (up (cdr lst))))
	  (else (cons (car lst) (up (cdr lst)))))))

; #3

(define count-occurrences
  (lambda (s l)
    (cond ((null? l) 0)
	  ((symbol? l) (if (eq? l s) 1 0))
	  (else (+ (count-occurrences s (car l))
		   (count-occurrences s (cdr l)))))))

; #4

(define flatten
  (lambda (l)
    (cond ((null? l) '())
	  ((symbol? (car l)) (cons (car l) (flatten (cdr l))))
	  (else (append (flatten (car l)) (flatten (cdr l)))))))

; #5

(define merge
  (lambda (lon1 lon2)
    (cond ((null? lon1) lon2)
	  ((null? lon2) lon1)
	  ((< (car lon1) (car lon2))
           (cons (car lon1) (merge (cdr lon1) lon2)))
	  (else
           (cons (car lon2) (merge (cdr lon2) lon1))))))



; Problem 2.2.9

; #1

(define path
  (lambda (n t)
    (cond ((null? t) '())
	  ((= n (car t)) '())
	  ((< n (car t)) (cons 'L (path n (cadr t))))
	  (else (cons 'R (path n (caddr t)))))))

; #2

(define car&cdr
  (lambda (s l errvalue)
    (let ((r (car&cdr-help s l errvalue car&cdr-compose 'lst)))
      (if (eq? r errvalue)
          errvalue
          (list 'lambda '(lst) r)))))

(define car&cdr-compose list)

(define car&cdr-help
  (lambda (s l errvalue compose f)
    (cond ((null? l)
           errvalue)
          ((symbol? l)
           (if (eq? s l) f errvalue))
          (else
            (let ((left (car&cdr-help s (car l) errvalue compose
                          (compose 'car f))))
              (if (not (eq? left errvalue))
                  left
                  (car&cdr-help s (cdr l) errvalue compose
                    (compose 'cdr f))))))))

; #3

(define car&cdr2
  (lambda (s l errvalue)
    (car&cdr-help s l errvalue car&cdr2-compose '())))

(define car&cdr2-compose
  (lambda (c-r path)
    (if (null? path)
        c-r
        (list 'compose c-r path))))

; #4

(define compose
  (lambda pl
    (if (null? pl)
	(lambda (x) x)
	(lambda (x) ((car pl) ((apply compose (cdr pl)) x))))))

; OR

(define compose
  (lambda pl
    (compose-help pl)))

(define compose-help
  (lambda (pl)
    (if (null? pl)
	(lambda (x) x)
	(lambda (x) ((car pl) ((compose-help (cdr pl)) x))))))

; #5

(define sort
  (lambda (l)
    (if (null? l)
	'()
	(sort-insert < (car l) (sort (cdr l))))))

(define sort-insert
  (lambda (p n l)
    (cond ((null? l) (list n))
	  ((p (car l) n) (cons (car l) (sort-insert p n (cdr l))))
	  (else (cons n l)))))

; #6

(define sort2
  (lambda (p l)
    (if (null? l)
	'()
	(sort-insert p (car l) (sort2 p (cdr l))))))