;; Procedure Abstraction
;;
;; File:	procedure-abstraction.in
;; Version:	2
;; Author:	walton@das.harvard.edu

(defun square (n) (* n n))
--->
SQUARE

#'square
--->
#<CLOSURE SQUARE (N) (DECLARE (SYSTEM::IN-DEFUN SQUARE))
  (BLOCK SQUARE (* N N))>

#'(lambda (n) (* n n))
--->
#<CLOSURE :LAMBDA (N) (* N N)>

(function (lambda (n) (* n n)))
--->
#<CLOSURE :LAMBDA (N) (* N N)>

(square 3)
--->
9

(funcall #'(lambda (n) (* n n)) 3)
--->
9

(funcall #'square 3)
--->
9

(funcall (function square) 3)
--->
9



;; (my-mapcar #'f '()) ===> '()
;; (my-mapcar #'f '(x . y)) ===>
;;	(cons (funcall #'f 'x) (my-mapcar  #'f 'y))
;;
;; where f, x, y are s-expressions
;;
(defun my-mapcar (f w)
  (cond
   ((null w) nil)
   (t (cons (funcall f (car w))
	    (my-mapcar f (cdr w))))))
--->
MY-MAPCAR



(my-mapcar #'square '())
--->
NIL

(my-mapcar #'square '(5))
--->
(25)

(my-mapcar #'square '(5 3))
--->
(25 9)

(my-mapcar #'oddp '(1 2 3 4 5))
--->
(T NIL T NIL T)



;; (sum m n) ===> 0                       if m > n
;;           ===> (+ m (sum (+ m 1) n))   otherwise
;;
;; where m, n are numbers
;;
(defun sum (m n)
  (cond
   ((> m n) 0)
   (t (+ m (sum (+ m 1) n)))))
--->
SUM

(sum 1 3)
--->
6

(sum 2 5)
--->
14



;; (sum-square m n)
;;    ===> 0                            if m > n
;;    ===> (+ (square m)
;;            (sum-square (+ m 1) n))   otherwise
;;
;; where m, n are numbers
;;
(defun sum-square (m n)
  (cond
   ((> m n) 0)
   (t (+ (square m) (sum-square (+ m 1) n)))))
--->
SUM-SQUARE

(sum-square 1 3)
--->
14

(sum-square 2 5)
--->
54



;; (sum-term #'f m n s)
;;    ===> 0                                if m > n
;;    ===> (+ (funcall #'f m)
;;            (sum-term #'f (+ m s) n s))   otherwise
;;
;; where f is an s-expression,   m, n, s are numbers
;;
(defun sum-term (f m n s)
  (cond
   ((> m n) 0)
   (t (+ (funcall f m) (sum-term f (+ m s) n s)))))
--->
SUM-TERM


(sum 1 3)
--->
6

(sum-term #'(lambda (n) n) 1 3 1)
--->
6

(sum-square 2 5)
--->
54

(sum-term #'square 2 5 1)
--->
54

; Need to compile for subsequent examples:

(compile 'sum-term)
--->
SUM-TERM



(defun integral (f x1 x2 dx)
  (sum-term
   #'(lambda (x) (* dx (funcall f (+ x (* 0.5 dx)))))
   x1 x2 dx))
--->
INTEGRAL

;; Area under straight line y = x from x = 0.0 to
;; x = 4.0:
;;
(integral #'(lambda (x) x) 0.0 3.999 0.01)
--->
7.999999999999961

(integral #'(lambda (x) x) 0.0 3.9999 0.001)
--->
7.999999999999506

;; Area under quarter circle of unit radius from
;; x = 0.0 to x = 1.0:
;;
(integral
  #'(lambda (x) (sqrt (- 1.0 (* x x))))
  0.0 0.999 0.01)
--->
0.7854842144750017

(integral
  #'(lambda (x) (sqrt (- 1.0 (* x x))))
  0.0 0.9999 0.001)
--->
0.7854008862282249

(/ pi 4)
--->
0.78539816339744830963L0




;; Computing PI by series:

(defun sum-pi (m)
  (* 8 (sum-term
	#'(lambda (n) (/ 1.0 (* n (+ n 2))))
	1 (* 4 m) 4)))
--->
SUM-PI

(sum-pi 10)
--->
3.0916238066678385

(sum-pi 100)
--->
3.1365926848388166

(sum-pi 1000)
--->
3.141092653621043

pi
--->
3.1415926535897932385L0



;; Streams:

;; (stream-car '()) ===> nil
;; (stream-car '(x . f)) ===> 'x
;;
;; where x, f are s-expressions
;;
(defun stream-car (w) (car w))
--->
STREAM-CAR

;; (stream-cdr '()) ===> nil
;; (stream-cdr '(x . f)) ===> (funcall 'f)
;;
;; where x, f are s-expressions
;;
(defun stream-cdr (w)
  (cond
   ((null w) nil)
   (t (funcall (cdr w)))))
--->
STREAM-CDR



(defun integers-from (n)
  (cons n #'(lambda () (integers-from (+ n 1)))))
--->
INTEGERS-FROM

(setf natural-numbers (integers-from 0))
--->
(0 . #<CLOSURE :LAMBDA NIL (INTEGERS-FROM (+ N 1))>)

(stream-cdr natural-numbers)
--->
(1 . #<CLOSURE :LAMBDA NIL (INTEGERS-FROM (+ N 1))>)

(stream-cdr (stream-cdr natural-numbers))
--->
(2 . #<CLOSURE :LAMBDA NIL (INTEGERS-FROM (+ N 1))>)

(stream-cdr (stream-cdr (stream-cdr natural-numbers)))
--->
(3 . #<CLOSURE :LAMBDA NIL (INTEGERS-FROM (+ N 1))>)