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 |

2010-11-25

GOOでL-99 (P23 指定した個数の要素をランダムに選択)

| 23:30 | GOOでL-99 (P23 指定した個数の要素をランダムに選択) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P23 指定した個数の要素をランダムに選択) - わだばLisperになる

以前は、L-99しかやってないブログと化していた程、L-99を色々なLISP方言で解いてみていましたが、どの方言でも完遂してはいません。

久々にちょっと久々に挑戦してみようかなと思い、ブログを眺めてみると、直近のエントリーは、2年前のGOOでの挑戦でした。

GOOもすっかり忘れているので、ちょっと書いて遊んでみることに。

久々に触ってみましたが、やっぱり色々と変わっています。

ちなみに、GOOはどういう言語かというと、Dylanの開発にも携わった、Jonathan Bachrach氏が開発した言語で、Dylan+Scheme+当時構想だけ発表されていたArcという感じのLISP方言です。

S式のDylanな感じもしつつ、Paul Graham氏の「生まれて3週間目のArc」を意識した機能と、短かすぎて逆に覚えられない関数名が特徴だと個人的には思っています。(GOOのページにもArcのパロディのような題名が多くあります)

ざっと目立つところだと

  • Arc/Perl風の短い関数名(と動作)
  • 基本的にメソッド主体で、総称関数
  • Dylanっぽい構文
  • Seriesが組み込み
  • 多値の代わりにタプル

というところでしょうか。

結構面白いので変わったLISP方言が好きな方にはお勧めです。

P23 (**) Extract a given number of randomly selected elements from a list.
    The selected items shall be returned in a list.
    Example:
    * (rnd-select '(a b c d e f g h) 3)
    (E D A)

    Hint: Use the built-in random number generator and the result of problem P20.
(df random-pop (u|<lst> => (tup <lst> <any>))
  (def rest (packer-fab <lst>))
  (def item (packer-fab <lst>))
  (def picknum (random (- (len u) 1)))
  (for ((e u)
        (i (from 0)))
    (if (= picknum i)
        (pack-in item e)
        (pack-in rest e)))
  (tup (packer-res rest)
       (1st (packer-res item))))

(df rnd-select (u|<lst> n|<int> => <lst>)
  (loc ((self1 (acc rest n)
          (if (or (zero? n) 
                  (empty? rest))
              acc
              (let (((tup nrest item) 
                     (random-pop rest)))
                (self1 (pair item acc)
                              nrest
                              (- n 1))))))
    (self1 () u n)))

実行例

(for ((i (range 1 <= 100)))
  (say out (rnd-select '(a b c d e f g h) 3) "\n"))
;-> 
;   (e g d)
;   (d e a)
;   (f d b)
;   (a b e)
;   (c a g)
;   (f d e)
;   (c f e)
;   (f g c)
;   (c f g)
;   (c g a)
;   (b e a)
;   (c a f)
;   (g f b)
;   (b a f)
;   (e d b)
;   (c a b)
;   (b f a)
;   (c g a)
;   (c b a)
;   (f e a)
;...

2008-10-28

GOOでL-99 (P22 指定した範囲の数列のリスト)

| 00:15 | GOOでL-99 (P22 指定した範囲の数列のリスト) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P22 指定した範囲の数列のリスト) - わだばLisperになる

久々にGOOをひっぱり出してきてみました。何に由来するのか分かりませんが、GOOの作法はひどく覚えにくいと感じます。

多分、命名規則が、他のLISP方言と違うところにあるのではないかと思うのですが、この違いというのが、はっきりくっきり違うというのではなくて、微妙に違うというところが逆に覚えづらい気がします。あと関数名を短くしすぎなのも微妙に覚えづらい。あと引数の順番とか、微妙に逆。そしてマニュアルも微妙に独自。

今回は、総称関数にする必要もないので、関数です。define-functionの略のdfを使用。

(df my-range (start|<num> end|<num> by|... => <seq>)
  (def ans (packer-fab <lst>))
  (def by (if (empty? by) 1 (1st by)))
  (def r (if (<= start end)
             (range-by start <= end (op + _ by))
             (range-by start > end (op - _ by))))
  (for ((x r)) (pack-in ans x))
  (packer-res ans))

(my-range 4 9)
;=> (4 5 6 7 8 9))
(my-range 9 4)
;=> (9 8 7 6 5 4)
(my-range 3 3)
;=> '(3)

2008-06-18

GOOでL-99 (P21 指定した位置に要素を挿入する)

| 17:39 | GOOでL-99 (P21 指定した位置に要素を挿入する) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P21 指定した位置に要素を挿入する) - わだばLisperになる

先週さぼったの2連続で…。前回と同じでmy-splitを使っています。文字列の扱いをどうしたら良いかと思いましたが、とりあえず印字表現をそのまま挿し込むことにしました。

(insert-at 'alpha '(a b c d) 2) ;=> (a alpha b c d)
(insert-at 'alpha #(a b c d) 2) ;=> #(a alpha b c d)
(insert-at 'alpha #[a b c d] 2) ;=> #[a alpha b c d]
(insert-at 'alpha "abcd" 2)     ;=> "aalphabcd"

(dg insert-at (item|<any> u|<seq> p|<int> => <seq>))

(dm insert-at (item|<any> u|<seq> p|<int> => <seq>)
  (def (tup x y) (my-split u (1- p)))
  (cat x (lst item) y))

(dm insert-at (item|<any> u|<str> p|<int> => <str>)
  (def (tup x y) (my-split u (1- p)))
  (cat x (to-str item) y))

GOOでL-99 (P20 指定した要素を削除)

| 17:39 | GOOでL-99 (P20 指定した要素を削除) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P20 指定した要素を削除) - わだばLisperになる

以前に定義したmy-splitを使っています。GOOで分割代入/束縛させたい場合、変数のところをタプルにすると分割して束縛されます。

(remove-at '(a b c d) 2) ;=> (a c d)
(remove-at #(a b c d) 2) ;=> #(a c d)  
(remove-at #[a b c d] 2) ;=> #[a c d]  
(remove-at "abcd" 2)     ;=> "acd"

(dg remove-at (u|<seq> p|<int> => <seq>))

(dm remove-at (u|<seq> p|<int> => <seq>)
  (def (tup x y) (my-split u (1- p)))
  (cat x (sub* y 1)))

2008-06-05

GOOでL-99 (P19 指定した位置でローテーション)

| 23:11 | GOOでL-99 (P19 指定した位置でローテーション) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P19 指定した位置でローテーション) - わだばLisperになる

P17で定義したmy-splitを使います。

(rotate '(a b c d e f g h) 3)
;=> (d e f g h a b c)
(rotate '(a b c d e f g h) -2)
;=> (g h a b c d e f)
(rotate #[a b c d e f g h] 3)
;=> #[d e f g h a b c]
(rotate #(a b c d e f g h) -2)
;=> #(g h a b c d e f)
(rotate "abcdefgh" 3)
;=> "defghabc"
(rotate "abcdefgh" -2)
;=> "ghabcdef"

(dg rotate (u|<seq> p|<int> => <seq>))

(dm rotate (u|<seq> p|<int> => <seq>)
  (def p (if (> 0 p) (+ p (len u)) p))
  (app cat (rev (as <lst> (my-split u p)))))

2008-05-29

GOOでL-99 (P18 範囲切り出し)

| 17:27 | GOOでL-99 (P18 範囲切り出し) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P18 範囲切り出し) - わだばLisperになる

シーケンスの範囲切り出しには総称関数のseqが備え付けで用意されています。

今回、最後にシーケンスのクラスを調べるのに、class-ofではなくて、col-res-typeを使ってみました。

しかし、機能として一体何が違うのかは良く分かっていません…。

(slice '(a b c d e f g h i k) 3 7)
;==> (c d e f g)
(slice #(a b c d e f g h i k) 3 7)
;==> #(c d e f g)
(slice #[a b c d e f g h i k] 3 7)
;==> #[c d e f g]
(slice "abcdefghik" 3 7)
;==> "cdefg"

(dg slice (u|<seq> s|<int> e|<int> => <seq>))

(dm slice (u|<seq> s|<int> e|<int> => <seq>)
  (def res (packer-fab <lst>))
  (for ((x u)
        (i (from 1)))
      (when (and (<= s i) (<= i e))
        (pack-in res x)))
  (as (col-res-type u) (packer-res res)))

2008-05-24

GOOでL-99 (P17 指定した位置でリストを分割)

| 15:32 | GOOでL-99 (P17 指定した位置でリストを分割) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P17 指定した位置でリストを分割) - わだばLisperになる

GOOには、splitが既に存在しているのですが、Perlのsplitと同じようなもののため、my-splitとして作成。

また、GOOには多値がないのですが、その代わりとしては、タプルを使うことになっていようです。

色々な型に対応するということで、分割した結果をタプルで返すことにしてみました。

seqは、CLのsubseqに相当し、seq*は、(seq x (len seq))と同様の働きをするものです。

(my-split '(a b c d e f g h i k) 3)
;==> #((a b c) (d e f g h i k))

(my-split #(a b c d e f g h i k) 3)
;==> #((a b c) (d e f g h i k))

(my-split #[a b c d e f g h i k] 3)
;==> #(#[a b c] #[d e f g h i k])

(my-split "abcdefghik" 3)
;==> #("abc" "defghik")

(dg my-split (u|<seq> pos|<int> => <seq>))

(dm my-split (u|<seq> pos|<int> => <seq>)
  (tup (sub u 0 pos) (sub* u pos)))

2008-05-16

GOOでL-99 (P16 周期Nで要素を間引く)

| 00:24 | GOOでL-99 (P16 周期Nで要素を間引く) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P16 周期Nで要素を間引く) - わだばLisperになる

GOOでは、CLで有名なRichard C. Water氏のSERIESを手本にした遅延評価のシリーズが組み込みで用意されています。

rangeや、from等、scan-rangeっぽいものがあるのですが、汎用的なforループの中で使えるというところが便利です。

;(drop '(a b c d e f g h i j k) 3)
;=> (a b d e g h j k)

;(drop #(a b c d e f g h i j k) 3)
;=> #(a b d e g h j k)

;(drop #[a b c d e f g h i j k] 3)
;=> #[a b d e g h j k]

;(drop "abcdefghijk" 3)
;=> "abdeghjk"

(dg drop (u|<seq> n|<int> => <seq>))

(dm drop (u|<seq> n|<int> => <seq>)
  (def res (packer-fab <lst>))
  (for ((x u)
        (cnt (from 1)))
    (unless (zero? (rem cnt n))
      (pack-in res x)))
  (as (class-of u) (packed res)))

2008-05-10

GOOでL-99 (P15 要素を任意回数複製する)

| 18:03 | GOOでL-99 (P15 要素を任意回数複製する) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P15 要素を任意回数複製する) - わだばLisperになる

色々な型に対応しようと思うと、どうも再帰というよりは、forのようなループを多用してしまうような…。

LISPで再帰を多用するのは、扱うデータが主にリストだからという面もあるのでしょうか。

;(repli '(a b c c d) 3)
;=> (a a a b b b c c c c c c d d d)

;(repli #(a b c c d) 3)
;=> #(a a a b b b c c c c c c d d d)

;(repli #[a b c c d] 3)
;=> #[a a a b b b c c c c c c d d d]

;(repli "abccd" 3)
;=> aabbccccdd

(dg repli (u|<seq> times|<int> => <seq>))

(dm repli (u|<seq> times|<int> => <seq>)
  (def res (packer-fab <lst>))
  (for ((x u))
    (for ((i (range 1 <= times)))
      (pack-in res x)))
  (as (class-of u) (packed res)))

2008-05-01

GOOでL-99 (P14 各要素を2倍する)

| 15:02 | GOOでL-99 (P14 各要素を2倍する) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P14 各要素を2倍する) - わだばLisperになる

GOOでもSLIMEが使えるようなので、今回使ってみました。

CVS版SLIMEのcontribの中にある、swank-goo.gooを使うのですが、CL用の設定と競合してしまうようで、slime-setupで読み込むものは、軒並み読み込まないで利用する必要があるようです。

手元で確認できたGOOのバージョンは、155でgooとg2cとありますが、g2cの方を利用。

使い勝手としては、goo-shellだとエラーの度にREPLに移動して、リスタート候補を選択するのが面倒だったのですが、SLIMEだと簡単になった、位でしょうか。飛躍的に便利になる訳ではないようです(^^;

;(dupli '(a b c c d))
;=> (a a b b c c c c d d)

;(dupli #(a b c c d))
;=> #(a a b b c c c c d d)

;(dupli #[a b c c d])
;=> #[a a b b c c c c d d]

;(dupli "abccd")
;=> aabbccccdd

(dg dupli (u|<seq> => <seq>))

(dm dupli (u|<seq> => <seq>)
  (def res (packer-fab <lst>))
  (for ((x u))
    (pack-in res x)
    (pack-in res x))
  (as (class-of u) (packed res)))

2008-04-24

GOOでL-99 (P13 ランレングス圧縮 その3)

| 06:43 | GOOでL-99 (P13 ランレングス圧縮 その3) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P13 ランレングス圧縮 その3) - わだばLisperになる

WikipediaでDylanの歴史の項目を眺めていたら、GOOの作者であるJonathan Bachrach氏は、Dylanの一番最初のフリーの実装を作った人だったらしく、GOOがDylanから影響を受けているというもの宜なるかな。

supはCLのcall-next-methodのようなもので、与えた引数に次に特定できるクラスのメソッドを適用します。

(encode-direct '(a a a a b c c a a d e e e e))
;=>  ((4 a) b (2 c) (2 a) d (4 e))
(encode-direct #[a a a a b c c a a d e e e e])
;=> #[(4 a) b (2 c) (2 a) d (4 e)]
(encode-direct #(a a a a b c c a a d e e e e))
;=> #((4 a) b (2 c) (2 a) d (4 e))
(encode-direct "aaaabccaadeeee")
;=> "4;a,b,2;c,2;a,d,4;e"

(dg encode-direct (u|<seq> => <seq>))

(dm encode-direct (u|<seq> => <seq>)
  (if (empty? u)
      u
      (let ((cnt 0)
            (prev (elt u 0))
            (res (packer-fab <lst>)))
        (for ((x `(,@(as <lst> u) ,(gensym))))
            (if (= prev x)
                (incf cnt)
                (seq 
                 (pack-in res (if (= 1 cnt) prev `(,cnt ,prev)))
                 (set cnt 1)
                 (set prev x))))
        (as (class-of u) (packed res)))))

(dm encode-direct (u|<str> => <str>)
  (join (map (fun (x) 
               (if (cons? x)
                   (let (((tup num item) x))
                     (cat (to-str num) ";" (to-str item)))
                   (to-str x)))
             (sup (as <lst> u)))
        ","))

(df cons? (u|<any> => <log>)
  (and (subtype? (class-of u) <lst>)
       (not (nul? u))))

2008-04-17

GOOでL-99 (P12 ランレングス圧縮の伸長)

| 17:45 | GOOでL-99 (P12 ランレングス圧縮の伸長) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P12 ランレングス圧縮の伸長) - わだばLisperになる

何となくDylanの書法を真似て書いてみました。DGは、CLのdefgeneric、Dylanのdefine genericです。

generic系で、対応するクラスと返り値のクラスを明示→個別をmethod系で定義、というのは、CLOS系では割と定番なのかもしれません。

GOOでは、let(def)は、タプルを指定することによって分割代入的なことが可能なので使ってみました。

それと、letはCL/Schemeでいうlet*なので若干注意が必要かもしれません。パラレルにしたい場合は、前述のタプルを使った方法で書く必要があります。

opfは、Arcのzap、TAOの!!のようなもので自己代入の書法です。(set x (op + _ 1) ) => (opf x (+ _ 1) )と書けます。

(decode '((4 a) (1 b) (2 c) (2 a) (1 d) (4 e)))
;=> (a a a a b c c a a d e e e e)
(decode #((4 a) (1 b) (2 c) (2 a) (1 d) (4 e)))
;=> #(a a a a b c c a a d e e e e)
(decode #[(4 a) (1 b) (2 c) (2 a) (1 d) (4 e)])
;=> #[a a a a b c c a a d e e e e]
(decode "4;a,1;b,2;c,2;a,1;d,4;e")
;=> "aaaabccaadeeee"

(dg decode (u|<seq> => <seq>))

(dm decode (u|<seq> => <seq>)
  (def res () )
  (for ((item u))
    (def (tup n item) item)
    (opf res (cat _ (repeat `(,item) n))))
  (as (class-of u) res))

(dm decode (u|<str> => <str>)
  (let ((res "")
        (items (split u #\,)))
    (for ((x items))
      (def (tup n item) (split x #\;))
      (opf res (cat _ (repeat item (str-to-num n)))))
    res))

2008-04-12

GOOでL-99 (P11 要素をランレングス圧縮する その2)

| 09:13 | GOOでL-99 (P11 要素をランレングス圧縮する その2) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P11 要素をランレングス圧縮する その2) - わだばLisperになる

前回(P10)の内容をちょっと変更して終了

(encode-modified '(a a a a b c c a a d e e e e))
;=> ((4 a) b (2 c) (2 a) d (4 e))
(encode-modified "aaaabccaadeeee")
;=> "4;a,b,2;c,2;a,d,4;e"

(dm encode-modified (u|<col> => <col>)
  (as (class-of u)
      (map (fun (x) (let ((xlen (len x)))
                      (if (= 1 xlen)
                          (head x)
                          `(,xlen ,(head x)))))
           (my-pack1 u))))

(dm encode-modified (u|<str> => <str>)
  (join (map (fun (x) (let ((xlen (len x)))
                        (cat (if (= 1 xlen) "" (cat (to-str xlen) ";"))
                             (to-str (head x)))))
             (my-pack1 u))
        ","))

2008-04-11

GOOでL-99 (P10 ランレングス圧縮)

| 07:32 | GOOでL-99 (P10 ランレングス圧縮) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P10 ランレングス圧縮) - わだばLisperになる

P09の定義を利用してランレングス圧縮を作成します。

今回も、コレクションクラスで作成。

前回作成した補助関数my-pack1を利用しました。

GOOの総称関数のディスパッチはCLOSのようにより特定なクラスが優先されます。

下記の例でも二つのメソッドのうちストリングクラスの定義の方が上位クラスのコレクションクラスより特定的なのでそちらが優先されています。

funは、CL/Schemeのlambdaで、Arcのfnのようなネーミングです。

Arcの[foo _]に対応する形式としては、(op foo _)というものがあります。

(encode '(a a a a b c c a a d e e e e))
;=> ((4 a) (1 b) (2 c) (2 a) (1 d) (4 e))
(encode #(a a a a b c c a a d e e e e))
;=> #((4 a) (1 b) (2 c) (2 a) (1 d) (4 e))
(encode #[a a a a b c c a a d e e e e])
;=> #[(4 a) (1 b) (2 c) (2 a) (1 d) (4 e)]
(encode "aaaabccaadeeee")
;=> "4;a,1;b,2;c,2;a,1;d,4;e"

(dm encode (u|<col> => <col>)
  (as (class-of u)
      (map (fun (x) `(,(len x) ,(head x)))
           (my-pack1 u))))

(dm encode (u|<str> => <str>)
  (join (map (fun (x) (cat (to-str (len x)) ";" (to-str (head x))))
             (my-pack1 u))
        ","))

2008-04-10

GOOでL-99 (P09 連続して現われる要素を纏める)

| 04:23 | GOOでL-99 (P09 連続して現われる要素を纏める) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P09 連続して現われる要素を纏める) - わだばLisperになる

今回も無駄にリストだけでなくコレクションクラスに対応してみました。

また、GOOでは、繰り返しの為の値の蓄積にpackerというものが使えるようなので使ってみました。

packer-fabでpakerのインスタンスを作成し、pack-inで蓄積、packedで蓄積結果を任意のクラスで返します。割とややこしい使い勝手。


(my-pack '(a a a a b c c a a d e e e e))
;=> ((a a a a) (b) (c c) (a a) (d) (e e e e))
(my-pack #(a a a a b c c a a d e e e e))
;=> #((a a a a) (b) (c c) (a a) (d) (e e e e))
(my-pack #[a a a a b c c a a d e e e e])
;=> #[(a a a a) (b) (c c) (a a) (d) (e e e e)]
(my-pack "aaaabccaadeeee")
;=> "aaaa,b,cc,aa,d,eeee"

(dm my-pack (u|<col> => <col>)
  (if (empty? u)
      u
      (as (class-of u) (my-pack1 u))))

(dm my-pack (u|<str> => <str>)
  (if (empty? u)
      u
      (join (map (op as <str> _) 
                 (my-pack1 u))
            ",")))

(df my-pack1 (u|<col> => <lst>)
  (let ((prev (1st u))
        (res (packer-fab <lst>))
        (tem (packer-fab <lst>)))
    (for ((x u))
      (unless (= x prev)
        (pack-in res (packed tem))
        (set tem (packer-fab <lst>)))
      (pack-in tem x)
      (set prev x))
    (pack-in res (packed tem))
    (packed res)))

;))))))))))

2008-04-09

GOOでL-99 (P08 連続して現われる要素を圧縮)

| 01:24 | GOOでL-99 (P08 連続して現われる要素を圧縮) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P08 連続して現われる要素を圧縮) - わだばLisperになる

コレクションクラスに対応してみました。

コレクションクラスがどういう位置付けなのかいまいち分かっていませんが、リストやベクタのスーパークラスのようです。

1stはCLのfirstで、2nd、3rdまで標準で存在しています。

empty?は、コレクションクラスのオブジェクトが空であるかを判定するものです。

(compress "") ;=> ""
(compress '(a a a a b c c a a d e e e e)) ;=> (a b c a d e) リスト
(compress #(a a a a b c c a a d e e e e)) ;=> #(a b c a d e) タプル
(compress #[a a a a b c c a a d e e e e]) ;=> #[a b c a d e] ベクタ
(compress "aaaabccaadeeee") ;=> "abcade" 文字列

(dm compress (u|<col> => <col>)
  (if (empty? u)
      u
      (let ((prev (1st u))
            (but1st (sub u 1 (len u)))
            (res (lst prev)))
        (for ((x but1st))
            (unless (= x prev)
              (pushf res x)
              (set prev x)))
        (as (class-of u) (rev res)))))