#:g1

cl-dropboxの紹介

Posted 2014-03-30 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の90日目です。

cl-dropboxとはなにか

 cl-dropboxは、Common LispからDropboxを利用するためのライブラリです。

パッケージ情報

パッケージ名cl-dropbox
Quicklisp
Quickdocshttp://quickdocs.org/cl-dropbox

インストール方法

(ql:quickload :cl-dropbox)

試してみる

 どんな関数があるかは、Quickdocsで確認できます。

 利用するにあたって、まずはDropboxのAPIを利用できるように開発者登録をする必要があります(README.txt参照のこと)

 登録が済んだら、これもREADME.txtの通りに


(push '("application" . "x-www-form-urlencoded") drakma:*text-content-types*)

;;; (cl-dropbox:set-credentials :key "..." :secret "...")

(cl-dropbox:get-request-token)

(cl-dropbox:authorize-app) ;>> Visit the below url to authorize your app then return and press enter. ; https://www.dropbox.com/1/oauth/authorize?oauth_token=............ ; ブラウザでアクセスして認証し、REPLでEnterを入力 (cl-dropbox:get-account-info) ;=> ((:REFERRAL--LINK . "...") (:DISPLAY--NAME . "...") (:UID . ...) (:COUNTRY . "..") ; ...

 位の感じで認証ができます。

 それでは、ファイルの取得でもしてみましょう。
cl-oauthの変更の所為なのか、cl-dropboxが追従していない所為なのか、はたまた私が分かっていないのか不明ですが、DRAKMAに渡す引数に:authは無いと怒られるので、get-fileのoauth:access-protected-resourceから:request-method :authを消します。

(defun dbox-filename (path)
  (*:when-let (file (last (*:split "/" path)))
    (first file)))

(defun to-octet (obj) (etypecase obj (STRING (*:string-to-octets obj)) (VECTOR (coerce obj '(VECTOR (UNSIGNED-BYTE 8))))))

(defun dbox-fetch (file &key (dir (user-homedir-pathname))) (*:when-let (seq (ignore-errors (cl-dropbox:get-file :path file))) (*:with-output-to-file (out (merge-pathnames (dbox-filename file) dir) :element-type '(unsigned-byte 8) :if-exists :supersede) (and (write-sequence (to-octet seq) out) T))))

(dbox-fetch "/rare-files/foo.tar.gz") ;=> T

なんとなく取得できました。では、アップロード機能を試してみようかと思いましたが、どうもアップロードのAPIの方は、まだ使えるようになってないようです。

まとめ

 今回は、cl-dropboxを紹介してみました。
主要なAPIも揃っていないみたいなので、もしかしたら作りかけかもしれません。

cl-lastfmの紹介

Posted 2014-03-29 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の89日目です。

cl-lastfmとはなにか

 cl-lastfmは、Nicolas Lamirault氏作のlast.fmのAPIをCommon Lispから利用する為のライブラリです。

パッケージ情報

パッケージ名cl-lastfm
Quicklisp
プロジェクトページnlamirault/cl-lastfm · GitHub
CLiKihttp://cliki.net/cl-lastfm
Quickdocshttp://quickdocs.org/cl-lastfm

インストール方法

(ql:quickload :cl-lastfm)

試してみる

 どんな関数があるかは、Quickdocsで確認できます。

 Nicolas Lamirault氏は以前、cl-audioscrobblerを開発していましたが、現在は、更新されておらず、その間にlast.fmのAPIのバージョンも変ってしまったため、cl-audioscrobblerは現在のlast.fmでは上手く使えなくなってしまいました。

 cl-lastfmのソースを眺める限り、どうもcl-audioscrobblerから現在のlast.fmでも使える部品を切り出してcl-lastfmとしているようです。
cl-audioscrobblerでは再生している音楽の情報も投稿できましたが、cl-lastfmではまだ対応していない様子。
ということで、現状では主に再生した情報を読み出す機能のみです。

(defun last.fm-api-key ()
  (let ((file (merge-pathnames (user-homedir-pathname)
                               (make-pathname :name ".LAST.FM" :case :common))))
    (with-open-file (in file) 
      (read in))))

(let* ((api-key (getf (last.fm-api-key) :api-key)) (dat (cl-lastfm:user-get-top-artists api-key "ma550"))) (flet ((? (key x) (stp:string-value (elt ($:find x key) 0)))) (series:iterate ((a (series:scan ($:find (cxml:parse dat (stp:make-builder)) "artist"))) (cnt (series:scan-range :from 1 :upto 10))) (format t "~2D: ~A: ~A~%" cnt (? "name" a) (? "playcount" a))))) ;>> 1: Miles Davis: 2428 ;>> 2: BONNIE PINK: 1310 ;>> 3: The Smashing Pumpkins: 1194 ;>> 4: David Liebman: 1119 ;>> 5: John Coltrane: 1098 ;>> 6: Elvin Jones: 999 ;>> 7: Branford Marsalis: 774 ;>> 8: Red Hot Chili Peppers: 691 ;>> 9: Brad Mehldau: 689 ;>> 10: Bill Evans: 653 ;>> ;=> NIL

まとめ

 今回は、cl-lastfmを紹介してみました。
何故名前を変更して再出発したのかは謎ですが、機能の充実をのんびり待ちたいところです。

fare-csvの紹介

Posted 2014-03-27 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の87日目です。

fare-csvとはなにか

 fare-csvは、Fare Rideau(fare)氏作のリストとCSVファイルを相互変換するライブラリです。

パッケージ情報

パッケージ名fare-csv
Quicklisp
CLiKihttp://cliki.net/fare-csv
Quickdocshttp://quickdocs.org/fare-csv

インストール方法

(ql:quickload :fare-csv)

試してみる

 どんな関数があるかは、Quickdocsで確認できます。

 CSVファイルを読むにはread-csv系関数、書き出すにはwrite-csv系の関数を利用、と基本的にシンプルに利用できます。

(with-output-to-string (out)
  (fare-csv:write-csv-lines (*:group (*:iota 100) 10)
                            out))
;=>  "0,1,2,3,4,5,6,7,8,9^M ※CRLF
;    10,11,12,13,14,15,16,17,18,19^M
;    20,21,22,23,24,25,26,27,28,29^M
;    30,31,32,33,34,35,36,37,38,39^M
;    40,41,42,43,44,45,46,47,48,49^M
;    50,51,52,53,54,55,56,57,58,59^M
;    60,61,62,63,64,65,66,67,68,69^M
;    70,71,72,73,74,75,76,77,78,79^M
;    80,81,82,83,84,85,86,87,88,89^M
;    90,91,92,93,94,95,96,97,98,99^M
;    "

(with-input-from-string (in "0,1,2,3,4,5,6,7,8,9^M
10,11,12,13,14,15,16,17,18,19^M
20,21,22,23,24,25,26,27,28,29^M
30,31,32,33,34,35,36,37,38,39^M
40,41,42,43,44,45,46,47,48,49^M
50,51,52,53,54,55,56,57,58,59^M
60,61,62,63,64,65,66,67,68,69^M
70,71,72,73,74,75,76,77,78,79^M
80,81,82,83,84,85,86,87,88,89^M
90,91,92,93,94,95,96,97,98,99^M
")
  (loop :for line := (fare-csv:read-csv-line in) :while line
        :collect line))
;=>  (("0" "1" "2" "3" "4" "5" "6" "7" "8" "9") ("10" "11" "12" "13" "14" "15" "16" "17" "18" "19") ("20" "21" "22" "23" "24" "25" "26" "27" "28" "29")
;     ("30" "31" "32" "33" "34" "35" "36" "37" "38" "39") ("40" "41" "42" "43" "44" "45" "46" "47" "48" "49") ("50" "51" "52" "53" "54" "55" "56" "57" "58" "59")
;     ("60" "61" "62" "63" "64" "65" "66" "67" "68" "69") ("70" "71" "72" "73" "74" "75" "76" "77" "78" "79") ("80" "81" "82" "83" "84" "85" "86" "87" "88" "89")
;     ("90" "91" "92" "93" "94" "95" "96" "97" "98" "99"))

 良く利用しそうなところは、

  • READ-CSV-FILE
  • READ-CSV-LINE
  • READ-CSV-STREAM
  • WRITE-CSV-LINE
  • WRITE-CSV-LINES

位でしょうか。
その他、エスケープ文字や改行文字の設定等、CSVの形式の設定も可能になっています。

まとめ

 今回は、fare-csvを紹介してみました。
自分がこれまで利用してきた感想としては、大抵の用途ではこのライブラリで間に合うかなと思っています。

Gabriel Benchmarksの紹介

Posted 2014-03-26 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の86日目です。

Gabriel Benchmarksとはなにか

 Gabriel Benchmarksは、Richard P. Gabriel氏が中心となって作成したベンチマーク集です。
ベンチでお馴染のtak関数ですが、このベンチマーク集に含まれていたこともLisp界隈で広く知られるようになったきっかけではないでしょうか(多分)。
当時Lisp処理系のベンチについては賛否両論があったようで、その辺りの経緯も本として出版されていますので、興味のある方は読んでみては如何でしょう。

パッケージ情報

パッケージ名Gabriel Benchmarks
Common Lisp版(CLtL1)Package: lang/lisp/code/bench/gabriel/
Scheme版(R4RS位)Scheme-Repos:code/misc/gabriel-scm.tar.gz

インストール方法

 上記サイトからダウンロードして実行しますが、古いので修正が必要です。
Scheme版に関してはLarcenyのサイトの R6RSベンチのページで修正されたものが配布されているようです。

Common Lispに関してはcl-bench等に含まれていたりします。

試してみる

 GCLは基本的にCLtL1の処理系で、KCL/AKCLの頃からそれ程変っていないようなので配布物のmakefileで処理系の名前を修正する位で動きます。

--------------   SESSION   ------------------

For skcl Common Lisp Tue Apr 19 23:40:44 CDT 1988

BOYER 6.600 BROWSE 12.817 CTAK 3.417 DDERIV 3.283 DERIV 2.633 DESTRU-MOD 0.975 DESTRU 1.362 DIV2 3.150 FFT-MOD 5.283 FFT 32.133 FPRINT 0.625 FREAD 1.242 FRPOLY 46.500 PUZZLE-MOD 4.283 PUZZLE 4.833 STAK 1.771 TAK-MOD 2.883 TAK 3.783 TAKL 1.317 TAKR 0.504 TPRINT 1.025 TRAVERSE 25.533 TRIANG-MOD 62.450 TRIANG 77.800 -------------- SESSION ------------------

For gcl Common Lisp Mon Mar 24 00:31:11 JST 2014

BOYER 0.000 BROWSE 0.020 CTAK 0.010 DDERIV 0.000 DERIV 0.000 DESTRU-MOD 0.002 DESTRU 0.002 DIV2 0.000 FFT-MOD 0.000 FFT 0.000 FPRINT 0.000 FREAD 0.000 FRPOLY 0.030 PUZZLE-MOD 0.000 PUZZLE 0.000 STAK 0.002 TAK-MOD 0.000 TAK 0.000 TAKL 0.000 TAKR 0.002 TPRINT 0.002 TRAVERSE 0.030 TRIANG-MOD 0.070 TRIANG 0.070

 添付されてくるファイルのtimesに結果が記録されています。
前回のマシンはSun 3/280(25 MHz)っぽいですが、Core2 Duo P8600 2.4GHz(5年位前のスペック)と比較しても1000倍位違うところに隔世の感があります。

まとめ

 今回は、Gabriel Benchmarksを紹介してみました。
スタンフォード大学のSAIL DARTには、Gabriel氏らが収集していた当時のデータや、上述のPerformance and Evaluation of Lisp Systemsで引用されているメール等が埋もれていたりするので、そのうち整理して眺めてみたいと思ったりしています。

なんとなくパタンマッチライブラリ比較

Posted 2014-03-25 16:00:00 GMT

 Common Lispには昔からパタンマッチのマクロはそれなりにある。
ふと、それぞれどんなものなのか比較してみたいと思ったので、harropifyの速度比較をしてみた。
もちろん限定的な比較なので、harropifyの速度がライブラリの良さに直結する訳ではない。念の為。
比較の為、パタンマッチは使わず手書きでリスト操作したものと、CL:TYPECASEで書いたものも一緒に計測した。

(cl:in-package :cl-user)

(defpackage :match-bench.non-pm (:use :cl) (:export :harropify))

(defpackage :match-bench.typecase (:use :cl) (:export :harropify))

(defpackage :match-bench.toadstool (:use :cl :toadstool) (:export :harropify))

(defpackage :match-bench.wright (:use :cl :snow-match) (:export :harropify))

(defpackage :match-bench.optima (:use :cl :optima) (:export :harropify))

(defpackage :match-bench.arnesi (:use :cl :arnesi) (:export :harropify))

(defpackage :match-bench.cl-match (:use :cl :cl-match) (:export :harropify))

(defpackage :match-bench.matchcomp (:use :cl :matchcomp) (:export :harropify))

(defpackage :match-bench.cl-unification (:use :cl :cl-unification) (:export :harropify))

(defpackage :match-bench.fare-matcher (:use :cl :fare-matcher) (:export :harropify))

(defpackage :match-bench.select-match (:use :cl :swank-match) (:import-from :swank-match :=>) (:export :harropify))

(cl:in-package :match-bench.non-pm)

(defun h (op a b) (case op (+ (cond ((and (numberp a) (numberp b)) (+ a b)) ((eql 0 a) b) ((eql 0 b) a) ((and (consp b) (eq '+ (nth 0 b))) (h '+ (h '+ a (nth 0 b)) (nth 1 b))) (T (list op a b)))) (* (cond ((and (numberp a) (numberp b)) (* a b)) ((eql 0 a) 0) ((eql 0 b) 0) ((eql 1 a) b) ((eql 1 b) a) ((and (consp b) (eq '* (nth 0 b))) (h '* (h '* a (nth 0 b)) (nth 1 b))) (T (list op a b)))) (otherwise (list op a b))))

(defun harropify (x) (typecase x (CONS (h (nth 0 x) (harropify (nth 1 x)) (harropify (nth 2 x)))) (T x)))

(cl:in-package :match-bench.typecase)

(defun h (op a b) (let ((arg (list op a b))) (declare (dynamic-extent arg)) (typecase arg ((CONS (EQL +) (CONS NUMBER (CONS NUMBER NULL))) (+ a b)) ((CONS (EQL +) (CONS (EQL 0) CONS)) b) ((CONS (EQL +) (CONS T (CONS (EQL 0) NULL))) b) ((CONS (EQL +) (CONS T (CONS (EQL +) NULL))) (h '+ (h '+ a (nth 0 b)) (nth 1 b))) ((CONS (EQL *) (CONS NUMBER (CONS NUMBER NULL))) (* a b)) ((CONS (EQL *) (CONS (EQL 0) CONS)) 0) ((CONS (EQL *) (CONS T (CONS (EQL 0) CONS))) 0) ((CONS (EQL *) (CONS (EQL 1) CONS)) b) ((CONS (EQL *) (CONS T (CONS (EQL 1) NULL))) a) ((CONS (EQL *) (CONS T (CONS (EQL *) CONS))) (h '* (h '* a (nth 0 b)) (nth 1 b))) (T (list op a b)))))

(defun harropify (x) (typecase x (CONS (h (nth 0 x) (harropify (nth 1 x)) (harropify (nth 2 x)))) (T x)))

(cl:in-package :match-bench.toadstool)

(defun h (op a b) (toad-case op a b '+ M N -> (when (and (numberp M) (numberp N))) (+ M N) '+ 0 F -> F '+ F 0 -> F '+ A (list '+ B C) -> (h '+ (h '+ A B) C) '* M N -> (when (and (numberp M) (numberp N))) (* M N) '* 0 F -> 0 '* F 0 -> 0 '* F 1 -> F '* 1 F -> F '* A (list '* B C) -> (h '* (h '* A B) C) Op A B -> (list Op A B)))

(defun harropify (x) (toad-case x (list Op A B) -> (h Op (harropify A) (harropify B)) A -> A))

(cl:in-package :match-bench.wright)

(defun h (op a b) (match (list op a b) (('+ (:? numberp M) (:? numberp N)) (+ M N)) (('+ 0 F) F) (('+ F 0) F) (('+ A ('+ B C)) (h '+ (h '+ A B) C)) (('* (:? numberp M) (:? numberp N)) (* M N)) (('* 0 F) f 0) (('* F 0) f 0) (('* F 1) F) (('* 1 F) F) (('* A ('* B C)) (h '* (h '* A B) C)) ((Op A B) (list Op A B))))

(defun harropify (x) (match x ((Op A B) (h Op (harropify A) (harropify B))) (A A)))

(cl:in-package :match-bench.optima)

(defun h (op a b) (match (list op a b) ((list '+ M N) when (and (numberp M) (numberp N)) (+ M N)) ((list '+ 0 F) F) ((list '+ F 0) F) ((list '+ A (list '+ B C)) (h '+ (h '+ A B) C)) ((list '* M N) when (and (numberp M) (numberp N)) (* M N)) ((list '* 0 F) (declare (ignore F)) 0) ((list '* F 0) (declare (ignore F)) 0) ((list '* F 1) F) ((list '* 1 F) F) ((list '* A (list '* B C)) (h '* (h '* A B) C)) ((list Op A B) (list Op A B))))

(defun harropify (x) (match x ((list Op A B) (h Op (harropify A) (harropify B))) (A A)))

(cl:in-package :match-bench.arnesi)

(defun h (op a b) (match-case (list op a b) ((:list '+ (:and (:test numberp) M) (:and (:test numberp) N)) (+ M N)) ((:list '+ 0 F) F) ((:list '+ F 0) F) ((:list '+ A (:list '+ B C)) (h '+ (h '+ A B) C)) ((:list '* (:and (:test numberp) M) (:and (:test numberp) N)) (* M N)) ((:list '* 0 F) 0) ((:list '* F 0) 0) ((:list '* F 1) F) ((:list '* 1 F) F) ((:list '* A (:list '* B C)) (h '* (h '* A B) C)) ((:list Op A B) (list Op A B))))

(defun harropify (x) (match-case x ((:list Op A B) (h Op (harropify A) (harropify B))) (A A)))

(cl:in-package :match-bench.cl-match)

(defun h (op a b) (match (list op a b) ((:when (and (numberp M) (numberp N)) (:list '+ M N)) (+ M N)) ((:list '+ 0 F) F) ((:list '+ F 0) F) ((:list '+ A (:list '+ B C)) (h '+ (h '+ A B) C)) ((:when (and (numberp M) (numberp N)) (:list '* M N)) (* M N)) ((:list '* 0 F) 0) ((:list '* F 0) 0) ((:list '* F 1) F) ((:list '* 1 F) F) ((:list '* A (:list '* B C)) (h '* (h '* A B) C)) ((:list Op A B) (list Op A B))))

(defun harropify (x) (match x ((:list Op A B) (h Op (harropify A) (harropify B))) (A A)))

(cl:in-package :match-bench.fare-matcher)

(defun h (op a b) (match (list op a b) ((list '+ (and M (of-type integer)) (and N (of-type integer))) (+ M N)) ((list '+ 0 F) F) ((list '+ F 0) F) ((list '+ A (list '+ B C)) (h '+ (h '+ A B) C)) ((list '* (and M (of-type integer)) (and N (of-type integer))) (* M N)) ((list '* 0 F) 0) ((list '* F 0) 0) ((list '* F 1) F) ((list '* 1 F) F) ((list '* A (list '* B C)) (h '* (h '* A B) C)) ((list Op A B) (list Op A B))))

(defun harropify (x) (match x ((list Op A B) (h Op (harropify A) (harropify B))) (A A)))

(cl:in-package :match-bench.cl-unification)

(defun h (op a b) (match-case ((list op a b)) ('(+ #.(make-instance 'unify:number-template :spec '(number ?M)) #.(make-instance 'unify:number-template :spec '(number ?N))) (+ M N)) ('(+ 0 ?F) F) ('(+ ?F 0) F) ('(+ ?A (+ ?B ?C)) (h '+ (h '+ A B) C)) ((list '* #.(make-instance 'unify:number-template :spec '(number ?M)) #.(make-instance 'unify:number-template :spec '(number ?N))) (* M N)) ('(* 0 ?F) 0) ('(* ?F 0) 0) ('(* ?F 1) F) ('(* 1 ?F) F) ('(* ?A (* ?B ?C)) (h '* (h '* A B) C)) ('(?Op ?A ?B) (list Op A B))))

(defun harropify (x) (match-case (x) ('(?Op ?A ?B) (h Op (harropify A) (harropify B))) (?A A)))

(cl:in-package :match-bench.matchcomp)

(defun h (&rest op-a-b) (match-case op-a-b ((+ ?A ?B) (if (and (numberp A) (numberp B)) (+ A B) (match-case op-a-b ((+ 0 ?F) F) ((+ ?F 0) F) ((+ ?A (+ ?B ?C)) (h '+ (h '+ A B) C)) (?- op-a-b)))) ((* ?M ?N) (if (and (numberp M) (numberp N)) (* M N) (match-case op-a-b ((* 0 ?F) F 0) ((* ?F 0) F 0) ((* 1 ?F) F) ((* ?F 1) F) ((* ?A (* ?B ?C)) (h '* (h '* A B)) C) (?- op-a-b)))) (?- op-a-b)))

(defun harropify (x) (match-case x ((?Op ?A ?B) (h Op (harropify A) (harropify B))) (?A A)))

(cl:in-package :match-bench.select-match)

#|(defun h (op a b) (match (list op a b) (('+ (#'numberp M) (#'numberp N)) (+ M N)) (('+ 0 F) F) (('+ F 0) F) (('+ A ('+ B C)) (h '+ (h '+ A B) C)) (('* (#'numberp M) (#'numberp N)) (* M N)) (('* 0 F) f 0) (('* F 0) f 0) (('* F 1) F) (('* 1 F) F) (('* A ('* B C)) (h '* (h '* A B) C)) ((Op A B) (list Op A B))))|#

(defun h (op a b) (match (list op a b) ('+ (#'numberp M) (#'numberp N)) => (+ M N) ('+ 0 F) => F ('+ F 0) => F ('+ A ('+ B C)) => (h '+ (h '+ A B) C) ('* (#'numberp M) (#'numberp N)) => (* M N) ('* 0 F) => 0 ('* F 0) => 0 ('* F 1) => F ('* 1 F) => F ('* A ('* B C)) => (h '* (h '* A B) C) (Op A B) => (list Op A B)))

(defun harropify (x) (match x ((Op A B) (h Op (harropify A) (harropify B))) (A A)))

;;; *END*

harropify 100,000回

================================================================================
MATCH-BENCH.NON-PM
100,000 times
Evaluation took:
  0.024 seconds of real time
  0.024002 seconds of total run time (0.024002 user, 0.000000 system)
  100.00% CPU
  57,848,832 processor cycles
  9,591,680 bytes consed

================================================================================ MATCH-BENCH.TYPECASE 100,000 times Evaluation took: 0.056 seconds of real time 0.056004 seconds of total run time (0.056004 user, 0.000000 system) 100.00% CPU 134,556,993 processor cycles 9,591,664 bytes consed

================================================================================ MATCH-BENCH.TOADSTOOL 100,000 times Evaluation took: 0.029 seconds of real time 0.032002 seconds of total run time (0.032002 user, 0.000000 system) 110.34% CPU 71,145,513 processor cycles 9,624,400 bytes consed

================================================================================ MATCH-BENCH.WRIGHT 100,000 times Evaluation took: 0.089 seconds of real time 0.076005 seconds of total run time (0.076005 user, 0.000000 system) 85.39% CPU 210,852,306 processor cycles 33,651,632 bytes consed

================================================================================ MATCH-BENCH.OPTIMA 100,000 times Evaluation took: 0.052 seconds of real time 0.048003 seconds of total run time (0.048003 user, 0.000000 system) 92.31% CPU 122,556,141 processor cycles 33,587,168 bytes consed

================================================================================ MATCH-BENCH.ARNESI 100,000 times Evaluation took: 16.032 seconds of real time 15.960997 seconds of total run time (15.916995 user, 0.044002 system) [ Run times consist of 1.585 seconds GC time, and 14.376 seconds non-GC time. ] 99.56% CPU 38,380,723,029 processor cycles 7,241,620,560 bytes consed

================================================================================ MATCH-BENCH.CL-MATCH 100,000 times Evaluation took: 0.108 seconds of real time 0.108007 seconds of total run time (0.108007 user, 0.000000 system) [ Run times consist of 0.036 seconds GC time, and 0.073 seconds non-GC time. ] 100.00% CPU 259,417,548 processor cycles 33,619,920 bytes consed

================================================================================ MATCH-BENCH.FARE-MATCHER 100,000 times Evaluation took: 0.487 seconds of real time 0.484030 seconds of total run time (0.484030 user, 0.000000 system) [ Run times consist of 0.072 seconds GC time, and 0.413 seconds non-GC time. ] 99.38% CPU 1,166,408,235 processor cycles 326,382,928 bytes consed

================================================================================ MATCH-BENCH.CL-UNIFICATION 100,000 times Evaluation took: 12.488 seconds of real time 12.380774 seconds of total run time (12.368773 user, 0.012001 system) [ Run times consist of 0.304 seconds GC time, and 12.077 seconds non-GC time. ] 99.14% CPU 29,896,123,851 processor cycles 1,371,211,456 bytes consed

================================================================================ MATCH-BENCH.MATCHCOMP 100,000 times Evaluation took: 0.045 seconds of real time 0.044003 seconds of total run time (0.044003 user, 0.000000 system) 97.78% CPU 106,829,712 processor cycles 23,995,488 bytes consed

================================================================================ MATCH-BENCH.SELECT-MATCH 100,000 times Evaluation took: 0.043 seconds of real time 0.044003 seconds of total run time (0.044003 user, 0.000000 system) 102.33% CPU 101,878,632 processor cycles 33,587,136 bytes consed

harropify 1,000,000回

 arnesi:match-caseとcl-unification:match-caseは他と比較して100倍位遅いので計測から外してある。
cl-unificationはその名の通りユニフィケーションの為のライブラリで双方向マッチ可能なので、harropifyのようなもので比較されるのは不利なのではないかと思う。

================================================================================
MATCH-BENCH.NON-PM
1,000,000 times
Evaluation took:
  0.228 seconds of real time
  0.228015 seconds of total run time (0.228015 user, 0.000000 system)
  100.00% CPU
  547,773,129 processor cycles
  96,014,720 bytes consed

================================================================================ MATCH-BENCH.TYPECASE 1,000,000 times Evaluation took: 0.604 seconds of real time 0.600037 seconds of total run time (0.600037 user, 0.000000 system) [ Run times consist of 0.040 seconds GC time, and 0.561 seconds non-GC time. ] 99.34% CPU 1,446,669,081 processor cycles 96,005,920 bytes consed

================================================================================ MATCH-BENCH.TOADSTOOL 1,000,000 times Evaluation took: 0.309 seconds of real time 0.304019 seconds of total run time (0.304019 user, 0.000000 system) 98.38% CPU 740,617,974 processor cycles 95,981,984 bytes consed

================================================================================ MATCH-BENCH.WRIGHT 1,000,000 times Evaluation took: 0.870 seconds of real time 0.856053 seconds of total run time (0.852053 user, 0.004000 system) [ Run times consist of 0.080 seconds GC time, and 0.777 seconds non-GC time. ] 98.39% CPU 2,082,572,298 processor cycles 335,990,736 bytes consed

================================================================================ MATCH-BENCH.OPTIMA 1,000,000 times Evaluation took: 0.563 seconds of real time 0.556035 seconds of total run time (0.552034 user, 0.004001 system) [ Run times consist of 0.076 seconds GC time, and 0.481 seconds non-GC time. ] 98.76% CPU 1,348,189,524 processor cycles 336,002,592 bytes consed

================================================================================ MATCH-BENCH.CL-MATCH 1,000,000 times Evaluation took: 0.810 seconds of real time 0.792049 seconds of total run time (0.788049 user, 0.004000 system) [ Run times consist of 0.080 seconds GC time, and 0.713 seconds non-GC time. ] 97.78% CPU 1,940,743,188 processor cycles 335,989,232 bytes consed

================================================================================ MATCH-BENCH.FARE-MATCHER 1,000,000 times Evaluation took: 4.624 seconds of real time 4.560284 seconds of total run time (4.424276 user, 0.136008 system) [ Run times consist of 0.464 seconds GC time, and 4.097 seconds non-GC time. ] 98.62% CPU 11,070,526,455 processor cycles 3,263,990,384 bytes consed

================================================================================ MATCH-BENCH.MATCHCOMP 1,000,000 times Evaluation took: 0.467 seconds of real time 0.460028 seconds of total run time (0.460028 user, 0.000000 system) [ Run times consist of 0.020 seconds GC time, and 0.441 seconds non-GC time. ] 98.50% CPU 1,117,957,527 processor cycles 239,987,984 bytes consed

================================================================================ MATCH-BENCH.SELECT-MATCH 1,000,000 times Evaluation took: 0.480 seconds of real time 0.472029 seconds of total run time (0.472029 user, 0.000000 system) [ Run times consist of 0.040 seconds GC time, and 0.433 seconds non-GC time. ] 98.33% CPU 1,147,606,731 processor cycles 336,014,880 bytes consed

select-matchの紹介

Posted 2014-03-25 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の85日目です。

select-matchとはなにか

 select-matchは、Stephen Adams氏が1990年に作ったパタンマッチのマクロです。

パッケージ情報

パッケージ名select-match
参考サイトPackage: lang/lisp/code/match/miranda/

インストール方法

 上記のCMUのAIレポジトリから拾ってきても良いのですが、SWANKにSWANK-MATCHとして同梱されているので、SWANKをロードすれば使えたりします。

(ql:quickload :swank)

試してみる

 恒例のharropifyで速度はどんなものかをみてみます。

(defun h (op a b)
  (match (list op a b)
    (('+ (#'numberp M) (#'numberp N)) (+ M N))
    (('+ 0 F)  F)
    (('+ F 0)  F)
    (('+ A ('+ B C))  (h '+ (h '+ A B) C))
    (('* (#'numberp M) (#'numberp N)) (* M N))
    (('* 0 F) f 0)
    (('* F 0) f 0)
    (('* F 1)  F)
    (('* 1 F)  F)
    (('* A ('* B C))  (h '* (h '* A B) C))
    ((Op A B)  (list Op A B))))

(defun harropify (x) (match x ((Op A B) (h Op (harropify A) (harropify B))) (A A)))

(harropify '(* x (+ (+ (* 12 0) (+ 23 8)) y))) ;=> (* X (+ 31 Y))

(time (dotimes (i 1000000) (harropify '(* x (+ (+ (* 12 0) (+ 23 8)) y))))) ;=> #| ================================================================ Evaluation took: 0.480 seconds of real time 0.472029 seconds of total run time (0.472029 user, 0.000000 system) [ Run times consist of 0.040 seconds GC time, and 0.433 seconds non-GC time. ] 98.33% CPU 1,147,606,731 processor cycles 336,014,880 bytes consed |#

 同じものがoptimaだと0.563secなのでselect-matchも結構速いようです。

 ちなみに、=>を使って括弧を少なめで書くことも可能です。

(defun h (op a b)
  (match (list op a b)
    ('+ (#'numberp M) (#'numberp N)) => (+ M N)
    ('+ 0 F) => F
    ('+ F 0) => F
    ('+ A ('+ B C)) =>  (h '+ (h '+ A B) C)
    ('* (#'numberp M) (#'numberp N)) => (* M N)
    ('* 0 F) => 0
    ('* F 0) => 0
    ('* F 1) => F
    ('* 1 F) => F
    ('* A ('* B C)) => (h '* (h '* A B) C)
    (Op A B) => (list Op A B)))

まとめ

 今回は、select-matchを紹介してみました。
コンパクトでありつつツボは押えている感じでソースコードも短かいのでSWANKでのように同梱するには良さそうなライブラリです。

stump-touchy-mode-lineの紹介

Posted 2014-03-24 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の84日目です。

stump-touchy-mode-lineとはなにか

 stump-touchy-mode-lineは、stumpwmのモードラインを拡張するユーティリティです。

パッケージ情報

パッケージ名stump-touchy-mode-line
Quicklisp
プロジェクトページmabragor/stump-touchy-mode-line · GitHub
Quickdocshttp://quickdocs.org/stump-touchy-mode-line

インストール方法

(ql:quickload :stump-touchy-mode-line)

試してみる

 どんな関数があるかは、Quickdocsで確認できます。

 StumpWMのモードラインを区分けして、各々の部分をクリックしたらコマンドを起動するようにする拡張です。非常にシンプル。
例として、モードラインを7分割して、右端をクリックした場合に時刻を表示(echo-date)するのは下記のような感じです。

(in-package :stump-touchy-mode-line)

(setf *space-between-buttons* 0.25) (setf *min-button-length* 20) (progn (setq stumpwm:*mode-line-click-hook* '()) (set-touchy-mode-line nil nil nil nil nil nil stumpwm::echo-date))

まとめ

 今回は、stump-touchy-mode-lineを紹介してみました。
使い方次第で色々広がりそうですが、自分はいまいちアイデアが浮かんで来ません。

util.stringの紹介

Posted 2014-03-23 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の83日目です。

util.stringとはなにか

 util.stringは、Allegro CLの文字列ユーティリティです。
現在のところは、string+のみの様子。

パッケージ情報

パッケージ名util.string
ドキュメントString utility functions in Allegro CL

インストール方法

 Allegro CLで

(require :util-string)

します。

試してみる

内容は、string+のみですが、string+は、Clojureでいうstr、Arcでいうstringのような感じです。
ドキュメントによれば、string+では効率が良く高速な文字列生成が可能とのこと。util.stringが文字列を生成する上で最適化されている形式は、

  • 文字列
  • シンボル
  • fixnum
  • 文字

とのこと。
ちなみに、最適化されているということであって他のデータ型が使えないという訳ではありません。

(util.string:string+ "a" #\b '|c| 1 '(2 3))
;=> "abc1(2 3)"

 util.stringの高速さはどんなものかということで色々調べたり計測してみることにしました。

(defun test-string+ ()
  (declare (optimize (debug 0) (safety 0) (speed 3)))
  (util.string:string+ "foo" "bar"))

(compiler-macro-function #'util.string:string+) ;=> NIL

(disassemble 'test-string+) ;>> ;; disassembly of #<Function TEST-STRING+> ;>> ;; formals: ;>> ;; constant vector: ;>> 0: "foo" ;>> 1: "bar" ;>> 2: UTIL.STRING:STRING+ ;>> ;>> ;; code start: #x1001319408: ;>> 0: 49 8b 7e 36 movq rdi,[r14+54] ; "foo" ;>> 4: 49 8b 76 3e movq rsi,[r14+62] ; "bar" ;>> 8: 49 8b 6e 46 movq rbp,[r14+70] ; UTIL.STRING:STRING+ ;>> 12: ff 63 d0 jmp *[rbx-48] ; SYS::TRAMP-TWO ;>> 15: 90 nop ;>> ;=> <no values>

 コンパイラマクロは付いてないようで、引数に文字列定数が来たら文字列を返してしまう、というようなことはしないようです。

 次にCL:CONCATENATEと速度を比べてみます。
CL:CONCATENATEよりstring+の方が文字列に変換するオブジェクトの種類は多いですが、さてどうか。

(defun test-concatenate ()
  (declare (optimize (debug 0) (safety 0) (speed 3)))
  (concatenate 'string "foo" "bar"))
(time (dotimes (i 1000000) (test-string+)))
; cpu time (non-gc) 0.176013 sec user, 0.004000 sec system
; cpu time (gc)     0.040001 sec user, 0.000000 sec system
; cpu time (total)  0.216014 sec user, 0.004000 sec system
; real time  0.225760 sec
; space allocation:
;  0 cons cells, 48,000,000 other bytes, 0 static bytes

(time (dotimes (i 1000000) (test-concatenate))) ; cpu time (non-gc) 0.060004 sec user, 0.004000 sec system ; cpu time (gc) 0.060004 sec user, 0.000000 sec system ; cpu time (total) 0.120008 sec user, 0.004000 sec system ; real time 0.123422 sec ; space allocation: ; 0 cons cells, 48,000,000 other bytes, 0 static bytes

 CL:CONCATENATEの方が速いという結果になりました。
素のCL:CONCATENATEもそんなに速くはなかった気がしたので、速くなりそうなものを自作して、それと比較してみます。

(defun ss+ (&rest strings)
  (declare (optimize (safety 0) (speed 3))
           (dynamic-extent strings))
  (let ((len 0)
        (pos 0))
    (declare (fixnum len pos))
    (dolist (s strings)
      (declare (simple-string s))
      (incf len (length s)))
    (let ((result (make-string len)))
      (declare (simple-string result))
      (dolist (s strings)
        (declare (simple-string s))
        (loop :for c :across s
              :do (setf (schar result pos) c) (incf pos)))
      result)))

(defun test-ss+ () (declare (optimize (debug 0) (safety 0) (speed 3))) (ss+ "foo" "bar"))

(time (dotimes (i 1000000) (test-ss+))) ; cpu time (non-gc) 0.016001 sec user, 0.000000 sec system ; cpu time (gc) 0.128008 sec user, 0.000000 sec system ; cpu time (total) 0.144009 sec user, 0.000000 sec system ; real time 0.149153 sec ; space allocation: ; 0 cons cells, 48,000,000 other bytes, 0 static bytes

 simple-stringに限定してベタベタに書くと、CL:CONCATENATEと比較して約3倍、string+と比較して約10倍位速くはできるようです。

 以上の結果からすると、どうも比較するものが間違っている気がしてきたので、様々な型のオブジェクトを文字列として連結する方向で比較してみます。

(time 
 (dotimes (i 1000000) 
   (with-output-to-string (out)
     (dolist (obj '("a" #\b |c| 1 (2 3)))
       (princ obj out)))))
; cpu time (non-gc) 11.752734 sec user, 0.000000 sec system
; cpu time (gc)     0.276017 sec user, 0.000000 sec system
; cpu time (total)  12.028751 sec user, 0.000000 sec system
; real time  12.056454 sec
; space allocation:
;  19,000,245 cons cells, 64,015,600 other bytes, 0 static bytes

(time (dotimes (i 1000000) (format nil "~{~A~}" '("a" #\b |c| 1 (2 3))))) ; cpu time (non-gc) 8.152510 sec user, 0.004000 sec system ; cpu time (gc) 0.352022 sec user, 0.004001 sec system ; cpu time (total) 8.504532 sec user, 0.008001 sec system ; real time 8.533479 sec ; space allocation: ; 14,000,126 cons cells, 64,010,656 other bytes, 0 static bytes

 CL:WITH-OUTPUT-TO-STRINGの場合と比較して約70倍、CL:FORMATと比較して約45倍string+の方が高速なようです。
使い勝手もstring+の方が良さそうなので、比較の対象としては、CL:FORMATや、CL:WITH-OUTPUT-TO-STRINGになりそうです。

まとめ

 今回は、util.stringを紹介してみました。
util.stringのような関数は、最近のLLには備わっていたりするので、速度よりは簡便さを優先して設計されたものなのかもな、と思ったりです。

arnesi+の紹介

Posted 2014-03-22 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の82日目です。

arnesi+とはなにか

 arnesi+は、先日紹介したarnesiの派生パッケージのようです。

パッケージ情報

パッケージ名arnesi+
Quicklisp
参考サイト
Quickdocshttp://quickdocs.org/arnesi+

インストール方法

(ql:quickload :arnesi+)

試してみる

 どんな関数があるかは、Quickdocsで確認できます。

 オリジナルのarnesiと何が違うのかと調べてみたところ、どうもバグ修正版の様子。しかし、更新記録的なものも無く謎なので、Quicklispの方を眺めてみると、どうもEvrim Ulu氏がメンテナンスされなくなったarnesiを修正していたものを、(Quicklispが?)arnesi+として配布しているようです。

 恐らく同氏のCore-serveRというウェブフレームワークでarnesiを利用していたためメンテナンスされなくなった後に自前で修正することになったのではないかと思われます。

 ちなみに、Quicklispの配布物は、以前のquicklispではgithubで更新されていたのを利用していたようですが、現在は、Core-serveRのプロジェクト内のソースを利用しているようです。

 オリジナルとの違いとしては、cl-contとして分離した継続を扱うライブラリの部分が修正されたりしています。
読み込みに関しては、CL:PACKAGE-NAME等も同じだったりするので、パッチのように後で読み込むというよりは、arnesi+のみ読み込むことを想定しているようです。

まとめ

 今回は、arnesi+を紹介してみました。
ライブラリの中身というより、メンテナンスされなくなった流浪のプロジェクトの紹介という感じになりました。

  • 公式に引き継ぎがされている様子もない
  • 誰がメンテナンスしたものかすぐには分からない
  • 更新記録もメンテナンス者のレポジトリを眺めない限りは良く分からない

というところですが、こういうのもあるんだなと思ったりです。

cl-anonfunの紹介

Posted 2014-03-20 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の80日目です。

cl-anonfunとはなにか

 cl-anonfunは、Tomohiro Matsuyama氏作のlambdaを簡便に書くためのユーティリティです。

パッケージ情報

パッケージ名cl-anonfun
Quicklisp
参考サイト
CLiKihttp://cliki.net/cl-anonfun
Quickdocshttp://quickdocs.org/cl-anonfun

インストール方法

(ql:quickload :cl-anonfun)

試してみる

 どんな関数があるかは、Quickdocsで確認できます。

 全体的にはClojureのfn/#()をCommon Lispにもってきたような感じになっています。
fnとfnnがありますが、fnnは引数の数を別途確保する必要がある場合に利用するようです。

(mapcar (fn (list :- %2 %1)) 
        '(1 2 3 4)
        '(a b c d e))
;=>  ((:- A 1) (:- B 2) (:- C 3) (:- D 4))

(mapcar (fn (list :- %2 %1)) '(1 2 3 4) '(a b c d e) '(i g n o r e)) ;!> invalid number of arguments: 3

(mapcar (fnn 3 (list :- %2 %1)) '(1 2 3 4) '(a b c d e) '(i g n o r e)) ;=> ((:- A 1) (:- B 2) (:- C 3) (:- D 4))

 fn/fnnを#%()で表記することも可能です。
%の後に整数が来るとfnnに展開されます。

(*:register-readtable :anonfun
                      (let ((*readtable* (copy-readtable nil)))
                        (anonfun:enable-fn-syntax)
                        *readtable*))

(*:in-readtable :anonfun)

(mapcar #%(list :- %2 %1) '(1 2 3 4) '(a b c d e)) ;=> ((:- A 1) (:- B 2) (:- C 3) (:- D 4))

(mapcar #%3(list :- %2 %1) '(1 2 3 4) '(a b c d e) '(i g n o r e)) ;=> ((:- A 1) (:- B 2) (:- C 3) (:- D 4))

(mapcar #%(list :- %2 %1) '(1 2 3 4) '(a b c d e) '(i g n o r e))

(mapcar #%(identity %&) '(1 2 3 4) '(a b c d e) '(i g n o r e)) ;=> ((1 A I) (2 B G) (3 C N) (4 D O))

(mapcar #%`(,@%& ,%1) '(1 2 3 4) '(a b c d e) '(i g n o r e)) ;=> ((A I 1) (B G 2) (C N 3) (D O 4))

まとめ

 今回は、cl-anonfunを紹介してみました。
Clojureのfn/#()をCommon Lispでも利用したいという人には結構良いんじゃないかなと思います。

Older entries (1663 remaining)