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 |

2008-04-05

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

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

Qiにはバックトラックの構文もあって非決定性プログラミングの解説もチュートリアルにあります。

しかし説明が難しくて全然分からない(笑)

(insert-at alfa [a b c d] 2)
\=> [a alfa b c d]
\

(define insert-at
  Item [ ] _ -> [Item]
  Item Lst Pos -> [Item | Lst] where (>= 1 Pos)
  Item [H | T] Pos -> [H | (insert-at Item T (- Pos 1))])

ArcでL-99 (P55 左右のバランスがとれた二分木)

| 00:54 | ArcでL-99 (P55 左右のバランスがとれた二分木) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P55 左右のバランスがとれた二分木) - わだばLisperになる

今回は、左右のバランスがとれた二分木を生成するのがお題ですが、元がPrologの問題ということもあってバックトラックを使用して解くように、ということになっています。

バランスが取れていることの定義ですが、各々の部分木ごとにノード数が同じか、1つ違うだけ、とのこと。

ここは、Scheme風のバックトラックを使うかどうか迷いましたが、分からなくなったので前にCLで作ったものを移植しました(;´Д`)…。

これは、バックトラックではなくて、力技で全部の組み合わせのリストを生成します。

しかし、バックトラックを使って解けるようにならないと、この先かなり苦戦すると思うので、ここはちょっと保留して、Scheme風のバックトラックでどう書けるのか、考えてみた方が良いのかもしれない…。

細々

  1. 0と、0.0が同じものであると判定する方法が分からなかったので、(iso 0 0.0) -> nil、==というものを作って比較しています。
  2. Arcのreduceは初期値を設定できないので、redという初期値を設定できるreduceをでっちあげました。

(each p (cbal-tree 6)
  (prn p))
;=>
;(x (x (x nil nil) (x nil nil)) (x nil (x nil nil)))
;(x (x (x nil nil) (x nil nil)) (x (x nil nil) nil))
;(x (x nil (x nil nil)) (x (x nil nil) (x nil nil)))
;(x (x (x nil nil) nil) (x (x nil nil) (x nil nil)))
;nil

(def cbal-tree (n)
  (if (is 0 n) '(())
      (>= 1 n) '((x () () ))
      'else
      (red (fn (res x)
             (let tree `(x ,@x)
               (if cbal-tree-p.tree
                   `(,tree ,@res)
                   res)))
           () ;init
           (let half (/ (- n 1) 2)
             (if nofraction.half
                 ;; balance
                 (comb2 cbal-tree.half
                        cbal-tree.half)
                 ;; unbalance
                 (with (g (+ 1 trunc.half) ;greater 
                        l trunc.half)      ;less
                   `(,@(comb2 cbal-tree.l
                              cbal-tree.g)
                     ,@(comb2 cbal-tree.g
                              cbal-tree.l))))))))

(def nofraction (num)
  (== 0 (- num (trunc num))))

(def cbal-tree-p (tree)
  (let (ro l r) tree
    (>= 1 (abs (- count-leaf.l
                  count-leaf.r)))))

(def count-leaf (tree)
  (iflet (ro l r) tree
         (+ 1 count-leaf.l count-leaf.r))
         0)

(def comb2 (xs ys)
  (mappend (fn (y) (map (fn (x) `(,x ,y)) xs))
           ys))

(def red (f init lst)
  (reduce f (cons init lst)))

(def == (x y)
  (and (>= x y) (<= x y)))