[Common Lisp] Q数を SERISE で

『ゲーデル、エッシャー、バッハ―あるいは不思議の環』に出てきた Q数 というのを SERIES で生成してみた。Q数というのは

n>2のときQ(n)=Q(n-Q(n-1))+Q(n-Q(n-2)),Q(1)=Q(2)=1

で、規則的に生成しているけど順番に増加せず増えたり減ったりしながら増加している。「非常に規則的なしかだで作り出される混沌」と表現されている。

次のコードは最初の1000個を出力する。

(require :series)
(use-package :series)
(subseries
 (scan-fn '(values integer integer list)
          (lambda () (values 1 2 '(1 1)))
          (lambda (a n list)
            (declare (ignore a))
            (let ((x (+ (nth (- n (nth (- n 1) list)) list)
                        (nth (- n (nth (- n 2) list)) list))))
              (values x
                      (1+ n)
                      (append list (list x))))))
 0 1000)

おもしろい。

[Common Lisp] Common Music

Common Music をいじってみた。Common Music とは "an object-oriented music composition environment".

他には OpenMusic というのもある。Common Lisp は Music が充実している。きっと MCL のおかげなんだろうな。

Common Music の全体像がまだ分からないけど、ひとまず MIDI で音を鳴らしてみた。音を鳴らすには timidity が必要。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :cm)
  (in-package :cm))
(events (process for i in '(c d e 0 c d e 0 g e d c d e c 0
                            g g e g a a g 0 e e d d c)
                 output (new midi :time (now) :keynum i)
                 wait 0.5) "b.midi")

とっかかりとしては Common Music Tutorials あたりがよさそう。

もうあきらめた

もう無理だよ。

もうやだ

ほんとに仕事やめたくなった。

Common Lisp から Maxima の関数を使う

(in-package :maxima)

#|
$plot2d に trace(C-c C-t) をかけておき、
plot2d(x^2, [x, -5, 5]); を実行すると
こんな引数で呼ばれるのが分かる。
  0: ($PLOT2D ((MEXPT SIMP) $X 2) ((MLIST SIMP) $X -5 5))
  0: $PLOT2D returned ""
|#

;; quit(); で Maxima からぬけて、
;; 2つの引数に ' を付けて実行すると、グラフが表示された。
($PLOT2D '((MEXPT SIMP) $X 2) '((MLIST SIMP) $X -5 5))


#|
http://cosmo.phys.hirosaki-u.ac.jp/wiki.cgi/maxima?page=Maxima+%A4%C7%A4%CE%A5%B0%A5%E9%A5%D5%C9%BD%BC%A8
を参考にして円をかく。

θ -> 0..2π
x -> cosθ
y -> sinθ
で円なのね。

(%i7) plot2d( [parametric, cos(t), sin(t), [t, 0, 2*%pi], [nticks, 50]],
              [gnuplot_preamble, "set size square"] )$
  0: ($PLOT2D
      ((MLIST SIMP) $PARAMETRIC ((%COS SIMP) $T) ((%SIN SIMP) $T)
       ((MLIST SIMP) $T 0 ((MTIMES SIMP) 2 $%PI)) ((MLIST SIMP) $NTICKS 50))
      ((MLIST SIMP) $GNUPLOT_PREAMBLE "set size square"))
|#

;; CL の repl から
($plot2d
 '((mlist simp) $parametric
   ((%cos simp) $t)
   ((%sin simp) $t)
   ((mlist simp) $t 0 ((mtimes simp) 2 $%pi))
   ((mlist simp) $nticks 50))
 '((mlist simp) $gnuplot_preamble "set size square"))



;;;; これを NLISP でやってみよう。
(require :nlisp)

(let* (($t (nlisp:.rseq 0 (* 2 pi) 50))
       ($x (nlisp:.cos $t))
       ($y (nlisp:.sin $t)))
  (nlisp:plot $x $y))

#|
できた。
↓のよりよくなった？
(let* ((x (.rseq -1 1 1000))
       (+y (.sqrt (.- 1 (.* x x))))
       (-y (.* -1 (.sqrt (.- 1 (.* x x))))))
  (plot (.concatenate +y -y)
        (.concatenate x x)))
|#

Maxima を起動するために

~/.sbclrc に次を追加した。

(defun maxima ()
  "Maxima を起動する。"
  (let ((*default-pathname-defaults*
         (translate-logical-pathname "ancient:clbuild;source;maxima;src;")))
    (load "maxima-build.lisp")
    (maxima-load)
    (cl-user::run)))

ブレゼンハム法

いわたさんよりコメントをいただいたので、やってみた。

参考サイト http://dencha.ojaru.jp/programs_07/pg_graphic_09a1.htmlありがとうございます。

(defparameter *r* 39 "半径")
(defparameter *points*
  (append
   (let* ((r *r*)
          (x 0)
          (y r)
          (d (- 2 (* 2 r))))
     (append
      `((0 ,r) (0 ,(- 0 r)) (,r 0) (,(- 0 r) 0)) ;開始点
      (loop
        if (> d (- 0 y))
          do (decf y)
          and do (incf d (- 1 (* 2 y)))
        if (<= d x)
          do (incf x)
          and do (incf d (1+ (* 2 x)))
        until (zerop y)
        collect (list x y)               ; 0〜90度
        collect (list (* x -1)  y)       ; 90〜180度
        collect (list (* x -1) (* y -1)) ; 180〜270度
        collect (list x (* y -1)))))))   ; 270〜360度

(loop with map = (make-hash-table)
      with keys = nil
      for (x y) in *points*
      do (push x (gethash y map))
      do (pushnew y keys)
      finally (loop for y in (sort keys #'<)
                    do (loop for x in (gethash y map)
                             with s = (make-string (1+ (* *r* 2))
                                           :initial-element #\space)
                             do (setf (char s (+ x *r*)) #\X)
                             finally (write-line s))))

ようやく円がかけた

単位円をかきたかった。

ようやくかけたが、ごらんのとおり。もっときれいにしたい。

(require :nlisp)
(use-package :nlisp)

(let* ((x (.rseq -1 1 1000))
       (+y (.sqrt (.- 1 (.* x x))))
       (-y (.* -1 (.sqrt (.- 1 (.* x x))))))
  (plot (.concatenate +y -y)
        (.concatenate x x)))