;;;
;;; MIDTERM REVIEW SOLUTIONS
;;;


;;
;; Defining Higher Order Procedures
;;

(define (test-all proc sent)
  (= (count (keep proc sent) sent) (count sent)))

(define (count-true proc sent)
  (count (keep proc sent)))

(define (find-first proc sent)
  (cond ((empty? sent) #f)
	((proc (first sent)) (first sent))
	(else (find-first proc (bf sent)))))

(define (find-first proc sent)
  (let ((filtered-sent (keep proc sent)))
    (if (empty? filtered-sent)
	#f
	(first filtered-sent))))

;;
;; zip
;;

(define (zip x y)
  (if (empty? x)
      y
      (se (first x) (zip y (bf x)))))


;;
;; reverse
;;

(define (reverse wd-or-sent) 
  (let ((combiner (if (word? wd-or-sent) word sentence)))
    (accumulate (lambda (x y) (combiner y x)) wd-or-sent)))



;;
;; repeated
;;

(define (compose f g)
  (lambda (x) (f (g x))))

(define (repeated proc num)
  (if (= num 1) 
      proc
      (compose proc (repeated proc (- num 1)))))

;;
;; gcf, lcm
;;

(define (1-to-num num)
  (if (= num 1) 
      1 
      (se (1-to-num (- num 1)) num)))

(define (prime? num)
  (= (count (factors num)) 2))

(define (factors num)
  (if (= num 0)
      (se 0)
      (keep (lambda (x)
	      (= (remainder num x) 0))
	    (1-to-num num))))

(define (prime-factorization num)
  (if (or (= num 0) (prime? num)) 
       (se num)  
      (let ((dividend (first (bf (bl (factors num))))))
	(se dividend (prime-factorization (quotient num dividend))))))


(define (gcf x y)
  (if (or (= x 0) (= y 0))
      0
      (last (keep (lambda (elem) (member? elem (factors x))) (factors y))) ))

(define (remove-first wd sent)
  (cond ((empty? sent) '())
	((equal? wd (first sent)) (bf sent))
	(else (se (first sent) (remove-first wd (bf sent))))))

(define (merge sent1 sent2)
  (cond ((empty? sent1) 
	 sent2)
	((member? (first sent1) sent2) 
	 (se (first sent1) 
	     (merge (bf sent1) (remove-first (first sent1) sent2))))
	(else (se (first sent1) (merge (bf sent1) sent2)))))
	

(define (lcm x y)
  (let ((xfact (prime-factorization x)) 
	(yfact (prime-factorization y)))
    (accumulate * (merge xfact yfact)))) 

(define (lcm x y)
  (let ((gcfactor (gcf x y)))
    (if (= gcfactor 0)
	0
	(* gcfactor (/ x gcfactor) (/ y gcfactor) ))))


;;
;; Pascal-Row
;;

(define (pascal-row row)
  (if (= row 0) 
      (se 1)
      (let ((prev-row (pascal-row (- row 1))))
	(double-every + 
		    (se prev-row 0)
		    (se 0 prev-row)))))




;;
;; Calculator (order-of-operations)
;;

;; Recursive solution

(define (second sent) (first (bf sent)))
(define (third sent) (first (bf (bf sent))))

(define (get-mult-div op)
  (cond ((equal? op '*) *)
	((equal? op '/) /)
	(else #f)))
(define (get-add-sub op)
  (cond ((equal? op '+) +)
	((equal? op '-) -)
	(else #f)))

(define (calc-helper get-op sent)
  (cond ((or (empty? sent) (empty? (bf sent))) sent)
	((get-op (second sent))
	 (calc-helper get-op 
		      (se ((get-op (second sent)) (first sent) (third sent)) 
			  (bf (bf (bf sent))))))
	(else
	 (cons (first sent) (cons (second sent)
				  (calc-helper get-op (bf (bf sent))))))))

(define (calc sent)
  (first (calc-helper get-add-sub (calc-helper get-mult-div sent))))

;; Higher order solution
(define (left-accumulate proc sent) 
  (if (= (count sent) 1)
      (last sent)
      (proc (left-accumulate proc (bl sent)) (last sent))))

(define (calc-helper get-op left right)
  (cond ((word? left) (se left right))
	((get-op (last left)) 
	 (se (bl (bl left)) 
	     ((get-op (last left)) (last (bl left)) right)))
	(else (se left right))))


(define (calc sent)
  (first (left-accumulate (lambda (x y) (calc-helper get-add-sub x y)) 
			  (left-accumulate (lambda (x y) (calc-helper get-mult-div x y)) sent))))


;;;
;;; snack-n
;;;  

(define (snack-n sent)
  (if (= (count sent) 1) 
      1
      (accumulate + (every (lambda (x) 
			     (snack-n (remove-1 x sent)))
			   (1-to-num (count sent))))))

(define (remove-1 pos sent)
  (cond ((empty? sent) '())
	((and (= pos 1) (= (first sent) 1)) (bf sent))
	((= pos 1) (se (- (first sent) 1) (bf sent)))
	(else (se (first sent) (remove-1 (- pos 1) (bf sent))))))