プログラム断片（2008/06/11）

for VisualWorks 7.6 with Jun780, Lispインタプリタのマニュアル(PDF)

最大公約数と最小公倍数

(defun gcd (m n)
  (cond ((not (integerp m)) nil)
        ((not (integerp n)) nil)
        ((= n 0) m)
        ((not (> m 0)) nil)
        ((not (> n 0)) nil)
        (t (gcd n (\\ m n)))))

(defun lcm (m n)
   (* (// m (gcd m n)) n))

(clear)
(gcd 12 8)
(gcd 36 27)
(gcd 208 117)
(gcd (gcd 24 36) 54)
(lcm 12 8)
(lcm 36 27)
(lcm 208 117)
(lcm (lcm 12 18) 27)
01 
t
> (gcd 12 8)
4
> (gcd 36 27)
9
> (gcd 208 117)
13
> (gcd (gcd 24 36) 54)
6
> (lcm 12 8)
24
> (lcm 36 27)
108
> (lcm 208 117)
1872
> (lcm (lcm 12 18) 27)
108

階乗

(defun factorial (n)
  (cond ((not (integerp n)) nil)
        ((< n 0) nil)
        ((= n 0) 1)
        (t (* n (factorial (- n 1))))))

(defun factorials (n)
  (cond ((not (integerp n)) nil)
        ((< n 0))
        (t (progn
             (princ n)
             (princ "! = ")
             (print (factorial n))
             (factorials (- n 1))))))

(clear)
(factorials 36)
02 
t
> (factorials 36)
36! = 371993326789901217467999448150835200000000
35! = 10333147966386144929666651337523200000000
34! = 295232799039604140847618609643520000000
33! = 8683317618811886495518194401280000000
32! = 263130836933693530167218012160000000
31! = 8222838654177922817725562880000000
30! = 265252859812191058636308480000000
29! = 8841761993739701954543616000000
28! = 304888344611713860501504000000
27! = 10888869450418352160768000000
26! = 403291461126605635584000000
25! = 15511210043330985984000000
24! = 620448401733239439360000
23! = 25852016738884976640000
22! = 1124000727777607680000
21! = 51090942171709440000
20! = 2432902008176640000
19! = 121645100408832000
18! = 6402373705728000
17! = 355687428096000
16! = 20922789888000
15! = 1307674368000
14! = 87178291200
13! = 6227020800
12! = 479001600
11! = 39916800
10! = 3628800
9! = 362880
8! = 40320
7! = 5040
6! = 720
5! = 120
4! = 24
3! = 6
2! = 2
1! = 1
0! = 1
nil

フィボナッチ数

(defun fibonacci (n)
  (cond ((not (integerp n)) nil)
        ((< n 0) nil)
        ((= n 0) 0)
        ((= n 1) 1)
        (t (+ (fibonacci (- n 1))
              (fibonacci (- n 2))))))

(defun fibonaccis (n)
  (cond ((not (integerp n)) nil)
        ((< n 0))
        (t (progn
             (princ "fib(")
             (princ n)
             (princ ") = ")
             (print (fibonacci n))
             (fibonaccis (- n 1))))))

(clear)
(fibonaccis 20)
03 
t
> (fibonaccis 20)
fib(20) = 6765
fib(19) = 4181
fib(18) = 2584
fib(17) = 1597
fib(16) = 987
fib(15) = 610
fib(14) = 377
fib(13) = 233
fib(12) = 144
fib(11) = 89
fib(10) = 55
fib(9) = 34
fib(8) = 21
fib(7) = 13
fib(6) = 8
fib(5) = 5
fib(4) = 3
fib(3) = 2
fib(2) = 1
fib(1) = 1
fib(0) = 0
nil

上記のプログラムでは2n乗のオーダーで計算量が増加します。おそらく20よりも上のフィボナッチ数を求めるのに、ものすごい手間がかかるようになります。それを軽減するためには連想計算という手法を用いるのが効果的です。得られた計算結果を連想表にして、リフレクションとしてプログラムの中に取り込み、再計算に利用するのです。そうすれば、100ぐらいのフィボナッチ数であろうとも容易に求めることができます。

(defun fibonacci (n)
  (cond ((not (integerp n)) nil)
        ((< n 0) nil)
        ((= n 0) 0)
        ((= n 1) 1)
        (t (do (value assertion condition target clauses)
             (setq value (+ (fibonacci (- n 1))
                            (fibonacci (- n 2)))
                   assertion (list (list '= 'n n) value)
                   condition (nth 4 (getprop 'fibonacci 'expr))
                   target (last condition)
                   clauses (list (car target)))
             (rplaca target assertion)
             (rplacd target clauses)
             value))))

(defun fibonaccis (n)
  (cond ((not (integerp n)) nil)
        ((< n 0))
        (t (progn
             (princ "fib(")
             (princ n)
             (princ ") = ")
             (print (fibonacci n))
             (fibonaccis (- n 1))))))
(clear)
(fibonaccis 50)
(progn (clear) (pp (getprop 'fibonacci 'expr)) nil)

以下のPrologとSmalltalkのリフレクティブなフィボナッチ数の計算プログラムもたどってみてください。

集合算

(defun union (x y)
  (cond ((null y) x)
        ((null x) y)
        ((member (car x) y) (union (cdr x) y))
        (t (cons (car x) (union (cdr x) y)))))

(defun intersection (x y)
  (cond ((null y) nil)
        ((null x) nil)
        ((member (car x) y) (cons (car x) (intersection (cdr x) y)))
        (t (intersection (cdr x) y))))

(defun set (x)
  (cond ((null x) nil)
        (t (union (cons (car x) nil) (set (cdr x))))))

(clear)
(union '(1 2 3 4) '(0 5 2 3 1))
(intersection '(1 2 3 4) '(0 5 2 3 1))
(set '(1 2 3 4 3 2 1 0 5 2 3 1))
04 
t
> (union '(1 2 3 4) '(0 5 2 3 1))
(4 0 5 2 3 1)
> (intersection '(1 2 3 4) '(0 5 2 3 1))
(1 2 3)
> (set '(1 2 3 4 3 2 1 0 5 2 3 1))
(4 0 5 2 3 1)

数リストの分割

(defun split (n x)
  (cond ((null x) (cons nil nil))
        ((< (car x) n)
         (do (y)
           (setq y (split n (cdr x)))
           (cons (cons (car x) (car y)) (cdr y))))
        ((>= (car x) n)
         (do (z)
           (setq z (split n (cdr x)))
           (cons (car z) (cons (car x) (cdr z)))))))

(clear)
(split 4 '(1 6 4 3 5 2 7))
(split 44 '(33 55 22 77 88 11))
05 
t
> (split 4 '(1 6 4 3 5 2 7))
((1 3 2) 6 4 5 7)
> (split 44 '(33 55 22 77 88 11))
((33 22 11) 55 77 88)

数リストの整列

(defun split (n x)
  (cond ((null x) (cons nil nil))
        ((< (car x) n)
         (do (y)
           (setq y (split n (cdr x)))
           (cons (cons (car x) (car y)) (cdr y))))
        ((>= (car x) n)
         (do (z)
           (setq z (split n (cdr x)))
           (cons (car z) (cons (car x) (cdr z)))))))

(defun quicksort (x)
  (cond ((null x) nil)
        (t (do (u)
             (setq u (split (car x) (cdr x)))
             (append (quicksort (car u))
                     (cons (car x) (quicksort (cdr u))))))))

(clear)
(quicksort '(8 1 6 0 4 3 5 2 7 9))
(quicksort '(9 8 7 6 5 4 3 2 1 0))
06 
t
> (quicksort '(8 1 6 0 4 3 5 2 7 9))
(0 1 2 3 4 5 6 7 8 9)
> (quicksort '(9 8 7 6 5 4 3 2 1 0))
(0 1 2 3 4 5 6 7 8 9)

写像関数

(defun xTen (x)
  (cond ((null x) nil)
        (t (cons (* (car x) 10) (xTen (cdr x))))))

(clear)
(xTen '(1 2 3 4 5))
07 
t
> (xTen '(1 2 3 4 5))
(10 20 30 40 50)
 
(defun xTen (x)
  (mapcar '(lambda (x) (* x 10)) x))

(clear)
(xTen '(1 2 3 4 5))
08 
t
> (xTen '(1 2 3 4 5))
(10 20 30 40 50)
 
(clear)
(mapcar '(lambda (x) (* x x)) '(1 2 3 4 5))
(mapcar 'car '((father 33) (mother 32) (son 5) (daughter 3)))
(mapcar 'cdr '((father 33) (mother 32) (son 5) (daughter 3)))
(mapcar '(lambda (x) (car (cdr x))) 
        '((father 33) (mother 32) (son 5) (daughter 3)))
09 
t
> (mapcar '(lambda (x) (* x x)) '(1 2 3 4 5))
(1 4 9 16 25)
> (mapcar 'car '((father 33) (mother 32) (son 5) (daughter 3)))
(father mother son daughter)
> (mapcar 'cdr '((father 33) (mother 32) (son 5) (daughter 3)))
((33) (32) (5) (3))
> (mapcar '(lambda (x) (car (cdr x))) 
        '((father 33) (mother 32) (son 5) (daughter 3)))
(33 32 5 3)

リスト要素の回転（未完成なので完成させてください）

(defun rotate (x n) 作成してください)

(clear)
(rotate '(1 2 3 4 5 6 7 8 9) 2)
(rotate '(1 2 3 4 5 6 7 8 9) -3)
(rotate '(1 2 3 4 5 6 7 8 9) 9)
(rotate '(1 2 3 4 5 6 7 8 9) -18)
11 
t
> (rotate '(1 2 3 4 5 6 7 8 9) 2)
(3 4 5 6 7 8 9 1 2)
> (rotate '(1 2 3 4 5 6 7 8 9) -3)
(7 8 9 1 2 3 4 5 6)
> (rotate '(1 2 3 4 5 6 7 8 9) 9)
(1 2 3 4 5 6 7 8 9)
> (rotate '(1 2 3 4 5 6 7 8 9) -18)
(1 2 3 4 5 6 7 8 9)

for VisualWorks 7.6 with Jun780, Lispインタプリタのマニュアル(PDF)

Updated: 2015/11/08 (Created: 2008/06/11) KSU AokiHanko