yamasushi:Lisp

yamasushi:Lisp

ちょっとまえにCommon Lispをいじくっていたときの記事から、いくつかひろってみます。
いまは、まったくCommon Lispとか触っていないので、自分で書いたコードでないような感覚におそわれています。 -“common lisp” - Archive - yamasushiの日記
http://yamasushi.hatenablog.com/archive/category/common%20lisp

ちょっと平均をとる

http://yamasushi.hatenablog.com/entry/20100604/1275612315

「ああ、この2つの幾何平均をとってみる」みたいな使い方をする

(defmacro mean-of (op &rest items)
  (let ((num (length items)))
   (when (> num 0)
     (case op
       ((*)  `(expt (* ,@items) ,(/ 1 num) ) )
       ((+)  `(/    (+ ,@items) ,num))
       (t (error "unknown op for mean : ~a" op))
       )))
  )

こんな感じ

(mean-of * ratio-amean-r ratio-vec ) ;; 幾何平均
(mean-of + ratio-amean-r ratio-vec ) ;; 算術平均

関数の合併

http://yamasushi.hatenablog.com/entry/20100530/1275200022

複数の関数を合体させたいから作った。

(defmacro fn-merge (&rest funs)
  (with-gensym (arg)
    `(lambda (&rest ,arg)
       (or ,@(mapcar #'(lambda (x)
                        `(apply ,x ,arg ))
                    funs)))))

定数関数

http://yamasushi.hatenablog.com/entry/20100530/1275200023

どんな引数で呼んでも定数を返す関数。

(defun fn-const (const)
  #'(lambda (&rest rest)
     (declare (ignore rest))
     const))

pairをどう実装するか

http://yamasushi.hatenablog.com/entry/20100527/1274910177

haskellのpairはlispではどう実装するか? cons cellでいいような気もするが、それだとnilを要素にしたときpprintがおかしくなる。 とりあえず、listでお茶をにごす。

(defun pair (l r)
  (list l r))

(defun fst (p)
  (car p))

(defun snd (p)
  (cadr p))

;; pair ---- (x y)
(defmacro let-pair ( (x y) pair-arg &body body )
  (with-gensym (pair)
   `(let* ((,pair ,pair-arg )
           (,x    (car  ,pair))
           (,y    (cadr ,pair)))
      ,@body
      )))

let-pairはpairにアクセスするための便法。なかなか便利。
複雑なデータ構造よりもpairのような超シンプルなものの扱いが大切な気がする。

複素数

http://yamasushi.hatenablog.com/entry/20100527/1275612697

pairの親戚の複素数。

(defmacro let-complex ( (x y) comp-arg &body body )
  (with-gensym (comp)
   `(let* ((,comp ,comp-arg )
           (,x    (realpart ,comp))
           (,y    (imagpart ,comp)))
      ,@body
      )))

zip,unzip

http://yamasushi.hatenablog.com/entry/20100527/1274910561

pairが決ったらzipが決まる

(defun zip-with (op l r)
  (cond
    ((and (listp l) (listp r))
     (mapcar op l r))
    ((vectorp l)
     (zip-with op (vector->list l) r))
    ((vectorp r)
     (zip-with op l (vector->list r)))
    (t (error "cannot zip"))
    ))

(defun zip (l r)
  (zip-with #'pair l r))

(defun unzip (z)
  (loop for item in z
       collecting (fst item) into l
       collecting (snd item) into r
       finally (return (pair l r))))

string,vector,listを一つの関数でまかなうのは、何か間違っている気がする。
いい考えが浮んだら直す。

vector->listは

(defun vector->list (v)
  (let ((len (length v)))
        (loop for i from 0 below len
           collecting (elt v i       ) into l
           collecting (elt v (- len i 1) ) into rl
           finally (return (values l rl len)))))

逆順リストと要素数も返す贅沢使用です。
リストにした後だと、逆順や要素数算定はコストがかかりそうなので。

alistから変数自動生成

http://yamasushi.hatenablog.com/entry/20100526/1274844854

haskellの関数をつくってみる

http://yamasushi.hatenablog.com/entry/20100523/1274612609

->,->>マクロ

WikiBooksEn:Clojure Programming/Concepts

3. Programmers new to Lisp are often put off by the "inside-out" reading of forms like the date creation above. Starting from the inside, you

You don't have to write inside-out code in Clojure. The -> macro takes its first form, and passes it as the first argument to its next form. The result then becomes the first argument of the next form, and so on. It is easier to read than to describe:

 1    (-> (Random.) (.nextInt) (long) (Date.))
 2  -> #<Date Sun Dec 21 12:47:20 EST 1969>

http://yamasushi.hatenablog.com/entry/20100523/1274610393

;; (fn-compose f g h)
;; ---> (lambda (x) (-> x f g h ))
;;      = (lambda (x) (h (g (f x))))
(defmacro fn-composite (&rest fns)
  (with-gensym (x)
    `(lambda (,x) (-> ,x ,@fns))))
(defmacro -> (x form &rest more)
  (if more
      `(-> (-> ,x ,form) ,@more )
      (if (listp form)
          `(,(car form) ,x ,@(cdr form))
          `(,form ,x))))

(defmacro ->> (x form &rest more)
  (if more
      `(->> (->> ,x ,form) ,@more )
      (if (listp form)
          `(,(car form) ,@(cdr form) ,x)
          `(,form ,x))))
(defmacro lambda-pipe ( x &body pipeline )
  (with-gensym (pipe-arg)
    `(->> ,x
          ,@(mapcar #'(lambda (p)
                        (destructuring-bind ((&rest arg) &body body) p
                          ;(format t "( ~a ) ~a~%" arg body) 
                          (if (singletonp arg)
                              `( (lambda (,@arg)
                                   ,@body) )
                              `( (lambda (,pipe-arg)
                                   (destructuring-bind (,@arg) ,pipe-arg
                                                        ,@body ) )))))
                    pipeline))))

with-gensymはシンボル生成マクロ(practial common lispのアレ)
singletonpは

(defun singletonp (x)
  (cond
    ( (atom x) nil )
    ( (and (listp x) (car x) (not (cdr x))) T)
    ( t (= (length x) 1))))

Last modified : 2013/04/28 06:37:51 UTC