2012/05/30

モチベーション 3.0

ダニエル・ピンクの「モチベーション 3.0」を読んだ。よかった。「自律」について私が感じていることを、見事に説明してくれた。

しかし、一つだけわからないことが。何でこの本借りたんだろう? 私があまり読まなさそうなタイプの本なのに。

2012/05/26

usocket の使い方をすっかり忘れてしまっていた

サーバ側

(defparameter *port* 1958)

(defgeneric server-start (server))
(defgeneric server-stop (server))


(defclass* server ()
((host usocket:*wildcard-host*)
(port *port*)
(listen-thread nil)))

(defmethod server-start ((server server))
(setf (listen-thread-of server)
(sb-thread:make-thread
(lambda ()
(usocket:with-socket-listener (socket (host-of server) (port-of server) :reuse-address t)
(loop (usocket:with-connected-socket (connected-socket
(usocket:socket-accept socket))
(let ((stream (usocket:socket-stream connected-socket)))
(print (eval (read stream)) stream)
(force-output stream))))))
:name "nunumo:server")))

(defmethod server-stop ((server server))
(sb-thread:terminate-thread (listen-thread-of server))
(setf (listen-thread-of server) nil))

クライアント側

(defgeneric client-open (client))
(defgeneric client-close (client))
(defgeneric client-read (client))
(defgeneric client-write (client object))
(defgeneric client-flush (client))

(defclass* client ()
((host "localhost")
(port *port*)
(socket nil)
(stream nil)))

(defmethod client-open ((client client))
(setf (socket-of client)
(usocket:socket-connect (host-of client) (port-of client))
(stream-of client)
(usocket:socket-stream (socket-of client)))
client)

(defmethod client-close ((client client))
(force-output (stream-of client))
(usocket:socket-close (socket-of client))
client)

(defmethod client-read ((client client))
(read (stream-of client)))

(defmethod client-write ((client client) object)
(print object (stream-of client)))

(defmethod client-flush ((client client))
(force-output (stream-of client))
client)

はい。RPC システム完成!

(let ((server (make-instance 'server))
(client (make-instance 'client)))
(server-start server)
(unwind-protect
(progn
(client-open client)
(client-write client '(format nil "(+ 1 2) => ~a" (+ 1 2)))
(client-flush client)
(client-read client))
(server-stop server)))
;;=> "(+ 1 2) => 3"

sb-concurrency:queue

sb-concurrency:queue を使ってみる。

(defstruct (thread-pool (:constructor %make-thread-pool))
(queue)
(name)
(stop)
(sleep-time)
(threads))

(defun make-thread-pool (number-of-thread &key
name
(sleep-time 0.1))
(let ((stop (cons nil nil))
(queue (sb-concurrency:make-queue)))
(%make-thread-pool
:name name
:queue queue
:stop stop
:sleep-time sleep-time
:threads (collect 'bag
(sb-thread:make-thread
(lambda ()
(loop until (car stop)
do (multiple-value-bind (job ok)
(sb-concurrency:dequeue queue)
(if ok
(funcall job)
(sleep sleep-time)))))
:name (format nil "~a worker thread ~d" name
(scan-range :from 1 :upto number-of-thread)))))))

(defun stop-thread-pool (thread-pool)
(setf (car (thread-pool-stop thread-pool)) t))

(defun join-thread-pool (thread-pool)
(stop-thread-pool thread-pool)
(collect-ignore (sb-thread:join-thread (scan (thread-pool-threads thread-pool)))))

(defun add-job (thread-pool job)
(sb-concurrency:enqueue job (thread-pool-queue thread-pool)))

(defun wait-thread-pool (thread-pool)
(loop until (sb-concurrency:queue-empty-p (thread-pool-queue thread-pool))
do (sleep (thread-pool-sleep-time thread-pool))))

(defmacro with-thread-pool ((var number-of-thread
&key
(name "nunumo::thread-pool")
(sleep-time 0.1) )
&body body)
`(let ((,var (make-thread-pool ,number-of-thread
:name ,name
:sleep-time ,sleep-time)))
(unwind-protect
(progn ,@body)
(stop-thread-pool ,var))))

#|
(labels ((fib (n)
(if (<= n 2)
1
(+ (fib (1- n))
(fib (- n 2))))))
(let ((q (sb-concurrency:make-queue)))
(with-thread-pool (pool 4)
(dotimes (i 10)
(add-job pool (let ((n (+ 31 i)))
(lambda ()
(sb-concurrency:enqueue (cons n (fib n)) q)))))
(wait-thread-pool pool)
(join-thread-pool pool))
(sb-concurrency:list-queue-contents q)))
;;=> ((31 . 1346269) (32 . 2178309) (33 . 3524578) (34 . 5702887) (35 . 9227465) (36 . 14930352) (37 . 24157817) (38 . 39088169) (39 . 63245986) (40 . 102334155))
|#

2012/05/19

Paiprolog の出番だ

某問題を解こうと思って Paiprolog の出番だ、と思ったがうまく行かなかった。

(ql:quickload  :paiprolog)

(defpackage :dropquest2012
(:use :cl :paiprolog))

(in-package dropquest2012)

(<-- (member ?item (?item . ?rest)))
(<- (member ?item (?x . ?rest)) (member ?item ?rest))
(<-- (d ?x) (member ?x (0 1 2 3 4 5 6 7 8 9)))

(prolog-collect (?n1 ?n2 ?n3 ?n4 ?n5)
(d ?n1)
(d ?n2)
(d ?n3)
(d ?n4)
(d ?n5)
(is 24 (* ?n1 ?n2))
(is ?n4 (/ ?n2 2))
(is 26 (+ ?n1 ?n2 ?n3 ?n4 ?n5))
(is ?n5 (+ ?n2 ?n3))
(is (+ ?n4 ?n5) (+ ?n1 ?n3)))
;;=> NIL

でも、こうすると動く。

(prolog-collect (?n1 ?n2 ?n3 ?n4 ?n5)
(d ?n1)
(d ?n2)
(d ?n3)
(d ?n4)
(d ?n5)
(is 24 (* ?n1 ?n2))
(is ?n4 (/ ?n2 2))
(is 26 (+ ?n1 ?n2 ?n3 ?n4 ?n5))
(is ?n5 (+ ?n2 ?n3))
;; (is (+ ?n4 ?n5) (+ ?n1 ?n3))
(is ?x (+ ?n4 ?n5))
(is ?x (+ ?n1 ?n3)))
;;=> ((6 4 5 2 9))

なんだろうね。

Series でも解きたくて scan-combination を実装した。

(ql:quickload  :info.read-eval-print.series-ext)

(info.read-eval-print.series-ext:sdefpackage :dropquest2012
(:use :cl))

(in-package dropquest2012)

(collect-first
(choose-if
(lambda (xs)
(destructuring-bind (n1 n2 n3 n4 n5) xs
(and (= (* n1 n2) 24)
(= n4 (/ n2 2))
(= (+ n4 n5) (+ n1 n3))
(= 26 (+ n1 n2 n3 n4 n5))
(= n5 (+ n2 n3)))))
(scan-combination 5 (collect (scan-range :upto 9)))))
;;=> ((6 4 5 2 9))

2012/05/08

MySQL でフェッチしながら他の SQL を実行

MySQL でフェッチしながら他の SQL を実行しようとするとよく "Commands out of sync; you can't run thiscommand now" というエラーになる。

大きな検索結果のときどうすりゃいいんだろう? というのがかねてからの疑問だった。

MySQL のクライレアント API を理解するために SWIG を使って Common Lisp から API をたたいてみた。

;; swig でコードを生成する。
(quicklisp:quickload :trivial-shell)
(with-open-file (out "/tmp/input.i" :direction :output :if-exists :supersede)
(write-string "%module input
%include \"/usr/include/mysql/mysql.h\""
out))
(trivial-shell:shell-command "swig -cffi /tmp/input.i")

;; libmysqlclient をロードする
(quicklisp:quickload :cffi)
(cffi:define-foreign-library libmysqlclient
((:not :windows) (:default "libmysqlclient"))
(:windows (:default "libmysql")))
(cffi:use-foreign-library libmysqlclient)

;; swig で生成したコードをロード
(load "/tmp/input.lisp")

;; MySQL に接続
(mysql_server_init -1 (cffi-sys:null-pointer) (cffi-sys:null-pointer))
(setf mysql (mysql_init (cffi-sys:null-pointer)))
(setf connection (mysql_real_connect mysql "localhost" "root" "" "outing_development" 0 "/var/run/mysqld/mysqld.sock" 0))
(mysql_set_character_set mysql "utf8")

;; クエリー行実 mysql_store_result
(mysql_query connection "select * from regions")
(setf result (mysql_store_result connection))
(loop for row = (mysql_fetch_row result)
until (cffi-sys:null-pointer-p row)
do (loop for i below (mysql_num_fields result)
do (format t "~a " (cffi:mem-aref row :string i))
finally (terpri)))
(mysql_free_result result)

;; クエリー行実 mysql_use_result
(mysql_query connection "select * from regions")
(setf result (mysql_use_result mysql))
(loop for row = (mysql_fetch_row result) ; このループを最後まで回らないと "Commands out of sync; you can't run this command now"
until (cffi-sys:null-pointer-p row)
do (loop for i below (mysql_num_fields result)
do (format t "~a " (cffi:mem-aref row :string i))
finally (terpri)))
(mysql_free_result result)

;; おしまい
(mysql_close connection)
(mysql_server_end)

mysql_fetch_row を使った場合は最後(null が返っくる)まで mysql_fetch_row をしないと "Commands out of sync; you can't run this command now" というエラーになる。ここに書いてある。

Common Lisp でコード書かなくてもマニュアルを読めばよかったんだけど、隠れた動機というやつかな。

で、結局のところフェッチしながら他の SQL を実行するにはどうすればいいか? よくわからん。

Rails の find_each なんかは何回かに分けて mysql_store_result している感じなんだろうか?

そんなことより、SWIG 使えば C のコードを一行も書かずに Common Lisp だけで C の API をたたけて実にすばらしい。

2012/05/04

ここしばらく

GW 対策でバタバタしていた。 GW に入る前はプログラマで GW に入ってからはインフラ屋さんな感じ。そろそろちょっとのんびりしたい。

今年の誕生日はジューサーを買った。3千円と安かったけど、ちゃんと動く。しぼりたてのジュースは美味しい。

娘は GW 前の一週間風邪でダウン。インフルエンザではないとの診断だったが高熱が3,4日続く質の悪い風邪だった。そしてまた今日も体調悪くてダウン。あわれ。四月末に一回遠出できたのはよかった。楽しそうだったし。回復したら今日行く予定だった映画に連れて行こう。

「さくらのVPS」ご利用中のお客様の新プラン乗り換え優遇施策

こどもの体調がわるく予定キャンセルで時間ができたので、新プランに乗り換えてた。 実施期間延長されててよかった。

すんなり Debian sid が入った。これでメモリ 1G で HD 100G だ。