はじめに
Prolog99の問題集をベースにしたLisp99があります。ISLispに慣れるためにと、少しずつですが、解いています。自分の書いたものを投稿することで、ISLispの使い方の雰囲気がお伝えできればいいと思い、書き記すことにしました。解いたものから五月雨式に追加していく予定です。
githubにおいてあります。気が向いたときにポツポツと解いています。
https://github.com/sasagawa888/eisl
問題
このページを参照してください。
https://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html
解答例
;;p01
(defun my-last (x)
(if (null (cdr x))
(car x)
(my-last (cdr x))))
(defun my-last (x)
(car (reverse x)))
(defun my-last (x)
(while (not (null (cdr x)))
(setq x (cdr x)))
(car x))
;;p02
(defun my-but-last (x)
(if (< (length x) 2)
(error "my-but-last: illegal argument" x)
(my-but-last1 x)))
(defun my-but-last1 (x)
(if (null (cdr (cdr x)))
x
(my-but-last1 (cdr x))))
> (my-but-last '(a b c d))
(C D)
;;p03
(defun element-at (x n)
(elt x (- n 1)))
> (element-at '(a b c d e f) 3)
C
;;p04
(defun elements (ls)
(if (null ls )
0
(+ 1 (elements (cdr ls)))))
;;p05
(defun my-reverse (ls)
(if (null ls)
nil
(append (my-reverse (cdr ls)) (list (car ls)))))
;;p06
(defun palindromep (ls)
(equal ls (reverse ls)))
;;p07
(defun my-flatten (x)
(cond ((null x) nil)
((atom x) (list x))
(t (append (my-flatten (car x)) (my-flatten (cdr x))))))
> (my-flatten '(a (b (c d) e)))
(A B C D E)
>
;;p08
(defun compress (ls)
(compress1 (car ls) (cdr ls)))
(defun compress1 (x ls)
(cond ((null ls) nil)
((eq x (car ls)) (compress1 x (cdr ls)))
(t (cons x (compress1 (car ls) (cdr ls))))))
;;p09
(defun pack (x)
(let ((y (pack1 (car x) '() x)))
(if (null (cdr y))
y
(cons (car y) (pack (cdr y))))))
(defun pack1 (x y z)
(cond ((null z) (cons y nil))
((not (eq x (car z))) (cons y z))
(t (pack1 x (cons (car z) y) (cdr z)))))
> (pack '(a a a b b b b c c))
((A A A) (B B B B) (C C))
>
;;p10
(defun encode (x)
(mapcar (lambda (y) (list (length y)(car y)))
(pack x)))
> (encode '(a a a b b b b c c))
((3 A) (4 B) (2 C))
>
;;p11
(defun encode-modified (x)
(mapcar (lambda (y) (if (= (length y) 1)
(car y)
(list (length y)(car y))))
(pack x)))
> (encode-modified '(a a a b b b b c c))
((3 A) (4 B) (2 C))
>
;;p12
(defun decode (x)
(mapcan (lambda (y) (if (atom y)
(list y)
(decode1 (elt y 0) (elt y 1))))
x))
(defun decode1 (n x)
(if (= n 0)
'()
(cons x (decode1 (- n 1) x))))
> (decode '((3 a) (4 B) (1 c)))
(A A A B B B B C)
>
;;p13
(defun encode-direct (x)
(let ((y (encode-direct1 (car x) 0 x)))
(if (null (cdr y))
(if (= (elt (car y) 0) 0)
(car (car y))
y)
(cons (car y) (encode-direct (cdr y))))))
(defun encode-direct1 (x n z)
(cond ((null z) (cons (list n x) nil))
((not (eq x (car z))) (cons (list n x) z))
(t (encode-direct1 x (+ n 1) (cdr z)))))
> (encode-direct '(a a a b b b b c c))
((3 A) (4 B) (2 C))
>
;;p16
(defun drop (x n)
(drop1 x nil n 1))
(defun drop1 (x y n m)
(cond ((null x) (reverse y))
((= n m)(drop1 (cdr x) y n 1))
(t (drop1 (cdr x) (cons (car x) y) n (+ m 1)))))
> (drop '(a b c d e f g h i j) 3)
(A B D E G H J)
>
;;p17
;;recursive
(defun split (x n)
(split1 nil x n))
(defun split1 (x y n)
(cond ((null y) nil)
((= n 0) (list (reverse x) y))
(t (split1 (cons (car y) x) (cdr y) (- n 1)))))
;;imperative
(defun split (x n)
(for ((front nil (cons (car rear) front))
(rear x (cdr rear))
(m n (- m 1)))
((= m 0) (list (reverse front) rear))))
> (split '(a b c d) 2)
((A B) (C D))
>
;;P20
(defun remove-at (ls n)
(if (= n 1)
(cdr ls)
(cons (car ls) (remove-at (cdr ls) (- n 1)))))
> (remove-at '(a b c) 2)
(A C)
>
;;p21
(defun insert-at (x ls n)
(if (= n 1)
(cons x ls)
(cons (car ls) (insert-at x (cdr ls) (- n 1)))))
> (insert-at 'alfa '(a b c d) 2)
(A ALFA B C D)
>
;;p22
;recursive
(defun range (m n)
(if (>= m n)
nil
(cons m (range (+ m 1) n))))
;imperative
(defun range (m n)
(for ((m1 m (+ m1 1))
(ls nil (cons m1 ls)))
((>= m1 n) (reverse ls))))
> (range 4 7)
(4 5 6)
>
;;p23
(defun md-select (ls n)
(let* ((len (length ls))
(m (random (- len n))))
(md-select1 ls n m)))
(defun md-select1 (ls n m)
(if (= m 0)
(take ls n)
(md-select1 (cdr ls) n (- m 1))))
(defun take (ls n)
(if (= n 0)
nil
(cons (car ls) (take (cdr ls) (- n 1)))))
;;p31
(defun is-prime (n)
(labels ((iter (m limit)
(cond ((> m limit) t)
((= (mod n m) 0) nil)
(t (iter (+ m 2) limit)))))
(cond ((< n 2) nil)
((= (mod n 2) 0) nil)
(t (iter 3 (isqrt n))))))
> (is-prime 2017)
T
> (is-prime 7)
T
>
;;p32
(defun my-gcd (x y)
(cond ((< x y) (my-gcd y x))
((= (mod x y) 0) y)
(t (my-gcd y (mod x y)))))
;;p33
(defun coprime (x y)
(= (my-gcd x y) 1))
;;p34
(defun totient-phi (n)
(length (divisors n)))
(defun divisors (n)
(divisors1 nil 1 n))
(defun divisors1 (ls m n)
(cond ((= m n) (cons m ls))
((= (mod n m) 0) (divisors1 (cons m ls) (+ m 1) n))
(t (divisors1 ls (+ m 1) n))))
;;p35
(defun prime-factors (n)
(labels ((iter (p x ls z)
(cond ((> p z) (cons x ls))
((= (mod x p) 0)
(let ((n1 (div x p)))
(iter 2 n1 (cons p ls) (isqrt n1))))
((= p 2) (iter 3 x ls z))
(t (iter (+ p 2) x ls z)))))
(cond ((< n 0) nil)
((< n 2) (list n))
(t (iter 2 n '() (isqrt n))))))
> (prime-factors 123)
(41 3)
;;p36
(defun prime-factors-mult (n)
(prime-factors-mult1 (prime-factors n)))
(defun prime-factors-mult1 (x)
(let ((y (prime-factors-mult2 (car x) 0 x)))
(if (null (cdr y))
y
(cons (car y) (prime-factors-mult1 (cdr y))))))
(defun prime-factors-mult2 (x n z)
(cond ((null z) (cons (list x n) nil))
((not (= x (car z))) (cons (list x n) z))
(t (prime-factors-mult2 x (+ n 1) (cdr z)))))
> (prime-factors-mult 315)
((7 1) (5 1) (3 2))
>
;;p37
(defun phi (n)
(if (= n 1)
1
(convert (* n (product (lambda (ls) (- 1 (quotient 1 (car ls))))
(prime-factors-mult n))) <integer>)))
(defun product (f ls)
(if (null ls)
1
(* (funcall f (car ls)) (product f (cdr ls)))))
::p38
> (time (totient-phi 10090))
Elapsed Time=0.016000
<undef>
> (time (phi 10090))
Elapsed Time=0.000000
<undef>
>
;;p40
(defun goldbach (n)
(let ((i 3))
(block exit
(while (< i n)
(if (and (is-prime i)(is-prime (- n i)))
(return-from exit (list i (- n i)))
(setq i (+ i 2)))))))
;;p54A
(defun istree (x)
(if (and (= (length x) 3)
(atom (elt x 0))
(atom (elt x 1))
(atom (elt x 2)))
t
(and (= (length x) 3)
(atom (elt x 0))
(or (atom (elt x 1))(istree (elt x 1)))
(or (atom (elt x 2))(istree (elt x 2))))))
> (istree '(a (b nil nil) nil))
T
> (istree '(a (b nil nil)))
NIL
>