Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2011-04-05

適当にCSVファイルを作成する

| 19:03 | 適当にCSVファイルを作成する - わだばLisperになる を含むブックマーク はてなブックマーク - 適当にCSVファイルを作成する - わだばLisperになる

いつものごとく書き捨てスクリプト的な日常LISPの紹介ですが、今回は趣向を変えてASDFでプロジェクトを作りつつやってみることにします。

タスク: CSVファイルの生成

今回のタスクの内容ですが、Redmineにタスクを登録するのに、csvファイルで一括登録できるプラグインがありまして、それで一括でタスクを登録するためのcsvファイルを作る、というものです。

そもそもRedmineの使い方を知らないんじゃないか等の疑問はありますが、それはおいておきます。

ASDFのプロジェクトを作成する

プロジェクトの作成には、QuickLispで有名な Zach Beane氏作の、quickprojectという便利なものがあるのでこれを使います。

(quickproject:make-project "/foo/bar/redmine-schedule/"
                           :depends-on '(:g000001 :fare-csv :date-calc :lets))

のようなものを実行すると、

/foo/bar以下に、

README.txt
package.lisp
redmine-schedule.asd
redmine-schedule.lisp

のような一式が用意されます。仕組みとしてはシンプルなものですが重宝しています。

ちなみにディレクトリ名の最後のスラッシュが肝なので忘れないようにしましょう。

上記ファイルですが、asdファイルは

(asdf:defsystem #:redmine-schedule
  :serial t
  :depends-on (:g000001 :fare-csv :date-calc :lets)
  :components ((:file "package")
               (:file "redmine-schedule")))

のように生成。:depends-onというのは、依存しているパッケージの指定になります。

package.lispは、:use #:cl位しかされていないので

(defpackage #:redmine-schedule
  (:use #:cl #:lets #:g000001))

のように適当にuseしたいものを追加で配置。

上記で使っているパッケージのざっとした説明ですが、g000001は自分のユーティリティ集で私にしか役に立たないもの、LetSは80年代初期のMacLISPのコードをCLで動くように私が盆栽しているもので完全なる趣味のもの、date-calcはPerlのDate::Calcを範にした日時を扱うのに便利なユーティリティです。

;; 2011/4/4の30日後
(date-calc:add-delta-days 2011 4 4 
                          30)
;=> 2011
;   5
;   4

のようなことができます。

また、fare-csvは、csvファイルとリストを相互変換できる便利ユーティリティです。

ということで、これらを使って、

(defun foo (delta)
  (multiple-value-list
   (date-calc:add-delta-days 2011 4 4 delta)))

(defun every-monday (text)
  (letS* ((d (Erange 1 52)))
    (cons
     '("題名" "説明" "担当者" "開始日" "期限日" "予定工数")
     (Rlist
       (list
        #0=(format nil "~A ~{~A/~A/~A更新~}" text (foo (* 7 d)))
        #0#
        "鈴木"
        (format nil "~{~A~^/~}" (foo (- (* 7 d) 3)))
        (format nil "~{~A~^/~}" (foo (* 7 d)))
        "1")))))

のようなものを書き殴り。

#=と##はコピペ代わりに使えて殴り書きのようなものには便利に使えます。

動作の説明ですが、2011/4/4の次の週から1年分のエントリーを作成するというものです。

再利用を考えてプロジェクトを作成しているのにハードコードな部分がありますが気にしない方向で進みます。

上記のような内容を適当に作成したら、asdファイルをロードしてみます。

そもそも対話的に作っていたりするとロードする必要もなかったりしますが、なんとなくプロジェクトを作っているっぽいという気分の問題です。

asdファイルがASDFに捕捉されていれば、上記プロジェクトの場合、

(asdf:load-system :redmine-schedule)
;; もしくは、
(ql:quickload :redmine-schedule)

でロードできますが、うんともすんとも言わない場合は、めんどくさいので、

(load "/foo/bar/redmine-schedule/redmine-schedule.asd" )

と、asdファイルを直に読み込んでからロードすると、大抵は動きます (あくまでめんどくさい場合)

ロードができたら、上の関数を使ってタスクのエントリーのリストを作成し、それをfare-csvを使ってcsvファイルに書き出します。

(with-> "/tmp/foo.csv"
  (fare-csv:write-csv-lines (every-monday "腹筋") >))

これで

"題名","説明","担当者","開始日","期限日","予定工数"
"腹筋 2011/4/11更新","腹筋 2011/4/11更新","鈴木",2011/4/8,2011/4/11,1
"腹筋 2011/4/18更新","腹筋 2011/4/18更新","鈴木",2011/4/15,2011/4/18,1
"腹筋 2011/4/25更新","腹筋 2011/4/25更新","鈴木",2011/4/22,2011/4/25,1

というファイルができました。

とりあえず簡単にプロジェクトは作れるので、とりあえずASDFでプロジェクトを作成しておいて、また使いたいようなことがあればその時に改良、というのもありかなと思っている最近です。

2011-02-27

適当な書き捨て仕事 2011/02/27

| 00:04 | 適当な書き捨て仕事 2011/02/27 - わだばLisperになる を含むブックマーク はてなブックマーク - 適当な書き捨て仕事 2011/02/27 - わだばLisperになる

やりたいこと

今の職場ではどういうわけか日報的なものがWordPressのブログになっておりここに書くとWordPressのプラグインの機能で社内にメールが飛んでいます。

日報に書いてある研究開発時間の今年度分を纏められないかと言われたのですが、集計すると思ってなかったので、このブログにしかデータがなく、このブログからデータを引っ張ってこなければなりません。

ということで、適当な書き捨て仕事のお題がみつかったのでCommon Lispでやってみます。

使うもの

  • CLSQL
    • とりあえす、WordPressは、MySQLにデータが格納されているので、CLSQLでデータを抜き出すことにします。
      • (ql:quickload :clsql)
  • Series
    • 今年はLOOPマクロ使用禁止で頑張ってみているので、SeriesかIterateを使うことになります。ということでSeriesです。
      • (ql:quickload :series)
  • cl-ppcre
    • もはや常に必須です
  • aprogn

下準備

CLSQLは、リーダーマクロを使うとS式な感じで書けるので、リーダーマクロを使ってみます。とはいえ自分的にCLSQLのリーダーマクロを使うのは初めてだったりします。

Seriesもリーダーマクロを使うと色々良い感じになります

(progn
  (series::set-dispatch-macro-character
   #\# #\Z (cl:function series::series-reader))
  (series::set-dispatch-macro-character
   #\# #\M (cl:function series::abbreviated-map-fn-reader))
  (clsql-sys:enable-sql-reader-syntax))

DBに接続

(progn
  (clsql-sys:connect '("localhost" "log" "***" "***")
                     :database-type :mysql)
  (clsql-sys:execute-command "set character_set_client='utf8'")
  (clsql-sys:execute-command "set character_set_connection='utf8'")
  (clsql-sys:execute-command "set character_set_results='utf8'")  )

文字コードを合せたりなんやり。

(defun foo-all ()
  (aprogn
    (clsql:select [post_date] [post_content] :from [log_wp_posts]
                  :where [= 2 [post_author]])
    ;;
    (mapping (((date text) (#2Mvalues-list (scan it))))
      (let ((date (ppcre:regex-replace " ..:..:.." date ""))
            (rh (ppcre:register-groups-bind ((#'parse-integer hs))
                                            (".*研究開発時間\\D*(\\d+).*" text)
                  hs)))
        (list date rh)))
    ;;
    (collect it)))

適当にREPLで、CLSQLを使って目当てのテーブルを探して該当のものをずらっと抜き出します。

マニュアルのとおりに[post_date]のような記述をしてもさっぱり拾ってこないのですが、中の文字列がシンボルの扱いになっていて、大文字になっているのが原因のようです。

ということで、["post_data"]とか[|post_data|]と書けば回避できるのですが、横道に逸れてCLSQL側を変更します。

眺めてみたところSQL-READER-OPENの中で、READ-DELIMITED-LISTが読み込んでいるようなのでこの関数が読み込みに使うリードテーブルはシンボルを大文字に揃えないように変更。

(defun sql-reader-open (stream char)
  (declare (ignore char))
  (let ((*readtable* (copy-readtable)))
    (setf (readtable-case *readtable*) :preserve)
    (let ((sqllist (read-delimited-list #\] stream t)))
      (unless *read-suppress*
        (handler-case
            (cond ((string= (write-to-string (car sqllist)) "||")
                   (cons (sql-operator 'concat-op) (cdr sqllist)))
                  ((and (= (length sqllist) 1) (eql (car sqllist) '*))
                   (apply #'generate-sql-reference sqllist))
                  ((sql-operator (car sqllist))
                   (cons (sql-operator (car sqllist)) (cdr sqllist)))
                  (t (apply #'generate-sql-reference sqllist)))
          (sql-user-error (c)
            (error 'sql-user-error
                   :message (format nil "Error ~A occured while attempting to parse '~A' at file position ~A"
                                    (sql-user-error-message c) sqllist (file-position stream)))))))))

あまりマニュアルも読んでないし、こういう対策はやっぱりまずいのかなと色々と調べようと思いはじめましたが、仕事が終わらないので引き返し。

とりあえず、ブログの中身に目的の文字列があるのでCL-PPCREで適当に抜き出します。

どんな関数名にして良いのか分からないので名前は適当です。

ここで動作確認

(subseq (foo-all) 100 110)
;=> (("2010-04-16" 3) ("2010-04-19" 2) ("2010-04-19" 3) ("2010-04-19" 3)
;    ("2010-04-20" 3) ("2010-04-20" 2) ("2010-04-20" 3) ("2010-04-21" 4)
;    ("2010-04-21" 3) ("2010-04-21" 2))

まあ良いんではないかと。

次に月ごとに集計する必要があるようなので、上記のデータを月毎に纏めるものを書くことにしました

(defun mtotal (yyyy m)
  (let ((mon1 (format nil "~D-~2,'0D" yyyy m))
        (mon2 (format nil "~D-~2,'0D" yyyy (1+ m))))
    (aprogn
      (scan (foo-all))
      ;;
      (choose-if (f_ (and (string< mon1 (car _))
                          (string> mon2 (car _))))
                 it)
      ;;
      (#Msecond it)
      ;;
      (choose it)
      ;;
      (collect-sum it))))

string<で比較するというかなり強引な方法です。

動作確認

(mtotal 2010 04)
;=> 71

できた後で、これ明かにSQLでやるべきだろうと思いましたが、まあ、もう良いやと。

意味なく表示用の関数を作成

(defun pp-mtotal (yyyy mm)
  (format 'T
          "~&~A-~A月~%研究開発時間: ~A時間~2%"
          yyyy
          mm
          (mtotal yyyy mm)))
(pp-mtotal 2010 4)
;-> 2010-4月
;   研究開発時間: 71時間
;
;=> NIL

いや、CSVでデータを提出した方が良いんじゃないかと。まあ、とりあえず良し。

次に年度を全て表示するものを作成

(defun foo-total (start)
  (format t "~&~V@{~A~:*~}~*~%" 40 "=")
  (aprogn
    (scan-range :from 0 :upto 11)
    ;;
    (#M(lambda (x)
         (let ((m (+ 3 x)))
           (list (if (< 11 m)
                     (1+ start)
                     start)
                 (1+ (mod (+ 3 x) 12)))))
      it)
    ;;
    (#M(lambda (x) (apply #'pp-mtotal x)) it)))

ここで、

(#M(curry #'apply #'pp-mtotal) it)

のように書きたいのに、リーダーマクロの展開で、#'(curry ...)となってしまうために、こういう記述ができないことを発見。

まったく仕事と関係ないですが、Seriesの定義を確認しに行きます。

#Mの次にくるものがコンスだった場合(おそらくlambda式を期待)はfunctionで囲む、となっていました。

Seriesは、CLtL1の時代のものなのでこれはこれで正しいですが、ANSIでは、lambdaマクロにより#'を補えるのと、今回のようなこともあるのでここはfunctionは補わなくても良いだろうということで、改造。

(cl:defun mapit (type fn args)
  (if (not (symbolp fn))
      `(map-fn ',type ,fn ,@ args)      ;シンボルでない場合はfunctionを付けない
    (cl:let ((vars (do ((a args (cdr a))
                        (l nil (cons (gensym "V-") l)))
                       ((null a) (return l)))))
      `(map-fn ',type (function (lambda ,vars (,fn ,@ vars))) ,@ args))))

でも、(#M(setf foo)...)とかには、#'が付かないとまずいよなあ、などと思ったりしましたが、setf関数など使いそうにもないし、横道に逸れすぎるので切り上げます。

(defun foo-total (start)
  (format t "~&~V@{~A~:*~}~*~%" 40 "=")
  (aprogn
    (scan-range :from 0 :upto 11)
    ;;
    (#M(lambda (x)
         (let ((m (+ 3 x)))
           (list (if (< 11 m)
                     (1+ start)
                     start)
                 (1+ (mod (+ 3 x) 12)))))
      it)
    (#M(curry #'apply #'pp-mtotal) it)))

のように書けるようになり、めでたしめでたし。

また、年を跨ぐ処理が面倒だったので適当にやっつけています。SQLで処理してればこんなことないのに。

というように、自分がCommon Lispで書く場合、いかに横道に逸れないかが重要である気がしつつあります。

2011-02-22

適当な書き捨て仕事 2011/02/22

| 20:52 | 適当な書き捨て仕事 2011/02/22 - わだばLisperになる を含むブックマーク はてなブックマーク - 適当な書き捨て仕事 2011/02/22 - わだばLisperになる

ちゃちゃっとした仕事は、シェルだのPerlだのRubyだので済ませる人が多いかと思いますが、Common Lispでも道具を揃えておけばそれなりに色々できますし…

という日々の内容を思い付いたらだらだら書いたり書かなかったりして行きたいと思います。

以前にも

みたいなものを書いてみたりしてました。これからも似たような内容が多くなりそうです…。

最初に断わっておくと基本的に自分の場合は、#!スクリプトにするのではなく、SLIME上で式を実行するというスタイルがメインです。

REPLで結果を確認しつつ作成し、完成したら出力のストリームをファイルに向ける、という一行野郎を書くようなスタイルで書けたりするので割と効率が良いのではないでしょうか。

やりたいこと: CSVファイルのデータをHTMLとして仕立てなおす

(with-> "/tmp/foo.html"
  (letS* (((date pref sche)
           (Elist (fare-csv:read-csv-file "/var/tmp/foo.csv"))))
    (Rignore
     (format >
             "
  <div class=\"foo\">
    <div class=\"bar\">
      <h3>日 時</h3>
      <p>~A</p>
    </div>
    <div class=\"baz\">
      <h3>場 所</h3>
      <p>
~A
      </p>
    </div>
    <div class=\"quux\">
      <h3>内 容</h3>
      <p>
~A
      </p>
    </div>
  </div>
"
             (aprogn date
                     (ppcre:regex-replace "日" it "")
                     (ppcre:regex-replace "月" it "/")
                     (ppcre:regex-replace "^" it "2011/"))
             (ppcre:regex-replace-all
              "\\n"
              pref
              "<br />")
             (ppcre:regex-replace-all
              "\\n"
              sche
              "<br />")))))

カサカサカサっと2、3分もかからず書けると思います。HTMLは既存のものをコピペして穴を空けています。

道具

  • 正規表現
    • cl-ppcreです。Quicklispでインストールできます。(ql:quickload :cl-ppcre)
  • CSVファイルの読み込み
    • fare-csvを使います。Lisperに優しく結果がリストで返ってきます(ql:quickload :fare-csv)
  • with->
    • with-open-fileの出力専用バージョンで上書き(:if-exists :supersede)、かつストリームがボディ内で、>という変数名で参照できるという自作適当マクロです。
  • letS*、Rignore
    • 自分が良く使っているSeriesを扱うloopマクロみたいなものです。分配束縛ができます。古のマクロを自作で復活させて使ってるだけで完全なる趣味です。
  • aprogn
    • 入れ子を解消する自作のマクロです。
(aprogn date
        (ppcre:regex-replace "日" it "")
        (ppcre:regex-replace "月" it "/")
        (ppcre:regex-replace "^" it "2011/"))

(ppcre:regex-replace "^" (ppcre:regex-replace "月" (ppcre:regex-replace "日" date "") "/") "2011/")

みたいに展開されます。直前の式がitの部分に展開されます。

書いてる途中で、同じ関数が連続する場合は、

(aprogn date
        (ppcre:regex-replace "日" it "")
        (// "月" it "/")
        (// "^" it "2011/"))

みたいに書けたらナイスなんじゃないだろうか!などと思いましたが、横道に逸れると仕事が終わらないので自重しました。そもそもそんなに同じ関数が連続になることもないのであまり効果がなさそうです。

2010-12-29

日常LISP (3) 常用シェルをCLISPに その2

| 11:41 | 日常LISP (3) 常用シェルをCLISPに その2 - わだばLisperになる を含むブックマーク はてなブックマーク - 日常LISP (3) 常用シェルをCLISPに その2 - わだばLisperになる

シェルをCLISPにしてみる実験の経過報告。

  • まだ全部をCLISPにする、というのは辛い
  • パイプの問題をどうするか
  • プログラミングが簡単にできるので、部分的には、既存のシェルより楽になるところもある
  • やっぱりEmacsのシェルモードから入力すると楽
  • 履歴機能をもう少し充実させたい

といったところです。

改善点は、

  • 括弧/ダブルクォートの対を簡単に入力できるようにした
  • ユーティリティ関数を定義している

というところです。

括弧の入力支援については、

.inputrcに

"\eL": "()\C-b"
"\e\"": "\"\"\C-b"

というようなものを追加しました。

m-"とで、""が入力され、m-sh-Lで()が入力されます。括弧の方はちょっとイレギュラーですが、"("が遠いのでこういう風にしてみました。

また、Emacsのシェルモードで使うのに便利なように、

;; Emacs
(define-key shell-mode-map [(meta ?c)]
  (defun insert-\#\[\] ()
    (interactive)
    (insert "#[]")
    (backward-char)))

こんなのも定義してみました。

ユーティリティ関数については、

;; swank起動
(defun swank (&key (lisp :sbcl))
  (case lisp
    (otherwise #[/lisp/swank-sbcl-1.0.38])))

;; capistranoでデプロイ
(defun cap-staging (name)
  (prog1 (run-program "/home/foo/bin/cap-staging" ;; 既存のシェルスクリプト
                      :arguments (list (string-downcase name)))
         (princ #\Bell)
         (run-program "mpg123" :ARGUMENTS '("/home/foo/sounds/eudora-sound.mp3"))
         (run-program "firefox" :ARGUMENTS (list (case name
                                                   (:project-foo "/var/tmp/deployfinish.html")
                                                   (otherwise "http://unicodesnowmanforyou.com/"))))))

;; ssh
(defun foo ()
  #[ssh foo])

;; IE6マシンに接続
(defun ie6 ()
  #[xvncviewer 192.168.1.6])

という非常にどうでも良いものばかりをずらずら定義していますが、割と便利です。

関数を定義するとファイルに書き出されるようにするともっと便利かもしれません。対話環境については、Interlispの環境がヒントになる気がしたのでちょっと真似してみたいと思っています。