モナドとかの演算子の型
(>>=) :: Monad m => m a -> (a -> m b) -> m b flip (>>=) :: Monad m => (a -> m b) -> m a -> m b (=<<) :: Monad m => (a -> m b) -> m a -> m b ap :: Monad m => m (a -> b) -> m a -> m b (<*>) :: Applicative f => f (a -> b) -> f a -> f b flip (<**>):: Applicative f => f (a -> b) -> f a -> f b (<**>) :: Applicative f => f a -> f (a -> b) -> f b (<$>) :: Functor f => (a -> b) -> f a -> f b fmap :: Functor f => (a -> b) -> f a -> f b map :: (a -> b) -> [a] -> [b] mapM :: Monad m => (a -> m b) -> [a] -> m [b] flip forM :: Monad m => (a -> m b) -> [a] -> m [b] forM :: Monad m => [a] -> (a -> m b) -> m [b]
おまけ
(>>) :: Monad m => m a -> m b -> m b (*>) :: Applicative f => f a -> f b -> f b (<*) :: Applicative f => f a -> f b -> f a (<$) :: Functor f => a -> f b -> f a (<|>) :: Alternative f => f a -> f a -> f a
ちなみに do とか do ブロック内の <- は演算子でも関数でもないみたい。
逆FizzBuzz問題
オートマトンっぽい問題なのは分かるけど、それを実装するのは面倒くさいので必要と思われる長さのFizzBuzzシーケンスを切り出して全チェックしてます。
与えられた「Fizz Buzz リスト」 の長さを len とすると、解が含まれる範囲は先頭から高々「7 + (len - 1)」...って考えて良いような気がします。
この程度なら全チェックしても大きなコストにはならないでしょう。
;; 逆 FizzBuzz ;; -------------------------------------------------------------------- ;; :dependencies [[org.clojure/clojure "1.4.0"] ;; [org.clojure/core.incubator "0.1.0"] ;; [org.clojure/math.numeric-tower "0.0.1"]] ;; --------------------------------------------------------------------- (ns inv-fizzbuzz.core (:use [clojure.core.incubator :only (-?>>)]) (:use [clojure.math.numeric-tower :only (lcm)])) (def word-num-pairs [["fizz" 3] ["buzz" 5]]) (defn lcmx [& xs] (reduce (fn [acc x] (lcm acc x)) xs)) (def fizzbuzz-seq (let [nils #(repeat % nil) cyc #(cycle (cons %1 (nils (dec %2))))] (->> (map (fn [[w n]] (cyc w n)) word-num-pairs) (apply map str) (drop 1)))) (def N (count (->> fizzbuzz-seq (take (apply lcmx (map second word-num-pairs))) (filter not-empty)))) (def INF Double/POSITIVE_INFINITY) (defn fizzbuzz [len] (let [n (+ N (dec len))] (->> (map list fizzbuzz-seq (range 1 INF)) (filter (comp not-empty first)) (take n)))) (defn inv-fizzbuzz [& args] (let [len (count args)] (-?>> (fizzbuzz len) (partition len 1) (filter #(= args (map first %))) (map #(map second %)) (group-by #(- (last %) (first %))) sort first second first)))
(inv-fizzbuzz "fizz") ;=> (3) (inv-fizzbuzz "fizzbuzz") ;=> (15) (inv-fizzbuzz "fizz" "buzz") ;=> (9 10) (inv-fizzbuzz "buzz" "fizz" "fizz") ;=> (5 6 9) (inv-fizzbuzz "fizz" "fizz" "buzz") ;=> (6 9 10) (inv-fizzbuzz "buzz" "fizz" "fizz" "buzz") ;=> (5 6 9 10) (inv-fizzbuzz "fizz" "buzz" "fizz" "buzz") ;=> nil (inv-fizzbuzz "fizz" "buzz" "fizz" "fizz" "buzz") ;=> (3 5 6 9 10) (inv-fizzbuzz "fizz" "fizzbuzz" "fizz" "buzz") ;=> (12 15 18 20)
あってるかなぁ？
FizzBuzzシーケンスの周期「７」はハードコードせずに、Fizz,Buzzの周期、3と5から算出しています。変数 N がそれにあたります。
したがって、word-num-pairs に任意の単語・周期ペアを登録することで拡張可能にしてあるつもりです。
たとえば、こんな風にすると
(def word-num-pairs [["fizz" 3] ["buzz" 5] ["hoge" 4] ["piyo" 6]])
こうなります
(inv-fizzbuzz "hoge" "fizz" "buzz") ;=> (8 9 10) (inv-fizzbuzz "buzz" "fizz" "hoge") ;=> (50 51 52) (inv-fizzbuzz "buzz" "fizzhogepiyo" "fizz") ;=> (35 36 39) (inv-fizzbuzz "hoge" "fizzbuzzpiyo" "hoge" "fizz" "buzz" "fizzhogepiyo") ;=> (28 30 32 33 35 36)
あってるのかなぁ？
別に...
-?>> 使う意味はなかったな。「解がなければそこで終了」のつもりで書いたけど、empty なコレクションは nil じゃないから機能しない。やるならこうですね。
(defn inv-fizzbuzz [& args] (let [len (count args)] (-?>> (fizzbuzz len) (partition len 1) (filter #(= args (map first %))) not-empty (map #(map second %)) (group-by #(- (last %) (first %))) sort first second first)))
not-empty は empty なコレクションを nil に、そうでないコレクションはそのまま返します。
バグ修正
単語と周期のペアを mapコレクションにしてしまうと要素の並びが保証されないので問題がありました。
対策として、ペアを順に並べたベクタに変更しました。
partitionしてmapする関数
こんなのあったら便利かもしれない関数。
partition したシーケンスを map で処理したいということがたまにある。それを簡略できると楽なことがたまにはあるかも。
実は欲しかったのは (mapncat 2 f coll) のパターン。
下のようなコードを書きたくて作った補助関数でした。一般化したら前記のようになった。
もっと分かりやすいネーミングにしたかったけど思い付かなかった。
例の問題
CLの練習で適当に書いた。いったい何を訴えたいのかよくわからないコードになった。
解き方はいたって普通。
(require :alexandria) (require :cl-ppcre) (defun perms (n xs list fn) (if (zerop n) (funcall fn list) (loop for x in xs do (perms (1- n) xs (append list (list x)) fn)))) (defun perms-list (n xs) (let ((result nil)) (perms n xs nil #'(lambda (x) (push x result))) result)) (defun solve (n) (let* ((xs (perms-list n (coerce "AGCT" 'list))) (xs (mapcar (alexandria:curry #'concatenate 'string) xs))) (remove-if-not (alexandria:curry #'cl-ppcre:scan ".*AAG.*") xs))) (solve 5) ;;=> ("TTAAG" "TCAAG" "TGAAG" "TAAGT" "TAAGC" "TAAGG" "TAAGA" "TAAAG" "CTAAG" ;; "CCAAG" "CGAAG" "CAAGT" "CAAGC" "CAAGG" "CAAGA" "CAAAG" "GTAAG" "GCAAG" ;; "GGAAG" "GAAGT" "GAAGC" "GAAGG" "GAAGA" "GAAAG" "ATAAG" "ACAAG" "AGAAG" ;; "AAGTT" "AAGTC" "AAGTG" "AAGTA" "AAGCT" "AAGCC" "AAGCG" "AAGCA" "AAGGT" ;; "AAGGC" "AAGGG" "AAGGA" "AAGAT" "AAGAC" "AAGAG" "AAGAA" "AAAGT" "AAAGC" ;; "AAAGG" "AAAGA" "AAAAG")
名前空間の扱いが今イチ慣れてない。
順列ライブラリとか、遅延評価リストライブラリとか探せばあるんだろうか。
ccl:*command-line-argument-list* がなんか変
● 実行形式ファイルが作りたい
コマンドライン引数リストをそのまま表示するプログラム(Clozure CL)
;;; hello.lisp (defun -main () (format t "~a" ccl:*command-line-argument-list*)) (ccl:save-application "hello" :toplevel-function #'-main :prepend-kernel t)
コンパイルして実行
$ ccl --version Version 1.6-r14468M (LinuxX8664) $ ccl -n -l hello.lisp
$ ./hello (./hello) $ ./hello foo bar (./hello foo bar)
ここまではいいんだけど、何故か１引数で実行するとエラーになる
$ ./hello foo Couldn't load lisp heap image from foo: No such file or directory
引数をファイルとしてロードしようとしている？ よくわからん。もしかしてバグ...？
● イメージのロードならうまくいく
prepend-kernel を nil にしてイメージをロードする実行形態ならうまくいく。
$ ccl -n -l hello.lisp $ ccl -I hello foo (CCL_INSTALLED_PATH/lx86cl64 foo)
CCL_INSTALLED_PATH は ClozureCL がインストールされてるパスです。
ちなみにうちの環境では ccl は ClozureCL のシェルスクリプト ccl64 の alias です。
● 追記（一応解決？）
:prepend-kernel t の実行形式ファイルでも引数によっては 1引数で実行出来た
$./hello -foo (./hello -foo)
「ccl:*command-line-argument-list* が変」というわけではなく、作られる実行ファイルの引数解釈の仕様なのかな。１引数だとイメージファイル読込となる仕様みたい。
実行形式ファイル hello と、バイナリイメージファイル hello_bin を作って実験。どちらもコードは一緒ですが、どちらが実行されているか分るよう[見出し]を出力するように細工しました。
$ ./hello hello_bin [hello_bin] (./hello) $ ./hello hello_bin foo [hello] (./hello hello_bin foo) $ ./hello hello_bin foo bar [hello] (./hello hello_bin foo bar) $ ./hello -foo [hello] (./hello -foo) $ ./hello foo bar [hello] (./hello foo bar) $ ./hello [hello] (./hello)
１つめの実行例では hello_bin が実行され、それ以外は hello が実行されている。そういう仕様なのだろう。きっと。
partial関数（マクロ）の続き
前回書いた partial マクロ利用例
(mapcar (partial #'args-rotate-right 1 #'make-list :initial-element 'X) '(1 2 3 4 5))
mapcar の第一引数をもう少し理解しやすい形にしたい。
そこで部分適用を段階的にしてみる。args-rotate-right 1 を部分適用した後、その部分適用した関数を使ってさらに make-list を部分適用。
(let ((fn (partial (partial #'args-rotate-right 1) #'make-list :initial-element 'X))) (mapcar fn '(1 2 3 4 5)))
これを変形する。ネストした部分適用を逐次的な記述へ。
(let* ((r1 (partial #'args-rotate-right 1)) (fn (partial r1 #'make-list :initial-element 'X))) (mapcar fn '(1 2 3 4 5)))
この形をみてふと clojure の -> が使いたくなった。
以前 elisp 用に書いたものを移植。というかそのまんま CL でも使える。
(defmacro -> (&rest exprs) (when exprs (reduce #'(lambda (acc expr) (if (listp expr) (cons (car expr) (cons acc (cdr expr))) (list expr acc))) exprs)))
これを使うと
(-> (partial #'args-rotate-right 1) (partial #'make-list :initial-element 'X) (mapcar '(1 2 3 4 5)))
だいぶスッキリ読みやすくなった。マクロ展開してみると
(MAPCAR (LAMBDA (&REST #:G0) (APPLY (LAMBDA (&REST #:G1) (APPLY #'ARGS-ROTATE-RIGHT 1 #:G1)) #'MAKE-LIST :INITIAL-ELEMENT 'X #:G0)) '(1 2 3 4 5))
部分適用する毎に lambda のネストが作られる。
一方このエントリの最初に書いたコードを展開すると
(MAPCAR (LAMBDA (&REST #:G0) (APPLY #'ARGS-ROTATE-RIGHT 1 #'MAKE-LIST :INITIAL-ELEMENT 'X #:G0)) '(1 2 3 4 5))
lambda が一つ少ない。
読みやすさと処理コストのトレードオフか...
