Qiita Teams that are logged in
You are not logged in to any team

Log in to Qiita Team
Community
OrganizationAdvent CalendarQiitadon (β)
Service
Qiita JobsQiita ZineQiita Blog
Help us understand the problem. What is going on with this article?

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
> 
sym_num
LALの笹川です。よろしくお願いします。
http://eisl.kan-be.com/
fukuokaex
エンジニア/企業向けにElixirプロダクト開発・SI案件開発を支援する福岡のコミュニティ
https://fukuokaex.fun/
Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away