Edited at

ISLispによるLISP99

More than 1 year has passed since last update.


はじめに

Prolog99の問題集をベースにしたLisp99があります。ISLispに慣れるためにと、少しずつですが、解いています。自分の書いたものを投稿することで、ISLispの使い方の雰囲気がお伝えできればいいと思い、書き記すことにしました。解いたものから五月雨式に追加していく予定です。


問題

このページを参照してください。

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
>