;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Lisp サンプルプログラム 
;;;
;;; 階乗計算、フィボナッチ数計算、2引数版append、1引数版の mapcar、
;;; クイックソート、ハノイの塔、4本ハノイの塔、nクィーン問題
;;;
;;; (追加)
;;; 高階関数の例 - 全数検索を追加
;;; 末尾再帰の階乗計算とフィビナッチ数計算
;;; ISLisp 版と Common Lisp 版の両方を同梱
;;;
;;; (修正)
;;; フィボナッチ数計算((fib 0)の値を1にしていたが正しくは0)
;;;
;;; このプログラムファイルのロード方法
;;; ISLisp>(load "samples.txt")
;;;
;;; このプログラムの動作例
;;; ISLisp>(fact 50) → 30414093201713378043612608166064768844377641568960512000000000000
;;; ISLisp>(fib 11) → 89
;;; ISLisp>(append2 '(1 2 3) '(4 5 6)) → (1 2 3 4 5 6)
;;; ISLisp>(mapcar1 (lambda (x) (* x 2)) '(1 2 3)) → (2 4 6)
;;; ISLisp>(qsort #'< '(5 4 3 2 1)) → (1 2 3 4 5)
;;; ISLisp>(hanoi 5) → 31回の移動
;;; ISLisp>(nqueen 9) → 352個の解
;;;
;;; (C) 2015 GOMI Hiroshi
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;
;;; 階乗
;;;
(defun fact (n)
  (if (<= n 1) 
     1                           ; n が 1以下であれば、1 を返す
     (* n (fact (- n 1))) ))     ; n が 1より大きければ、再帰呼び出し

;;;
;;; フィボナッチ数
;;;
(defun fib (n) 
   (if (<= n 1) 
       n
       (+ (fib (- n 1)) (fib (- n 2))) ))

;;;
;;; 2引数版の append
;;;
(defun append2 (list1 list2)
   (if (null list1) 
       list2
       (cons (car list1) (append2 (cdr list1) list2)) ))

;;;
;;; 1引数版の mapcar
;;;
(defun mapcar1 (lambda list)
   (if (null list)
       nil
       (cons (apply lambda (list (car list))) ; mapcar はこのように car を実行する
             (mapcar1 lambda (cdr list)) )))

;;;
;;; クイックソート
;;;
(defun qsort (lambda list)
   (if (null list)
       list
       ; クイックソートのピボット(基準値)は先頭の値(car list)にする
       (qsort2 lambda (car list) (cdr list) nil nil) ))

;; lambda 比較関数、p ピボット、list データ、left 比較で true、right そうでないもの
(defun qsort2 (lambda p list left right)
   (if (null list)
       (append (qsort lambda left) (cons p (qsort lambda right)))
       ;; ピボット p よりも lambdaなものを left にそうでないものを right に入れる
       (if (apply lambda (car list) (list p))
           (qsort2 lambda p (cdr list) (cons (car list) left) right)
           (qsort2 lambda p (cdr list) left (cons (car list) right)) )))

;;;
;;; ハイブリッド版のクイックソート
;;;
(defun iqsort (lambda list)
   (if (null list)
       list
       (let ((p (car list))
             (left nil)
             (right nil))
          ;; この繰り返し文によってピボットでデータを振り分ける
          ;; Common Lisp では (dolist (n list) ...) になる
          (for ((n (cdr list) (cdr n)))
               ((null n) nil)
               (let ((e (car n)))
                  (if (apply lambda e (list p))
                      (setq left (cons e left))
                      (setq right (cons e right)) )))
          ;; 以下は再帰プログラミングにする
          (append (iqsort lambda left) (list p) (iqsort lambda right)) )))

;;;
;;; ハイブリッド版のクイックソートの Common Lisp 版
;;;
(defun iqsort-cl (lambda list)
   (if (null list)
       list
       (let ((p (car list))
             (left nil)
             (right nil))
          ;; この繰り返し文によってピボットでデータを振り分ける
          (dolist (e (cdr list))
             (if (apply lambda e (list p))
                 (push e left)
                 (push e right) ))
          ;; 以下は再帰プログラミングにする
          (append (iqsort-cl lambda left) (list p) (iqsort-cl lambda right)) )))

;;;
;;; 3本ハノイの塔
;;;
(defun hanoi (n) (hanoi3 n 'from 'to 'other) )  ; n は円盤の枚数、from から to へ移動させます

(defun hanoi3 (n from to other)                 ; from は移動元、to は移動先、otherはワーク用の柱
    (if (= n 1) 
        (cons (cons from to) nil)               ; 円盤が1枚なら from から to へ移動させて終了
        (append                                 ; 円盤が2枚以上のときは
	   (hanoi3 (- n 1) from other to)       ; 最初に from から other へ
           (hanoi3 1 from to other)             ; 次にfrom から to へ
           (hanoi3 (- n 1) other to from) )))   ; 最後に other から to へ移動させる
                                                ; append はリストを連結させる関数

;;;
;;; 4本ハノイの塔
;;;
(defun hanoi4 (n from to other1 other2)
   ;; 2枚以内であれば、3本ハノイの塔と同じ
   (if (< n 3)
       (hanoi3 n from to other1)
       (if (= n 3)
           ;; 3枚のときは最初の1枚をother1に移動し、後は円盤2枚の3本ハノイと同じ
           ;; で、最後に最初の1枚をother1からtoへ移動して移動完了
           (append (list (cons from other1)) (hanoi3 2 from to other2) (list (cons other1 to)))
           ;; 4枚以上あるときは、いくつかのアルゴリズムがありますが、ここでは以下の
           ;; アルゴリズムにしています。これを解読して、さらに改良してみてください。
           (append (hanoi4 (- n 3) from other1 other2 to)
                   (hanoi3 3 from to other2)
                   (hanoi4 (- n 3) other1 to other2 from) ))))

;;;
;;; nクイーン（エイトクイーン）
;;;
(defun nqueen (n)
   (nqueen2 n 1 nil) )

;;; 引数n     --- 女王の人数（盤の大きさ）
;;;     y     --- 配置しようとする女王の縦位置、
;;;     board --- 盤(縦位置(y座標)を要素とするｘ座標のリスト(ｘ座標は降順))
;;; 返り値    --- y以上n以下のy座標に配置できる全パターンをリストにして返す
(defun nqueen2 (n y board)
   (if (> y n)
       nil
       ;; (member y board)は横報告に他の女王がいるかどうか
       ;; (diagonal 1 y board)は斜め方向に他の女王がいるかどうか
       ;; 縦方向は女王を1個ずつしか配置しないことでチェック不要
       (if (or (member y board) (diagonal 1 y board))
           (nqueen2 n (+ y 1) board) ; 他の女王がいたときは次のy座標にする
           (append ; 以下の二つのリストを連結する
                 ;; yの位置で配置できるパターン
                 (if (= (length board) (- n 1)) 
                    (list (cons y board))               ; 最後の女王が配置できたとき
                    (nqueen2 n 1 (cons y board)) )      ; 次の女王を配置する
                 ;; y+1 から nの位置で配置できるパターン
                 (nqueen2 n (+ y 1) board) ))))

;;; queen の位置に女王が置けるかどうか
;;; 駒が置けなければ T を返す
;;; board の長さ分のチェックをする
(defun diagonal (x queen board)
  (if (null board) 
      nil
      (if (= (abs (- (car board) queen)) x)             ; 斜めチェック
          t
          (diagonal (+ x 1) queen (cdr board)) ))) 

;;; 上記の diagonal のイタレータ版
;;; nクィーンをハイブリッド版にするときは、関数を idiagonal に変更
(defun idiagonal (x queen board)
  (block nil
    (for ((i x (+ i 1)))
          ((null board) nil)
       (if (= (abs (- (car board) queen)) i)
           (return-from nil t)
           (setq board (cdr board)) ))))

;;; 上記の diagonal のイタレータ版 Common Lisp 版
;;; nクィーンをハイブリッドの Common Lisp 版にするときは、関数を idiagonal-cl に変更
(defun idiagonal-cl (x queen board)
  (block nil
    (dolist (e board)
       (if (= (abs (- e queen)) x)
           (return-from nil t) )
       (inc x) )))

;;;
;;; 高階関数の例 - 全数検索
;;;
;;;   fun  - 検索用関数
;;;   key  - 検索ワード
;;;   list - データ列
;;; 
(defun find (fun key list)
   (if (null list)
       nil
       (nconc ; 引数の関数を呼び出す nconc は append の破壊版（副作用版）
          (if (funcall fun key (car list))	; funcall は関数呼び出し
              (list (car list)) )
          (find fun key (cdr list)) )))		; 再帰呼び出し

;;;
;;; 末尾再帰にした階乗計算
;;;
(defun fact-tail (n) (fact-tail2 n 1))
(defun fact-tail2 (n f) 
   (if (<= n 1) 
       f 
       (fact-tail2 (- 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)) ))