ISLispによるLISP99

はじめに

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
>