;; CS 3520
;; Fall 2000
;; HW 2 example solution

;; 2.1 (EoPL 1.15, page 24)

;; 1.

; <list-of-obj> = () | (<obj> . <list-of-obj>)

; duple : num object -> list-of-obj
(define (duple n x)
  (cond
   [(zero? n) '()]
   [else (cons x (duple (- n 1) x))]))

(equal? (duple 0 'a) '())
(equal? (duple 10 'a) '(a a a a a a a a a a))

;; 2.

; <2-list> = (<obj> <obj>)
; <list-of-2-list> = ()  | (<2-list> . <list-of-2-list>)

; invert : list-of-2-list -> list-of-2-list
(define (invert lst)
  (cond
   [(null? lst) '()]
   [else (cons (invert/2l (car lst))
	       (invert (cdr lst)))]))

; invert/2l : 2-list -> 2-list
;  Swaps the order of the elements in the given 2-list
;   (invert/2l '(a b)) = _(b a)_
(define (invert/2l l)
  (list (cadr l) (car l)))

(equal? (invert/2l '(a b)) '(b a))

(equal? (invert '()) '())
(equal? (invert '((a 1) (a 2) (b 1) (b 2)))
	'((1 a) (2 a) (1 b) (2 b)))

;; 3.

; filter-in : pred list-of-obj -> list-of-obj
(define (filter-in pred lst)
  (cond
   [(null? lst) '()]
   [else (cond
	  [(pred (car lst)) 
	   (cons (car lst) (filter-in pred (cdr lst)))]
	  [else
	   (filter-in pred (cdr lst))])]))

(equal? (filter-in number? '()) '())
(equal? (filter-in number? '(a 2 (1 3) b 7))
	'(2 7))

;; 4.

; every? : pred  list-of-obj -> bool
(define (every? pred lst)
  (cond
   [(null? lst) #t]
   [else (and (pred (car lst))
	      (every? pred (cdr lst)))]))

(equal? (every? number? '()) #t)
(equal? (every? number? '(a 2 (1 3) b 7)) #f)
(equal? (every? number? '(2 7)) #t)

;; 5.

; exists? : pred  list-of-obj -> bool
(define (exists? pred lst)
  (cond
   [(null? lst) #f]
   [else (or (pred (car lst))
	     (exists? pred (cdr lst)))]))

(equal? (exists? number? '()) #f)
(equal? (exists? number? '(a 2 (1 3) b 7)) #t)
(equal? (exists? symbol? '(2 7)) #f)

;; 6.

; <num-or-#f> = <num> | #f

; vector-index : pred vector -> num-or-#f
(define (vector-index pred v)
  (vector-index/n pred v 0))

; vector-index/n : pred vector num -> num-or-#f
;  Finds an element in v, from n to the end of the vector,
;  that matches pred.
;   (vector-index/n number? #(a 1 c) 2) = #f
;   (vector-index/n number? #(a 1 c) 0) = 1
(define (vector-index/n pred v n)
  (cond
   [(= n (vector-length v)) #f]
   [else (cond
	  [(pred (vector-ref v n))
	   n]
	  [else
	   (vector-index/n pred v (+ n 1))])]))

(equal? (vector-index list? #()) #f)
(equal? (vector-index list? #(1 a 2)) #f)
(equal? (vector-index symbol? #(1 a 2)) 1)

;; 7.

; list-set : list-of-obj num obj -> list-of-obj
;  where n must be less than (length lst)
(define (list-set lst n x)
  (cond
   [(zero? n) (cons x (cdr lst))]
   [else (cons (car lst)
	       (list-set (cdr lst) (- n 1) x))]))

(equal? (list-set '(1) 0 'a) '(a))
(equal? (list-set '(1 2 3) 1 'a) '(1 a 3))

;; 8.

; product : list-of-obj list-of-obj ->  list-of-2-list
(define (product lst1 lst2)
  (cond
   [(null? lst1) '()]
   [else (append
	  (product1 (car lst1) lst2)
	  (product (cdr lst1) lst2))]))

; product1 : obj list-of-obj ->  list-of-2-list
;  Pairs x with each element of lst, creating a
;  list of 2-lists.
;   (product1 'x '()) = _()_
;   (product1 'x '(a b)) = _((x a) (x b))_
(define (product1 x lst)
  (cond
   [(null? lst) '()]
   [else (cons (list x (car lst))
	       (product1 x (cdr lst)))]))

(equal? (product1 1 '()) '())
(equal? (product1 2 '(a b c)) '((2 a) (2 b) (2 c)))

(equal? (product '() '(a b c)) '())
(equal? (product '(1 2 3) '(a b c)) '((1 a) (1 b) (1 c)
					    (2 a) (2 b) (2 c)
					    (3 a) (3 b) (3 c)))

;; 9.

; down : list-of-obj -> list-of-obj
(define (down lst)
  (cond
   [(null? lst) '()]
   [else (cons (list (car lst))
	       (down (cdr lst)))]))

(equal? (down '()) '())
(equal? (down '(1 (2) 3)) '((1) ((2)) (3)))

;; 10.

; vector-append-list : vector list-of-obj -> vector
(define (vector-append-list v lst)
  (let ([v2 (make-vector (+ (vector-length v)
			    (length lst)))])
    (copy-vec! v2 v 0)
    (copy-lst! v2 lst (vector-length v))
    v2))

; copy-vec! : vector vector num -> nothing
;  Copies elements of vsrc into vdest, starting with
;  position n. The vdest vector is modified, and no
;  useful result is returned.
;   (copy-vec! #(_ _ _) #(1 2 3) 1) = nothing, but
;                                     first vector changed
;                                     to #(_ 2 3)
(define (copy-vec! vdest vsrc n)
  (cond
   [(= n (vector-length vsrc))
    'done]
   [else
    (vector-set! vdest n (vector-ref vsrc n))
    (copy-vec! vdest vsrc (+ n 1))]))

; copy-vec! : vector vector num -> nothing
;  Copies elements of lst into vdest, starting with
;  position n in vdest. The vdest vector is modified, and no
;  useful result is returned.
;   (copy-vec! #(_ _ _) '(1 2) 1) = nothing, but
;                                   vector changed
;                                   to #(_ 1 2)
(define (copy-lst! vdest lst n)
  (cond
   [(null? lst)
    'done]
   [else
    (vector-set! vdest n (car lst))
    (copy-lst! vdest (cdr lst) (+ n 1))]))

(equal? (vector-append-list #(1 2 3) '()) #(1 2 3))
(equal? (vector-append-list #() '(a b c)) #(a b c))
(equal? (vector-append-list #(1 2 3) '(a b c d)) #(1 2 3 a b c d))
(equal? (vector-append-list #(1 2 3 4) '(a b c)) #(1 2 3 4 a b c))

;; 2.2 (EoPL 1.16, page 26)

;; 1.

; up : list-of-object -> list-of-object
(define (up lst)
  (cond
   [(null? lst) '()]
   [else (cond
	  [(list? (car lst))
	   (append (car lst) (up (cdr lst)))]
	  [else
	   (cons (car lst) (up (cdr lst)))])]))

(equal? (up '()) '())
(equal? (up '(1 (2) ((3)))) '(1 2 (3)))

;; Another possible implementation:
(define (up lst)
  (cond
   [(null? lst) '()]
   [else ((cond
	   [(list? (car lst)) append]
	   [else cons])
	  (car lst) (up (cdr lst)))]))

(equal? (up '()) '())
(equal? (up '(1 (2) ((3)))) '(1 2 (3)))

;; 2.

; swapper : sym sym s-list -> s-list
(define (swapper s1 s2 slist)
  (cond
   [(null? slist) '()]
   [else
    (cons (swapper/sexpr s1 s2 (car slist))
	  (swapper s1 s2 (cdr slist)))]))

; swapper/sexpr : sym sym s-expr -> s-expr
;  Replaces s1 with s2, and vice-versa, in sexpr
;   (swapper/sexpr 'x 'y 'x) = _y_
;   (swapper/sexpr 'x 'y '(x y)) = _(y x)_
(define (swapper/sexpr s1 s2 sexpr)
  (cond
   [(symbol? sexpr)
    (cond
     [(eq? sexpr s1) s2]
     [(eq? sexpr s2) s1]
     [else sexpr])]
   [else
    (swapper s1 s2 sexpr)]))

(equal? (swapper/sexpr 'a 'b 'a) 'b)
(equal? (swapper/sexpr 'a 'b 'b) 'a)
(equal? (swapper/sexpr 'a 'b '(a b)) '(b a))

(equal? (swapper 'a 'b '()) '())
(equal? (swapper 'a 'b '(a)) '(b))
(equal? (swapper 'a 'b '(((b)))) '(((a))))
(equal? (swapper 'a 'b '((a a) (b))) '((b b) (a)))

;; 3.

; count-occurrences : sym s-list -> num
(define (count-occurrences s slist)
  (cond
   [(null? slist) 0]
   [else
    (+ (count-occurrences/sexpr s (car slist))
       (count-occurrences s (cdr slist)))]))

; count-occurrences/sexpr : sym s-expr -> num
;  Counts occurrences of s in sexpr
;   (count-occurrences/sexpr 'x 'y) = 0
;   (count-occurrences/sexpr 'x '(x y)) = 1
(define (count-occurrences/sexpr s sexpr)
  (cond
   [(symbol? sexpr)
    (cond
     [(eq? sexpr s) 1]
     [else 0])]
   [else
    (count-occurrences s sexpr)]))

(equal? (count-occurrences/sexpr 'a 'a) 1)
(equal? (count-occurrences/sexpr 'a 'b) 0)
(equal? (count-occurrences/sexpr 'a '(a b a)) 2)

(equal? (count-occurrences 'a '()) 0)
(equal? (count-occurrences 'a '(a)) 1)
(equal? (count-occurrences 'a '(((a) b))) 1)
(equal? (count-occurrences 'a '((a a) (b))) 2)

;; 4.

; flatten : s-list -> list-of-obj
(define (flatten slist)
  (cond
   [(null? slist) '()]
   [else
    (append (flatten/sexpr (car slist))
	    (flatten (cdr slist)))]))

; flatten/sexpr : s-expr -> list-of-obj
;  Returns only the symbols in sexpr, in order
;   (flatten/sexpr 'x) = _(x)_
;   (flatten/sexpr '(x y)) = _(x y)_
(define (flatten/sexpr sexpr)
  (cond
   [(symbol? sexpr)
    (list sexpr)]
   [else
    (flatten sexpr)]))

(equal? (flatten/sexpr 'a) '(a))
(equal? (flatten/sexpr 'b) '(b))
(equal? (flatten/sexpr '(a b a)) '(a b a))

(equal? (flatten '()) '())
(equal? (flatten '(a)) '(a))
(equal? (flatten '(((a) b))) '(a b))
(equal? (flatten '((a a) (b))) '(a a b))

;; 5.

; merge : list-of-num list-of-num -> list-of-num
;  where lon1 and lon2 are sorted
(define (merge lon1 lon2)
  (cond
   [(null? lon1) lon2]
   [else (cond
	  [(null? lon2) lon1]
	  [else
	   (cond
	    [(< (car lon1) (car lon2))
	     (cons (car lon1)
		   (merge (cdr lon1) lon2))]
	    [else
	     (cons (car lon2)
		   (merge lon1 (cdr lon2)))])])]))

(equal? (merge '() '()) '())
(equal? (merge '(1) '()) '(1))
(equal? (merge '() '(2)) '(2))
(equal? (merge '(1) '(2)) '(1 2))
(equal? (merge '(1) '(0)) '(0 1))
(equal? (merge '(1 3 5 9) '(0 2 2.5 4 10 11)) '(0 1 2 2.5 3 4 5 9 10 11))