Common Lisp¶

docker run --rm -it -v ${PWD}$:/home/cl clfoundation/cl-devel:latest sbcl

brew install roswell
ros install sbcl-bin quicklisp slime fukamachi/cl-project

docker run -it --rm --name ms -p 10000:8888 --mount type=bind,source=$(pwd),destination=/work kkwok/jupyter-mit-scheme jupyter notebook --ip=0.0.0.0 --allow-root --NotebookApp.token=''

ros setup > err.txt 2>&1

(ql:quickload :rove)
(use-package :rove)

(testing "P.28, place to quote 1"
  (flet ((exclaim1 (expression)
           (append expression '(oh my))))
    (ok '(exclaim1 '(lions and tigers and bears))
        '(LIONS AND TIGERS AND BEARS OH MY))
    (ok '(nconc * '(goodness))
        '(LIONS AND TIGERS AND BEARS OH MY GOODNESS))
    (ok '(exclaim1 '(fixnums and bignums and floats))
        '(FIXNUMS AND BIGNUMS AND FLOATS OH MY GOODNESS))))

(testing "P.28, place to quote 2"
  (flet ((exclaim2 (expression)
           (append expression (list 'oh 'my))))
    (ok '(exclaim2 '(lions and tigers and bears))
        '(LIONS AND TIGERS AND BEARS OH MY))
    (ok '(nconc * '(goodness))
        '(LIONS AND TIGERS AND BEARS OH MY GOODNESS))
    (ok '(exclaim2 '(fixnums and bignums and floats))
        '(FIXNUMS AND BIGNUMS AND FLOATS OH MY))))

;; 以下は等価
(+ 1 2)
(apply #'+ '(1 2))
(apply (symbol-function '+) '(1 2))
(apply #'(lambda (x y) (+ x y)) '(1 2))
(apply #'+ 1 '(2))
(funcall #'+ 1 2)

(do (variable-definition*)
    (end-test-form result-form*)
  statement*)

;;; (dotimes (var limit result) S式)
(dolist (x '(0 1 2 3 4)) (print x))

;;; (dolist (var init-form result) S式)
(dotimes (x 5) (print x))

(do ((n 0 (1+ n))
     (cur 0 next)
     (next 1 (+ cur next)))
    ((= 10 n) cur))

(dotimes (i 4) (print i))
(do ((i 0 (1+ i)))
    ((>= i 4))
  (print i))

(reduce #'max '(1 2 3 4))

(format t "hello, world")
(format t "hello, ~a" '(1 2 3))
(format t "x: ~d y: ~d" 20.1 3)

(format t "~a" 3)

(loop :for i :below 5 :collect i)
(loop for i from 1 to 10 collecting i)

(loop for x downfrom 999 to 900
      append (loop for y downfrom 999 to 900
                   collect (format nil "~a" (* x y))))

(let ((i 0) (fibval 0) (fibs ())
      (xs ())
      (lastval 4000000))
  (loop while (< fibval lastval)
        do (progn
             (setq fibval (fib-memo i)
                        i (incf i))
             (when (< fibval lastval)
               (setq fibs (cons fibval fibs))))))))

(loop for x from 1 to 10 summing (expt x 2)) ;==> 385
(loop :for i :from 3 :upto 5 :do (print i))
(loop :repeat 5 :do (format t "~&five"))
(loop :for i :upto 5 :do (format t "~&~A" i))

;;; This counts the number of vowels in a string:
(loop for x across "the quick brown fox jumps over the lazy dog"
      counting (find x "aeiou"))

(print (mapcar #'1+ '(1 2 3)))

(remove-if-not #'(lambda (x) (if (oddp x) (1+ x)))
               '(1 2 3 4))

(defun sq (x) (* x x))
(mapcar #'sq '(1 2 3 4))

(cond
    ((equal (mod x 3) 0) x)
    ((equal (mod x 5) 0) x))
    (t x))

(if (3or5p 4)
    1
    2)

(when (3or5p 4)
  1)

(expt 2 3) ; 2^3

(make-array 3)
(make-array 3 :element-type 'list :initial-element nil)
(make-array 3 :initial-contents '(1.0 2.0 3.0))
(let ((a #(1.0 2.0 3.0)))
  (format nil "~A" a))

;;; ハッシュテーブル
(let ((hash (make-hash-table)))
  (setf (gethash 'color hash) 'red)
  (setf (gethash 'height hash) 185)
  (setf (gethash 'weight hash) 110)
  (setf (gethash 'name hash) "Mukku")
  (maphash #'(lambda (k v) (format t "~a => ~a~%" k v)) hash)
  (loop for key being each hash-key of hash
      using (hash-value value)
      do (format t "~A => ~A~%" key value))
  )
;;; 連想リスト
(let ((alst '()))
  (push '(:color :red) alst)
  (push '(height 185) alst)
  (push '(weight 110) alst)
  (format t "~&~a" (assoc :color alst))
  (format t "~&~a" (assoc 'height alst))
  (format t "~&~a" (assoc 'weight alst))
  (format t "~&~a" alst))

;;; https://takeokunn.xyz/blog/post/common-lisp-fibonacci
;;; フィボナッチ数列
(defun memo (fn)
  (let ((table (make-hash-table :test 'equal)))
    #'(lambda (&rest rest)
        (multiple-value-bind (val found-p) (gethash rest table)
          (if found-p
              val
              (setf (gethash rest table) (apply fn rest)))))))
(defun memoize (fn-name)
  (setf (symbol-function fn-name)
        (memo (symbol-function fn-name))))
(defmacro defun-memo (fn args &body body)
  `(memoize (defun ,fn ,args . ,body)))
(defun fib (n)
  (if (<= n 1) 1
      (+ (fib (- n 1)) (fib (- n 2)))))
(defun-memo fib-memo (n)
  (if (<= n 1) 1
      (+ (fib-memo (- n 1)) (fib-memo (- n 2)))))

(digit-char-p "test")

(parse-integer "1")
(parse-integer "11" :radix 2)
(parse-integer "11" :radix 8)
(parse-integer "11" :radix 10)
(parse-integer "11" :radix 16)
(read-from-string "1/10")
(read-from-string "1.2")
(read-from-string "#c(1 1)")

(reverse "1234")

(reduce #'max '(1 2 3 4))