ちょっとまえに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))
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 )))
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)))))逆順リストと要素数も返す贅沢使用です。
リストにした後だと、逆順や要素数算定はコストがかかりそうなので。
http://yamasushi.hatenablog.com/entry/20100526/1274844854
- alistのkeyと同じ変数名を自動宣言
(defun lookup-alist (key alist) (let ((lookup (assoc key alist))) (if lookup (cdr lookup) (error "unknown key ~a~%" key)) )) (defmacro let-alist ( (&rest keys) alist-arg &body body ) (with-gensym (alist) (let ((bind-list (mapcar #'(lambda (key) `(,key (lookup-alist ,(intern (symbol-name key) 'keyword) ,alist)) ) keys ) )) `(let* ((,alist ,alist-arg) ,@bind-list) ;; end of bind ,@body ))))
- 使用例 こんな感じのalistを参照する
((:ds-sym . :sg-puppy) (:initial-pts-maker . "MAKE-RANDOM-PT-INSIDE-UNIT-CIRCLE" ) (:canvas-size . (:width 1200 :height 1200) ) (:paint-op . "PAINT-CIRCLE") ;; (:gray-ratio . 1) (:alpha-ratio . 1) (:radius-ratio . 10) (:gray-scheme . "KUDARI-PARABOLA") (:alpha-scheme . "KUDARI-PARABOLA") (:radius-scheme . "KUDARI-PARABOLA") ;; (:num-traj . 200 ) (:num-pt . 500 ) (:num-pt-for-test . 500 ) )(defun make-dynsys-for-painter ( param ) (let-alist (initial-pts-maker num-traj ds-sym num-pt num-pt-for-test ) param (let* ((ds-param (lookup-alist ds-sym dynsys:*dynsys-param-alist*)) (initial-pts (series:collect (funcall (intern initial-pts-maker :dynsys) num-traj)) ) (ds-serieses (make-dynsys-series-multi (getf ds-param :dynform) :trans (getf ds-param :trans) :init initial-pts ) ) ) (values (series:subseries ds-serieses 1 (1+ num-pt) ) (series:subseries ds-serieses 1 (1+ num-pt-for-test) )) )))
http://yamasushi.hatenablog.com/entry/20100523/1274612609
- haskellと言えばfold
(defun foldl (op ini lst) (reduce op lst :initial-value ini)) (defun foldr (op ini lst) (reduce op lst :initial-value ini :from-end t))- drop & take
(defun drop(n s) (subseq s n)) (defun take (n s) (subseq s 0 n ))- filter
(defun filter (pred lst) (remove-if-not pred lst))- split-atは改善の余地がある。
(defun split-at (n lst) (cond ((null lst) (pair '() '())) (t (let ((result-car '())) (do* ((last-xs lst xs) (x (car lst) (car last-xs)) (xs (cdr lst) (cdr last-xs)) (i 1 (1+ i))) ((or (> i n) (null x)) (pair (nreverse result-car) last-xs)) (push x result-car) ;(format t "~a , ~a , ~a , ~a~%" i x xs result-car) )))))(defun split-at-string (n str) (cond ((<= n 0) (pair "" str)) ((<= (length str) 0) (pair "" "")) (t (pair (subseq str 0 n) (subseq str n)))))(defun split-at-vector (n vec) (cond ((<= n 0) (pair #() vec)) ((<= (length vec) 0) (pair #() #())) (t (pair (subseq vec 0 n) (subseq vec n)))))
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
- get a new Random
- get the next random integer
- cast it to a long
- pass the long to the Date constructor
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))))