; 3
; 3.1
; 高階関数の例 第1引数の関数を2回適用する
(defun double (fun x) (funcall fun (funcall fun x)))

; 加算関数 add
(defun add (x y) (+ x y))

; 多値関数の例 身長と体重の2個の値を返す
(defun height-weight (person)
  (if (eq person 'gomihiroshi) (values 168 66)) )

; 階乗計算（再掲）
(defun fact (x) (if (<= x 1) 1 (* x (fact (- x 1)))))

; 副作用のないスタック操作関数
(defun noside-push (element stack) (cons element stack))
(defun noside-top (stack) (car stack))
(defun noside-pop (stack) (cdr stack))

; 副作用のあるスタック操作関数
(setf stack ())
(defun side-push (element) (setf stack (cons element stack)))
(defun side-top () (car stack))
(defun side-pop () (setf stack (cdr stack)))
; 副作用のある関数 - スタックをポップして、取り出した要素を返す
(defun side-top-and-pop () 
   (let ((top (car stack))) 		 
      (setf stack (cdr stack))
      top ))

; 3.3
; 多値を返す pop
(defun mv-pop (stack)
  (let ((top (cat stack)))
    (cons top (cdr stack)) ))

; 3.4
; ノードから距離1で連結しているサブグラフを生成
(defun make-subgraph (node anode)
  (cons node anode) )

; グラフへサブグラフの追加
(defun add-subgraph (sub graph)
  (cons sub graph) )

; グラフからサブグラフの取得
(defun detect-subgraph (node graph)
  (assoc node graph) )

; ランダムアクセスリストへのセット
(defun set-list-aref (list index value)
  (cons (cons index value) list) )

; ランダムアクセスリストから値を取り出す
(defun list-aref (list index)
  (cdr (assoc index list)) )

; 3.5
; 引数までの総和を計算する関数（再帰関数版）
(defun sum (x) 
  (if (= x 0) 
      0 
      (+ x (sum (- x 1))) ))

; 引数までの総和を計算する関数（繰り返し版）
(defun isub (x) 
  (let ((sum 0)) 
    (dotimes (i (+ x 1) sum) 
       (setf sum (+ sum i)) )))

; リストの長さを返す関数
(defun my-length (list) 
  (if (null list) 
      0
      (+ 1 (my-length (cdr list))) ))

; プラス1のマッピング関数
(defun map1+ (list) 
  (if (null list) 
      ()
      (cons (+ 1 (car list)) (map1+ (cdr list))) ))

; リストのコピー関数
(defun copy (list) 
  (if (null list) 
      ()
      (cons (car list) (copy (cdr list))) ))

; 2引数版のリスト連結関数
(defun append2 (list1 list2)
  (if (null list1)
      list2
      (cons (car list1) (append2 (cdr list1) list2)) ))

; プラス1の深いマッピング関数
(defun deep-map1+ (list) 
  (if (null list)
      ()
      (if (atom (car list))
          (cons (+ 1 (car list)) (deep-map1+ (cdr list)))
          (cons (deep-map1+ (car list)) (deep-map1+ (cdr list))) )))

; 深いコピー関数
(defun deep-copy (list) 
  (if (null list)
      ()
      (if (atom (car list))
          (cons (car list) (deep-copy (cdr list)))
          (cons (deep-copy (car list)) (deep-copy (cdr list))) )))

; 深いリストパターンのプログラム
; f を定義して使う
(defun deep (list)
  (if (null list)
      nil
      (if (atom (car list))
          (cons (f (car list)) (deep (cdr list)))
          (cons (deep (car list)) (deep (cdr list))) )))

; 長さ n のリストを生成する関数
(defun my-make-list (n)
   (if (<= n 0)
       ()
       (cons nil (my-make-list (- n 1))) ))

; 原始再帰関数で加算関数を作る
(defun add (x y)
  (if (= x 0) y
      (if (= y 0) x
          (add (1- x) (1+ y)) )))

; 昇順の整数パターンでの再帰プログラム 
; 1 からnまでの和を求める関数 sum
(defun sum (n) (sum2 1 n))
(defun sum2 (index end)
  (if (>= index end)
      index
      (+ index (sum2 (+ index 1) end)) ))

; 降順の整数パターン（普通の整数パターン）での再帰プログラム 
; 1 からnまでの和を求める関数 
; sum
(defun sum-2 (n)
  (if (<= n 1)
      1
      (+ n (sum-2 (- n 1))) ))

; 1 からnまでの和を求める関数 繰り返し版
(defun isum (x)
  (let ((sum 0))
    (dotimes (i (+ x 1) sum)
      (setf sum (+ sum i)) )))

; リストのリバースを生成する関数
(defun my-reverse (list rlist)
   (if (null list)
       rlist
       (my-reverse (cdr list) (cons (car list) rlist)) ))

; 階乗計算　（再掲）
(defun fact (n) 
  (if (<= n 1) 
      1 
      (* n (fact (- n 1))) ))

; 階乗計算 末尾再帰版
(defun fact-tail (n) (fact-tail2 n 1))
(defun fact-tail2 (n f) 
  (if (<= n 1) 
      f 
      (fact-tail2 (- n 1) (* n f)) ))

; 階乗計算 末尾再帰版 キーワード引数版
(defun fact-tail (n &optional (f 1))
   (if (<= n 1)
       f
       (fact-tail (- n 1) (* n f)) ))

; フィボナッチ関数 末尾再帰版
(defun fib-tail (n) (fib-tail2 n 0 1))
(defun fib-tail2 (n f0 f1) 
  (if (< n 1) 
      f0 
      (fib-tail2 (- n 1) f1 (+ f0 f1)) ))

; フィボナッチ関数 末尾再帰版　オプショナル引数版
(defun fib-tail (n &optional (f0 0) (f1 1)) 
  (if (< n 1) 
      f0 
      (fib-tail (- n 1) f1 (+ f0 f1)) ))

; フィボナッチ関数 繰り返し版
(defun fact-iter (n)
   (let ((f 1))
     (dotimes (i n f)
       (setf f (* (- n i) f)) )))

; 3.6
; 高階関数の例
(defun cal (fun x y) (funcall fun x y))

; 全数検索関数
(defun finds (fun key list)
   (if (null list)
       nil
       (append
          (if (funcall fun key (car list))
              (list (car list)) )
          (finds fun key (cdr list)) ) ))

; 全数検索関数　オプショナル引数版
(defun finds (fun key list &optional ret)
   (if (null list)
       (reverse ret)
       (finds fun key (cdr list) 
          (if (funcall fun key (car list))
              (cons (car list) ret)
              ret ))))

; 2関数合成
(defun compose2 (f g)
  (lambda (x) (funcall f (funcall g x))) )

; 1引数版の mapcar
(defun mapcar1 (fun list)
  (if (null list)
      nil
      (cons (funcall fun (car list)) (mapcar1 fun (cdr list))) ))

; reduce 関数
(defun my-reduce (fun list)
   (if (= (length list) 2)
       (funcall fun (car list) (car (cdr list)))
       (my-reduce 
          fun 
          (cons (my-reduce fun (list (car list) (car (cdr list)))) (cdr (cdr list))) ) ))

; 加算関数のカリー化
(defun add1 (x) 
   (lambda (y) (+ x y)) )

; 高階関数の例
(defun cal (fun x y) (funcall fun x y))

; 3.7
; 関数による分岐命令
; cond-fun
(defun cond-fun-function (cond then else)
  (if cond then else) )

; クロージャによる分岐命令の実装
(defmacro cond-fun (cond then else)
  `(cond-fun2 ,cond (lambda () ,then) (lambda () ,else)) )
(defun cond-fun2 (cond then else) 
  (if cond (funcall then) (funcall else)) )

; クォート式による分岐命令の実装
; cond-fun
(defmacro cond-fun-quote (cond then else)
  `(cond-fun2-quote ,cond ',then ',else) )
; cond-fun2
(defun cond-fun2-quote (cond then else)
  (if cond (eval then) (eval else)) )

; クロージャによる外側優先評価の加算関数の実装
(defmacro plus (a b c)
  `(outer+ (lambda () ,a) (lambda () ,b) (lambda () ,c)) )
(defun outer+ (a b c)
  (+ (funcall a) (funcall b) (funcall c)) )

; クォート式による外側優先評価の加算関数の実装
; plus
(defmacro plus-quote (a b c)
  `(outer+-quote ',a ',b ',c) )
; outer+
(defun outer+-quote (a b c)
  (+ (eval a) (eval b) (eval c)) )

;;; test
(defun test (tests)
  (dolist (test tests)
    (print test)
    (terpri)(princ "---->")
    (print (eval test)) 
    (terpri) ))

(setf tests '(

(double #'1+ 3)
(height-weight 'gomihiroshi)
(noside-push 2 (noside-push 1 ()))
(sum 10)
(sum-2 10)
(isum 10)
(my-length '(1 2 3 4 5))
(map1+ '(1 2 3 4))
(copy '(1 2 3 4))
(append2 '(1 2 3) '(4 5 6))
(deep-map1+ '((1 2) (3 4 5)))
(deep-map1+ '(1 (1 2) (3 (4 5))))
(deep-map1+ '(1 2 3 4))
(deep-copy '(1 (2 3) (4 (5 6))))
(my-make-list 4)
(add 2 3)
(my-reverse '(1 2 3) nil)
(fact-tail 10)
(fib-tail 10)
(fact-iter 10)
(finds #'= 2 '(1 2 3 2 1))
(finds #'< 2 '(1 2 3 4 5))
(funcall (compose2 #'car #'cdr) '(1 2))
(mapcar1 #'list '(1 2 3))
(my-reduce #'* '(1 2 3 4 5))
(my-reduce #'append '((1 2) (3 4) (5 6) (7 8)))
(my-reduce (lambda (x y) (concatenate 'string x y)) '("abc" "def" "ghi"))
(add1 1)
(funcall (add1 1) 2)
(cond-fun-function t (+ 1 2) (+ 3 4))
(cond-fun t (+ 1 2) (+ 3 4))
(cond-fun nil (+ 1 2) (+ 3 4))
(macroexpand '(cond-fun t (+ 1 2) (+ 3 4)))
(macroexpand '(cond-fun-quote t (+ 1 2) (+ 3 4)))
(let ((x 1) (y 3)) (cond-fun t (+ x 2) (+ y 4)))
(let ((x 1) (y 3)) (cond-fun nil (+ x 2) (+ y 4)))
(macroexpand '(plus (+ 1 2) (+ 3 4) (+ 5 6)))
(macroexpand '(plus-quote (+ 1 2) (+ 3 4) (+ 5 6)))
(plus (+ 1 2) (+ 3 4) (+ 5 6))

))

(test tests)