;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;             U. C. Berkeley            ;;
;;      EECS Computer Science Division   ;;
;;     CS3 Lecture 12 (Advanced Lists)   ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;
;; Association Lists
;;;;;;;;;;;;;;;;;;;;

(define *numbers* 
  '((dan 555-1212)
    (info 411)
    (info 511)
    (pizza 123-345-4577 111-122-2222)))

(assoc 'info     *numbers*) ;; ==> (info 411)
(assoc 'pizza    *numbers*) ;; ==> (pizza 123-345-4577 111-122-2222)
(assoc 'hospital *numbers*) ;; ==> #f

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Arbitrary number of arguments
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; anoat = "Arbitrary number of arguments test"
(define (anoat x y . L)
  (display "x : ") (display x) (newline)
  (display "y : ") (display y) (newline)
  (display "L : ") (display L) (newline)
  'done)
(anoat) ;; ==> error
(anoat 1) ;; ==> error
(anoat 1 2) ;; ==> L is ()
(anoat 1 2 3) ;; ==> L is (3)
(anoat 1 2 3 4) ;; ==> L is (3 4)

;; greetings
;;
;; INPUTS       : A first name, last name and (optional) letters
;; RETURNS      : A greeting for the person

(define (greetings first-name last-name . letters)
   (append (list 'hello first-name last-name) letters))

(greetings 'madonna)
;; *** Error:
;;     too few arguments to: (greetings (quote madonna))
;; Current eval stack:
;; __________________
;;   0    (greetings (quote madonna))

(greetings 'barack 'obama)
;; ==> (hello barack obama)

(greetings 'Maick 'Griebenow 'MD 'DDS 'PhD 'FRCMFS)
;; ==> (hello maick griebenow md dds phd frcmfs)

;; my+

(define (my+ . L-of-nums)
  (reduce + L-of-nums))

(my+)
(my+ 1 2 4 1000)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Recursion on Arbitrary Structured Lists
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (1+ x) (+ x 1))

;; Add 1 to every number in a simple list (all of numbers)

(define (shallow-add1-recur L)
   (cond ((null? L) L)
         ((not (list? (car L))) ;; Always true since simple list
          (cons (1+ (car L))
		(shallow-add1-recur (cdr L))))))
		
(shallow-add1-recur '(1 2 3))
;; ==> (2 3 4)

;; But now that we have HOFs we just write it with those
;; since this is a standard mapping pattern

(define (shallow-add1-hof L)  ;; L a simple list, e.g., (1 2 3)
  (map 1+ L))

(shallow-add1-hof '(1 2 3))
;; ==> (2 3 4)

;; Now let's see how much we have to change to go deep

(define (deep-add1-recur1 L)
  (if (null? L)
      L
      (cons (if (list? (car L))               ;; car isn't always # 
                (deep-add1-recur1 (car L))   ;; if it's not, recurse
                (1+ (car L)))                 ;; if it is, same as before
	    (deep-add1-recur1 (cdr L)))))

(deep-add1-recur1 '(1 2 3))
;; ==> (2 3 4)
(deep-add1-recur1 '((1 2 (3 4 5) 6) 7 (((8)))) )
;; ==> ((2 3 (4 5 6) 7) 8 (((9))))

;; Seems like we could still use our HOF; it's still a mapping
;; pattern. The lambda looks remarkably similar to the 3 lines above

(define (deep-add1-hof L)
  (map (lambda (Ln)
	 (if (list? Ln)
	     (deep-add1-hof Ln)
	     (+ 1 Ln)))
       L))

(deep-add1-hof '(1 (2) ((3)) (((4)))) )
;; ==> ((2 3 (4 5 6) 7) 8 (((9))))

;; Let's take another look at this. What if we
;; considered three cases:
;; (1) null list
;; (2) car is not a list (proceed as in shallow case)
;; (3) recurse on both car AND cdr (called car-cdr recursion)

(define (deep-add1-carcdr1 L)
  (cond ((null? L) L)
	((not (list? (car L)))
	 (cons (1+ (car L))
	       (deep-add1-carcdr1 (cdr L))))
	(else (cons (deep-add1-carcdr1 (car L))
		    (deep-add1-carcdr1 (cdr L))))))

(deep-add1-carcdr1 '(1 (2) ((3)) (((4)))) )
;; ==> ((2 3 (4 5 6) 7) 8 (((9))))

;; Let's take another look at this. What if we
;; considered three cases:
;; (1) null list
;; (2) argument wasn't a list at all!
;; (3) recurse on both car AND cdr

(define (deep-add1-carcdr2 Ln)
  (cond ((null? Ln) Ln)
	((not (list? Ln)) (+ Ln 1))
	(else (cons (deep-add1-carcdr2 (car Ln))
		    (deep-add1-carcdr2 (cdr Ln))))))

(deep-add1-carcdr2 '(1 (2) ((3)) (((4)))) )
;; ==> ((2 3 (4 5 6) 7) 8 (((9))))

;;;;;;;;;;
;; flatten
;;;;;;;;;;

(define (flatten1 L)
  (cond ((null? L) L)
	((not (list? (car L)))
	 (cons (car L)
	       (flatten1 (cdr L))))
	(else (append (flatten1 (car L))
		      (flatten1 (cdr L))))))

(flatten1 '(1 2 3 4))
(flatten1 '(1 (2) ((3)) (((4)))) )

(define (flatten2 Ln)
  (cond ((null? Ln) Ln)
	((not (list? Ln)) (list Ln))
	(else (append (flatten2 (car Ln))
		      (flatten2 (cdr Ln))))))

(flatten2 '(1 2 3 4))
(flatten2 '(1 (2) ((3)) (((4)))) )

;;;;;;;;;;;;;;
;; deep-reduce
;;;;;;;;;;;;;;

(define (deep-reduce1 f base L)
  (cond ((null? L) base)
	((not (list? (car L)))
	 (f (car L)
	    (deep-reduce1 f base (cdr L))))
	(else (f (deep-reduce1 f base (car L))
		 (deep-reduce1 f base (cdr L))))))

(deep-reduce1 + 0 '(1 2 3 4))
(deep-reduce1 + 0 '(1 (2) ((3)) (((4)))) )

(define (deep-reduce2 f base Ln)
  (cond ((null? Ln) base)
	((not (list? Ln)) Ln)
	(else (f (deep-reduce2 f base (car Ln))
		 (deep-reduce2 f base (cdr Ln))))))

(deep-reduce2 + 0 '(1 2 3 4))
(deep-reduce2 + 0 '(1 (2) ((3)) (((4)))) )