#lang scheme
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; CSC324 Lecture 5,
;;; Oct. 8, 2009
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; procedures as input values
(define (all-num? list)
  (or (null? list)
      (and (number? (car list))
           (all-num? (cdr list)))))

(define (abs-list list)
  (cond ((null? list) '())
        (else 
         (cons (abs (car list)) (abs-list (cdr list))))))

(define (all-num-f fun list)
  (if (all-num? list) (fun list)
      'error))  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; procedures as returned values
(define add-mult
  (lambda (x)
    (cond 
      ((and (number? x) (> x 0))
       (lambda (y) (+ x y)))
      ((and (number? x) (< x 0))
       (lambda (y) (* x y)))
      (else (lambda (x) x)))))

;; some tests for add-mult
;; ((add-mult -1) 4)
;; ((add-mult 3) 4)
;; ((add-mult 'a) 5)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; mymap -- a simple limited version of map

(define (mymap f l)
  (cond ((null? l) '())
        (else (cons (f (car l)) 
                    (mymap f (cdr l))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; myfoldr -- a simple limited version of foldr

(define (myfoldr op id list)
  (if (null? list)  id
      (op  (car list)
           (myfoldr  op id (cdr list)))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; myreducer -- define reduce-right in MIT Scheme 
(define (myreducer op id list)
  (if (null? list)  id
      (let ((h (car list)) (t (cdr list)))
        (if (null? t) h
            (op h
                (myreducer op id t))))))

;; Some test cases
;; (myreducer cons 'id '())
;; (myreducer cons 'id '(1))
;; (myreducer cons 'id '(1 2 3))

;; exmple of eval
(define (atomcount s)
  (cond ((null? s) 0)
        ((not (pair? s)) 1)
        (else
         ;(+ (map atomcount s))))
         (eval
          (cons '+ (map atomcount s)))))
  ;; another way
  ;; (apply + (map atomcount s))))
  )

;; example of eval
(define (eval-formula formula)
  (eval  `(let ([x 2] [y 3]) ,formula)))

;; prune
(define (prune test lst)
  (if (null? lst) '()
      (let* ((h (car lst)) 
             (t (cdr lst))
             (result (prune test t)))
        (cond 
          ((test h)
           (cons h result))
          (else result)))))
  
  ;; example of set!
  (define cons-count 0)
  (define (cons-co x y)
    (set! cons-count (+  cons-count  1))
    (cons x y))
  
  ;; example of assoc
  (define NAMES '((Smith Pat Q)
                  (Jones Chris J)
                  (Walker Kelly T)
                  (Thompson Shelly P)))
  
  ;; (assoc 'Smith NAMES)