#:g1: frontpage

 

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

Posted 2010-11-25 14:30:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
以前は、L-99しかやってないブログと化していた程、L-99を色々なLISP方言で解いてみていましたが、どの方言でも完遂してはいません。

久々にちょっと久々に挑戦してみようかなと思い、ブログを眺めてみると、直近のエントリーは、2年前のGOOでの挑戦でした。
GOOもすっかり忘れているので、ちょっと書いて遊んでみることに。
久々に触ってみましたが、やっぱり色々と変わっています。
ちなみに、GOOはどういう言語かというと、Dylanの開発にも携わった、Jonathan Bachrach氏が開発した言語で、Dylan+Scheme+当時構想だけ発表されていたArcという感じのLISP方言です。
-(http://people.csail.mit.edu/jrb/goo/)
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)
;...

RubyでL-99 (P9〜P13)

Posted 2009-03-19 17:17:00 GMT

適当につらつらと書いておりますが、折角なのでRSpecでテストも書きたいところ。
次は書いてみよう!

# P09 (**) Pack consecutive duplicates of list elements into sublists.
#     If a list contains repeated elements they should be placed in
#     separate sublists.
#
#     Example:
#     * (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))
class Array
  def pack
    self.internal_pack([], [:dummy])
  end

protected def internal_pack(ans, acc) head, *tail = self if self.empty? (ans + [acc])[1..-1] elsif head == acc[0] tail.internal_pack(ans ,acc + [head]) else tail.internal_pack(ans + [acc], [head]) end end end

%w(a a a a b c c a a d e e e e).pack #=> [["a", "a", "a", "a"], ["b"], ["c", "c"], ["a", "a"], ["d"], ["e", "e", "e", "e"]]

# P10 (*) Run-length encoding of a list. # Use the result of problem P09 to implement the so-called # run-length encoding data compression method. Consecutive # duplicates of elements are encoded as lists (N E) where N is the # number of duplicates of the element E. # # Example: # * (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)) class Array def encode self.pack.map do |x| [x.size, x.first] end end end

%w(a a a a b c c a a d e e e e).encode #=> [[4, "a"], "b", [2, "c"], [2, "a"], "d", [4, "e"]]

# P11 (*) Modified run-length encoding. # Modify the result of problem P10 in such a way that if an # element has no duplicates it is simply copied into the result # list. Only elements with duplicates are transferred as (N E) # lists. # # Example: # * (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)) class Array def encode_modified self.pack.map do |x| if 1 == x.size x.first else [x.size, x.first] end end end end

%w(a a a a b c c a a d e e e e).encode_modified #=> [[4, "a"], "b", [2, "c"], [2, "a"], "d", [4, "e"]]

# P12 (**) Decode a run-length encoded list. # Given a run-length code list generated as specified in problem # P11. Construct its uncompressed version. class Array def decode self.inject([]) do |ans, x| ans + if x.class == Array Array.new(x[0], x[1]) else Array.new(1, x) end end end end

# 2 class Array def decode t = Array self.inject([]) do |ans, x| ans.+ x.class == Array ? Array.new(x[0], x[1]) : Array.new(1, x) end end end

[[4, "a"], "b", [2, "c"], [2, "a"], "d", [4, "e"]].decode #=> ["a", "a", "a", "a", "b", "c", "c", "a", "a", "d", "e", "e", "e", "e"]

# P13 (**) Run-length encoding of a list (direct solution). # Implement the so-called run-length encoding data compression # method directly. I.e. don't explicitly create the sublists # containing the duplicates, as in problem P09, but only count # them. As in problem P11, simplify the result list by replacing # the singleton lists (1 X) by X. # # Example: # * (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)) class Array def encode_direct (self + [:dummy]).internal_encode_direct([], 1, :dummy)[1..-1] end

protected def internal_encode_direct(ans, cnt, prev) head, *tail = self if self.empty? ans elsif head == prev tail.internal_encode_direct(ans, cnt + 1, head) else tail.internal_encode_direct(ans + [[cnt, prev]], 1, head) end end end

%w(a a a a b c c a a d e e e e).encode_direct #=> [[4, "a"], [1, "b"], [2, "c"], [2, "a"], [1, "d"], [4, "e"]]


RubyでL-99 (P1〜P8)

Posted 2009-03-16 14:59:00 GMT

Rubyを勉強しております。
Rubyにリストが無いのとブロックの引数がローカルのスコープをつくらないところ(1.8では)にびっくりしました。
びっくりというより若干ショックでしたが、別にLispじゃないので当然のことでした。
ちょっとMatz Lispという言葉を真に受け過ぎていたようです(笑)

無駄に再帰していますが、L-99はそういう問題なのでRubyでも再帰。
色々分からないことが多く、まったくRubyっぽく書けてないですが、10年後位にはRubyっぽく書けるようになるのかもしれません。

# P01 (*) Find the last box of a list.
#     Example:
#     * (my-last '(a b c d))
#     (D)
class Array
  def my_last 
    head, *tail = self
    if tail.empty?
      self
    else
      tail.my_last
    end
  end
end

%w(1 2 3).my_last #=> ["3"]

# P02 (*) Find the last but one box of a list. # Example: # * (my-but-last '(a b c d)) # (C D) class Array def last2 _, *tail = self if tail[1..-1].empty? self else tail.last2 end end end

%w(a b c d).last2 #=> ["c", "d"]

#P03 (*) Find the K'th element of a list. # The first element in the list is number 1. # Example: # * (element-at '(a b c d e) 3) # C class Array def element_at (pos) head, *tail = self if 0 > pos nil elsif self.empty? || 1 >= pos head else tail.element_at(pos - 1) end end end

%w(1 2 3 4).element_at(2) #=> "2"

# P04 (*) Find the number of elements of a list. class Array def my_size _, *tail = self if self.empty? 0 else 1 + tail.my_size end end end

%w(1 2 3 4).my_size #=> 4

# P05 (*) Reverse a list. class Array def my_reverse head, *tail = self if self.empty? [] else tail.my_reverse + [head] end end end

%w(1 2 3 4).my_reverse #=> ["4", "3", "2", "1"]

#P06 (*) Find out whether a list is a palindrome. # A palindrome can be read forward or backward; e.g. (x a m a x). class Array def palindrome? self.my_reverse == self end end

%w(x a m a x).palindrome? #=> true

%w(x m a x).palindrome? #=> false

# P07 (**) Flatten a nested list structure. # Transform a list, possibly holding lists as elements into a # `flat' list by replacing each list with its elements # (recursively). # Example: # * (my-flatten '(a (b (c d) e))) # (A B C D E) # Hint: Use the predefined functions list and append. class Array def my_flatten head, *tail = self if self.empty? [] elsif head.class == Array head.my_flatten + tail.my_flatten else [head] + tail.my_flatten end end end

[1, [2, [3, 4], 5]].my_flatten #=> [1, 2, 3, 4, 5]

# P08 (**) Eliminate consecutive duplicates of list elements. # If a list contains repeated elements they should be replaced # with a single copy of the element. The order of the elements # should not be changed. # Example: # * (compress '(a a a a b c c a a d e e e e)) # (A B C A D E) class Array def _compress(prev, acc) head, *tail = self if self.empty? acc elsif head == prev tail._compress(head, acc) else tail._compress(head, acc + [head]) end end

def compress self._compress(:dummy, []) end end

%w(a a a a b c c a a d e e e e).compress #=> ["a", "b", "c", "a", "d", "e"]

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

Posted 2008-10-27 15:15:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
久々に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)

clojureでL-99 (P26 指定した個数を抜き出す組み合わせ)

Posted 2008-10-22 08:01:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
Arcの[]や、clojureの#()は、便利なんですが、更に進んで、mapの等で、`#(~(first coll) ~@%)みたいに書きたくなることが結構あります。どっちも今のところできません。というか、筋道立てて考えるとそもそも無理な相談という感じなのですが。

(defn 
  #^{:doc "P26 (**) Generate the combinations of K distinct objects 
chosen from the N elements of a list"
     :test (do (test= (combination 0 [1 2 3]) [])
               (test= (combination 88 []) [])
               (test= (count (combination 3 (range 12))) 220))}
  combination
  ([num coll]
     (cond (or (empty? coll) (>= 0 num)) 
           []
           (= 1 num) 
           (map list coll)
           :else
           `(~@(map #(cons (first coll) %)
                    (combination (- num 1) (rest coll)))
             ~@(combination num (rest coll))))))

clojureでL-99 (P24 ロトくじ)

Posted 2008-10-16 03:21:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
こういうランダムな場合に上手く条件をテストできる方法が知りたいと思ったり。

(defn
  #^{:doc "P24 (*) Lotto: Draw N different random numbers from the set 1..M."}
; ------------
  lotto-select
; ------------
  ([nums rng]
     (if (or (>= 0 rng) (>= 0 nums)) 
       nil
       (rnd-select (range 1 (+ 1 rng)) nums))))

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

Posted 2008-10-13 21:37:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
P20で作ったremove-atを使用します。どうも、ぱっとしない出来。

(defn
  #^{:doc "P20 (*) Remove the K'th element from a list."
     :test (do (test= (rnd-select [] 3) [])) }
; ----------
  rnd-select
; ----------
  ([coll num]
     (loop [coll coll, cnt 1, len (length coll), ans [] ]
       (if (or (empty? coll) (> cnt num))
         ans
         (let [p (rand-int len)]
           (recur (remove-at coll (+ 1 p))
                  (+ 1 cnt)
                  (+ -1 len)
                  (conj ans (nth coll p))))))))

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

Posted 2008-10-12 21:26:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
fromの反対のdownfromとか定義してみましたが、もう一工夫という感じです。
ちなみに、標準で、clojureには、rangeがありますが、このお題と同じ動きではありません。

(defn downfrom 
  ([start]
     (downfrom start 1))
  ([start step]
     (iterate #(- % step) start)))

(defn #^{:doc "P22 (*) Create a list containing all integers within a given range." :test (do (test= (my-range 4 9) '(4 5 6 7 8 9)) (test= (my-range 9 4) '(9 8 7 6 5 4)) (test= (my-range 3 3) '(3)))} ; -------- my-range ; -------- ([start end] (cond (< start end) (take (+ 1 (- start) end) (from start)) (> start end) (take (+ 1 start (- end)) (downfrom start)) :else (list start))))

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

Posted 2008-10-09 21:42:00 GMT

前回と同じく無限リストを利用してみました。あとおまけで、EmacsのC-tのような操作でくるくるひっくり返してゆくパターンを思い付いたので書いてみました。
とりあえず、condの節の括弧はやっぱりあった方が良いと思うんですよねー。

(defn
  #^{:doc "P21 (*) Insert an element at a given position into a list."
     :test (do (test= (insert-at 'alfa '(a b c d) 2)
                      '(a alfa b c d))
               (test= (insert-at 'alfa [] 2)
                       '(alfa))        
               (test= (insert-at 'alfa '(a b c d) -2)
                      '(alfa a b c d))
               (test= (insert-at 'alfa '(a b c d) 100)
                      '(a b c d alfa))) }
; ---------
  insert-at
; ---------
  ([item coll pos]
     (let [len (count coll)]
       (cond 
        (empty? coll) 
        (list item)
        ;; 
        (>= 0 pos) 
        (cons item coll)
        ;; 
        (<= len pos) 
        (concat coll (list item))
        ;; 
        :else 
        (mapcat #(if (= pos %1) 
                   (list item %2)
                   (list %2))
                (from 1)
                coll)))))

;; 要素をくるくるひっくり返しつつ送ってゆくパターン (defn insert-at ([item coll pos] (loop [coll (cons item coll), cnt pos, acc [] ] (if (or (>= 1 cnt) (nil? (rest coll))) (concat (reverse acc) coll) (recur (cons (first coll) (rrest coll)) (+ -1 cnt) (cons (second coll) acc))))))


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

Posted 2008-10-06 12:31:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
clojureには標準でsubseqがあります。

(defn
  #^{:doc "P18 (**) Extract a slice from a list."
     :test (do (test= (slice [] 3 7) [])
               (test= (slice '(a b c d e f g h i k) 3 7)
                      '(c d e f g))
               (test= (slice '(a b c d e f g h i k) -3 7)
                      (slice '(a b c d e f g h i k) 1 7))
               (test= (slice '(a b c d e f g h i k) -3 100)
                      '(a b c d e f g h i k))) }
; -----
  slice
; -----
  ([coll start end]
     (if (empty? coll)
       []
       (let [len (count coll), start (max start 1), end (min end len)]
         (loop [coll coll, pos 1, acc [] ]
           (if (or (empty? coll) (< end pos))
             (reverse acc)
             (recur (rest coll)
                    (+ 1 pos)
                    (if (<= start pos end)
                      (cons (first coll)
                            acc)
                      acc))))))))

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

Posted 2008-10-05 08:18:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
ありあわせの関数を使っちゃいけないということなので自前で処理しましたが、take、drop、take-while等々あるのでそれを使えば簡単に書けます。

(defn 
  #^{:doc "P17 (*) Split a list into two parts; the length of the first part is given."
     :test (do (test= (split [] 3) [[] []])
               (test= (split '(a b c d e f g h i k) 3)
                      '((a b c) (d e f g h i k)))
               (test= (split '(a b c d e f g h i k) -3)
                      '(()(a b c d e f g h i k)))
               (test= (split '(a b c d e f g h i k) 100)
                      '((a b c d e f g h i k) () ))) }
; -----
  split
; -----
  ([coll pos]
     (let [len (count coll)]
       (cond 
        (<= len pos) (list coll [])
        (>= 0 pos) (list [] coll)
        :else
        (loop [coll coll, cnt pos, head [] ]
          (if (or (empty? coll) (zero? cnt))
            (list (reverse head) coll)
            (recur (rest coll)
                   (+ -1 cnt)
                   (cons (first coll) head))))))))

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

Posted 2008-10-03 09:34:00 GMT

このお題では、関数名がdropとなっているのですが、dropはclojureにも存在するので、my-dropとしています。
clojure/dropの動作としては、SRFIのdropと同じです。
clojureの場合、名前空間を分けられるので、競合を防ぐことも可能だと思いますが、とりあえず今回は大元のdropも使っていて紛らわしいので、それはなしの方向で。

(defn 
  #^{:doc "P16 (**) Drop every N'th element from a list."
     :test (do (test= (my-drop [] 3) [])
               (test= (my-drop '(a b c d e f g h i k) -1)
                      '(a b c d e f g h i k))
               (test= (my-drop '(a b c d e f g h i k) 0)
                      '(a b c d e f g h i k))
               (test= (my-drop '(a b c d e f g h i k) 3)
                      '(a b d e g h k))) }
; ----
  my-drop
; ----
  ([coll n]
     (if (empty? coll)
       []
       (loop [coll coll, acc [] ]
         (if-let block (butlast (take n coll))
           (recur (drop n coll) (concat acc block))
           (concat acc coll))))))

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

Posted 2008-10-02 09:37:00 GMT

この問題は、2つ星で難しめということになっているのですが、Prologだとこういうのは難しかったりするんでしょうか。

(defn 
  #^{:doc "P15 (**) Replicate the elements of a list a given number of times."
     :test (do (test= (repli [] -1) [])
               (test= (repli [1 2] 0) nil)
               (test= (repli [1 2] -1) nil)
               (test= (repli '(a b c) 3)
                      '(a a a b b b c c c))) }
; -----
  repli
; -----
  ([coll n]
     (reduce #(concat %1 (take n (repeat %2)))
             []
             coll)))

clojureでL-99 (P14 要素を2回繰り返す)

Posted 2008-10-01 04:09:00 GMT

clojureにも畳み込み用のreduceがあります。

(defn
  #^{:doc "P14 (*) Duplicate the elements of a list."
     :test (do (test= (dupli []) [])
               (test= (dupli '(a b c c d))
                      '(a a b b c c c c d d))) }
; -----
  dupli
; -----
  ([coll]
     (reduce #(concat % (list %2 %2))
             []
             coll)))

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

Posted 2008-09-30 04:13:00 GMT

packの結果を加工せずに直接作成せよという問題。
clojureのletは分割束縛の機能があるのでリスト分解 & 合成が楽です。

(defn 
  #^{:doc "P13 (**) Run-length encoding of a list (direct solution)."
     :test (do (test= (encode-direct []) [] )
               (test= (encode-direct [1]) [1] )
               (test= (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
; -------------
  ([coll]
     (if (empty? coll)
       []
       (loop [coll (concat coll (list (gensym))),
              tem (list 1 (gensym))
              acc [] ]
         (let [[car & cdr] coll, [cnt item] tem]
           (cond (empty? coll)
                 (rest (reverse acc))
                 ;; 
                 (= car item)
                 (recur cdr (list (+ 1 cnt) car) acc)
                 ;; 
                 :else
                 (recur cdr 
                        (list 1 car)
                        (cons (if (= 1 cnt)
                                item
                                tem)
                              acc))))))))

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

Posted 2008-09-29 02:54:00 GMT

repeatという、アイテムの繰り返しの遅延リストを作れるので、こういうのは割と簡潔に書けます。

(defn
  #^{:doc "P12 (**) Decode a run-length encoded list."
     :test (do (test= (decode []) [])
               (test= (decode '((4 a) b (2 c) (2 a) d (4 e)))
                      '(a a a a b c c a a d e e e e))) }
; ------
  decode
; ------
  ([coll]
     (if (empty? coll)
       []
       (mapcat #(if-let [n item] (and (list? %) %)
                  (take n (repeat item))
                  (list %))
               coll))))

clojureでL-99 (P11 ランレングス圧縮 その2)

Posted 2008-09-28 05:37:00 GMT

書くのを忘れてましたが、defnに:testを付けると定義した時点で:testの部分が実行されます。
ということで、適切なテストケースを付ければ、きっと便利だと思います。
ただ単にassertだけを書いたテストケースでは、最初に定義した時点で意図通り動かない場合、逆にいらっと来るかもしれません(笑)
また、lengthがないのはなんでだろうと思っていましたが、countという名前で存在していたことを発見。
うーん、確かにcountという名前も妥当ではありますが…。
length、len、size、count等、同じ機能でも方言によって色んな名前がありますね。

(defn
  #^{:doc "P11 (*) Modified run-length encoding."
     :test (do (test= (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)))
               (test= (encode-modified []) [])
               (test= (encode-modified [1]) [1]))}
; ---------------
  encode-modified
; ---------------
  ([coll]
     (if (empty? coll)
       []
       (map #(if (single? %)
               (first %)
               (list (count %) (first %)))
            (pack coll)))))

(defn single? [coll] (nil? (rest coll)))

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

Posted 2008-09-27 05:25:00 GMT

clojureでは、lambdaは、Arcのようにfn(ファンと作者は読んでいた)と書けるので楽で良いです。
また、リーダーマクロによる更なる略記法もあって、#()でArcの[]のようなことができます。
引数は、UNIXのシェルのように%1、%2、%3...と番号で参照できます。さらに良く使う%1は、%だけでも良し。

(defn
  #^{:doc "P10 (*) Run-length encoding of a list."
     :test (do (test= (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)))
               (test= (encode []) [])) }
; ------
  encode
; ------
  ([coll]
     (if (empty? coll)
       []
       (map #(list (length %) (first %))
            (pack coll)))))

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

Posted 2008-09-25 22:40:00 GMT

なんとなくコメントも付けてみました。どうやら、キーと値のペアなら何でも格納できるようなので、色々活用できるのかもしれません。

(defn
  #^{:doc "P09 (**) Pack consecutive duplicates of list elements into sublists.
If a list contains repeated elements they should be placed in separate sublists."
     :test (do (test= (pack []) [[]])
               (test= (pack [1]) [[1]])
               (test= (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))))
     :comment "(pack []) => []とすべきか、(pack []) => [[]]とすべきか…"}
; ----
  pack
; ----
  [coll]
  (loop [coll coll, tem [], acc [] ]
    (let [[car & cdr] coll]
      (cond (empty? coll) 
            (reverse (cons tem acc))
            ;;
            (or (= car (first tem)) (empty? tem))
            (recur cdr (cons car tem) acc)
            ;;
            :else
            (recur cdr (list car) (cons tem acc))))))

(:comment ^#'pack) ;=> "(pack []) => []とすべきか、(pack []) => [[]]とすべきか…"

clojureでL-99 (P08 リストの圧縮)

Posted 2008-09-24 19:55:00 GMT

今回は、letのリストの分割束縛機能を無理矢理気味に使ってみました。テストのところもなんとなくマクロに。

(defn 
#^{:doc "P08 (**) Eliminate consecutive duplicates of list elements."
:test (test= (compress '(a a a a b c c a a d e e e e))
'(a b c a d e))}
; --------
compress [coll]
; --------
(loop [coll coll, acc `[~(gensym)] ]
(let [[head & tail] coll]
(cond
(empty? coll)
(rest (reverse acc))
;;
(= head (first acc))
(recur tail acc)
;;
:else
(recur tail (cons head acc))))))

(defmacro test= [expr val]
`(do (assert (= ~expr ~val))))
clojureでは、,(コンマ)ではなく、~でクオート解除になります。コンマは空白として扱われるので、変数束縛の部分等でみやすく清書するために使えます。
また、clojureはLISP-1ということもあり、古典的なマクロでは、展開先で内部で使用している関数(マクロ)が書き換えられてしまう問題が心配されますが、これは回避してくれるとのこと。CLのように名前空間も分かれているので(CLのパッケージ的)この点でもScheme+古典的マクロより安全そうです。
(let [= list]
  (= 3 3))
;=> (3 3)

(defmacro foo [x] `(= ~x ~x))

(let [= list] (foo 3)) ;=> true ; 意図した通りの動作

;; scheme (Gauche等) (define-macro (foo x) `(= ,x ,x))

(let ((= list)) (foo 3)) ;=> (3 3) ; 書き換えられてしまいました。


clojureでL-99 (P07 リストの平坦化)

Posted 2008-09-24 00:09:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、テストも付けてみることにしました。
ちょっと探したところでは、解説がみつけられなかったのですが、defnの定義のときに、#^{}という形式で、色々な属性が定義できます。
そして、定義されたものに、逆の符号^#を付ければ、属性のテーブルが呼び出せるようです。
属性のテーブルは、キーワードと値の対になっていて、キーワードは、clojureの場合、テーブルから値を取得する関数のような動きをするので、ドキュメントならば、

(:doc ^#'flatten)
でflattenのドキュメントが取得できるという具合です。
同じく:testはテスト用の関数を取得でき、
(:test ^#'flatten)
で書いたテストを実行することができます。
なかなか便利なのですが、しかし、色々盛り込むと、関数定義がごちゃごちゃするのが、ちょっと…。
(defn  
  #^{:doc "P07 (**) Flatten a nested list structure."
     :test (assert (and (= (flatten '(1((2)(()3(()()4(((("56")))))))))
                           '(1 2 3 4 "56"))
                        (= (flatten [])
                           [])))}
; -------
  flatten 
; -------
  ([coll]
     (cond (empty? coll) []
           (coll? (first coll))
           (concat (flatten (first coll))
                   (flatten (rest coll)))
           :else (cons (first coll)
                       (flatten (rest coll))))))

clojureでL-99 (P06 回文の判定)

Posted 2008-09-22 11:34:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
CLのような順番でドキュメントを付けることもできるようです。ただこの場合、ボディ部を括弧で囲まないと上手くSLIMEのドキュメント表示にひっかかってこないという謎。
ちなみに、clojureは引数/ボディの書き方が複数あるようですが、どれが標準なんだろうという…。

(defn palindrome? 
  "P06 (*) Find out whether a list is a palindrome.
A palindrome can be read forward or backward; e.g. (x a m a x)."
  ([coll]
     (= (seq coll) (reverse coll))))

(palindrome? "たけやぶ") ;=> false (palindrome? "たけやぶやけた") ;=> true (palindrome? '[x a m a x]) ;=> true


clojureでL-99 (P03 K番目の要素)

Posted 2008-09-21 12:35:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)

;; P03 (*) Find the K'th element of a list.

(defn element-at [coll pos] (loop [coll coll, pos pos] (if (>= 1 pos) (first coll) (recur (rest coll) (- pos 1)))))

(element-at "いろはにほ" 3)

;=> \は


clojureでL-99 (P04 リストの長さ)

Posted 2008-09-21 12:35:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
lengthが標準ではないようなのですが、もしかすると無限リストの存在と関係があったりするんでしょうか。

;;P04 (*) Find the number of elements of a list.

(defn length [coll] (loop [coll coll, acc 0] (if (empty? coll) acc (recur (rest coll) (+ 1 acc)))))

(length "いろはにほ") ;=> 5 ;; これでは無限リストじゃ止まらない。


clojureでL-99 (P05 コレクションの逆転)

Posted 2008-09-21 12:35:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
ドキュメントを付けてみました。他にユーザコメントとテストが付けられるようです。

;; P05 (*) Reverse a list.
(defn 
  #^{:doc "P05 (*) Reverse a list."}
  rev [coll]
  (let [str? (string? coll)]
    (loop [coll coll, acc []]
      (if (empty? coll)
        (if str?
          (apply str acc)
          acc)
        (recur (rest coll) (cons (first coll) acc))))))

(rev "foooo") ;=> "oooof" (rev '[f o o o]) ;=> (o o o f)


clojureでL-99 (P2 最後2つのペアを返す)

Posted 2008-09-18 14:55:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今日もclojureでL-99。小さいコードをいじってると心が休まります(´▽`*)
clojureでは、()とnilは別物で、()はempty?で検査できます。
また、(rest ())はエラーではなくて、nilが返ります。
ブール値は、trueとfalseなので、別にnilがある、ということなんですね。これはこれで便利かも。

;; P02 (*) Find the last but one box of a list.

(apply str (last-2 "こんにちは")) ;=> "ちは"

(defn last-2 [col] (loop [col col] (if (nil? (rrest col)) col (recur (rest col)))))

-CLや、Schemeと違うところ
(nil? ())
;=> false

(nil? nil) ;=> true

(rest ()) ;=> nil

clojureでL-99 (P1 最後のペアを返す)

Posted 2008-09-17 14:58:00 GMT

最近どうも鬱々として不調なのですが、なんでだろうと内省したところ、これはどうもL-99をやってないからじゃないかという結論に達しました。
ということで、今日からリハビリの為に、clojureでL-99を開始しようかと。
いい加減 問50以降も挑戦しないととは思いますが、P1からで…。
さっと眺めただけでも、clojureには色々面白そうな特徴があるようです。これは面白そう。
(defn my-last [col]
  (if (empty? (rest col))
    col
    (my-last (rest col))))

;; 動作例 (my-last '(1 2 3 4)) ;=> (4) (my-last [1 2 3 4]) ;=> (4) (my-last "1234") ;=> (\4)

;; デフォルトだと末尾再帰の最適化はしてくれないそうなので、 ;; 用意された構文で書く必要があるらしい。 (defn my-last [col] (loop [col col] (if (empty? (rest col)) col (recur (rest col))))) ;; とか

面白いとおもったところ

cadr、cadddrに似た合成された関数名

first + rest => frest つまり、second
(frest [1 2 3 4])
(frest [1 2 3 4])
;=> 2
(rrest [1 2 3 4])
;=> (3 4)

文字列もリストみたいに扱える

(apply str (rrest "お前誰?"))
;=> "誰?"

;; repeatは無限リストを生成し、takeで最初の10個を ;; 取得、つまり遅延リスト (apply str \う \は (take 10 (repeat \w))) ;=> "うはwwwwwwwwww"

seriesでL-99 (P07 リストの平坦化)

Posted 2008-07-15 06:56:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
この前のエントリでは、ややこしく書いてしまいましたが、マニュアルを読んでいたら、ツリーを走査する専用の関数がありました。

(flatten '(1 2 3 (4 5  (6 (7 (8 (9 (((10(11(((((()))))))))))))))12))
;=> (1 2 3 4 5 6 7 8 9 10 11 12)

(defun flatten (list) (collect (choose (scan-lists-of-lists-fringe list))))


サンプルコードによるseries入門 (番外編)

Posted 2008-07-12 07:22:00 GMT

LOOP、ITERATEと来たので、seriesでもやらないではいられません…。

インストール

(asdf-install:install :series)
一発です。

使ってみる

これもなんとなくL-99を25問目まで解いてみました。
なんとなく、iterate、mappingで、繰り返し的に、scan-fnで末尾再帰的な感覚で書ける気がしてきました。
それにつけても、seriesで書かれたソースがあまり出回ってないので、定石な書法がいまいち分からないんですよね…。
(defpackage :l99-series
  (:use :cl :series))

(in-package :l99-series)

;; P01 (defun last-pair (list) (collect-last (scan-fn 't (lambda () list) #'cdr #'atom)))

(last-pair '(1 2 3 4)) ;=> (4)

(last-pair '(1 2 3 . 4)) ;=> (3 . 4)

;; P02 (defun last-2-pair (list) (collect-last (scan-fn 't (lambda () list) #'cdr (lambda (x) (atom (cdr x))))))

(last-2-pair '(1 2 3 4)) ;=> (3 4)

(last-2-pair '(1 2 3 . 4)) ;=> (2 3 . 4)

;; P03 (defun element-at (list position) (first (collect-last (scan-fn-inclusive '(values list integer) (lambda () (values list 0)) (lambda (l cnt) (values (cdr l) (1+ cnt))) (lambda (l cnt) (or (null l) (>= cnt (1- position))))))))

(element-at '(a b c d e) 3) ;=> C (element-at '(a b c d e) 13) ;=> NIL

;; P04 ;; 1 (defun len (list) (let ((cnt 0)) (iterate ((i (scan list))) (incf cnt)) cnt))

;; 2 (defun len (list) (collect-last (scan-fn-inclusive '(values integer t) (lambda () (values 0 list)) (lambda (cnt lst) (values (1+ cnt) (cdr lst))) (lambda (cnt lst) (declare (ignore cnt)) (null lst)))))

(len (loop :repeat 5 :collect t)) ;=> 5

;; P05 (defun rev (list) (collect-last (scan-fn-inclusive '(values list list) (lambda () (values () list)) (lambda (ans list) (values (cons (car list) ans) (cdr list))) (lambda (ans list) (declare (ignore ans)) (null list)))))

(rev '(1 2 3 4)) ;=> (4 3 2 1)

;; P06 (defun palindrome-p (list) (iterate ((org (scan list)) (rev (scan (reverse list)))) (unless (equal org rev) (return-from palindrome-p nil))) 'T)

(palindrome-p '(1 2 3 2 1)) ;=> T

;; P07 ;; 1. 普通にの繰り返しと再帰 (defun flatten (list) (collect-append (mapping ((x (scan list ))) (if (listp x) (flatten x) (list x)))))

;; 2. gatheringで要素を投げる系 (defun flatten (list) (gathering ((ans collect)) (labels ((f (list gatherer) (iterate ((x (scan list))) (if (listp x) (f x gatherer) (next-out gatherer x))))) (f list ans))))

;; 3. 普通にの繰り返しと再帰 その2 (defun flatten (list) (collect-last (scan-fn-inclusive '(values list list) (lambda () (values () list )) (lambda (acc list) (values (append acc (if (listp (car list)) (flatten (car list)) (list (car list)))) (cdr list))) (lambda (acc list) (declare (ignore acc)) (endp list)))))

(flatten '(1 2 3 (4 5 (6 (7 (8 (9 (((10(11(((((()))))))))))))))12)) ;=> (1 2 3 4 5 6 7 8 9 10 11 12)

;; P08 (defun compress (list) (gathering((ans collect)) (iterate ((prev (previous (scan list) (gensym) 1)) (cur (scan list))) (unless (equal prev cur) (next-out ans cur)))))

(compress '(a a a a b c c a a d e e e e e)) ;=> (A B C A D E)

;; P09 (defun pack (list) (gathering ((ans collect)) (let ((list (nconc (copy-list list) (list (gensym)))) tem) (iterate ((x (scan list)) (prev (previous (scan list) (gensym) 1))) (unless (or (equal prev x) (null tem)) (next-out ans tem) (setq tem () )) (push x tem)))))

(pack '(a a a a b c c a a d e e e e e)) ;=> ((A A A A) (B) (C C) (A A) (D) (E E E E E))

;; P10 (defun encode (list) (collect (mapping ((x (scan (pack list)))) `(,(length x) ,(car x)))))

(encode '(a a a a b c c a a d e e e e e)) ;=> ((4 A) (1 B) (2 C) (2 A) (1 D) (5 E))

;; P11 (defun single (list) (and (consp list) (null (cdr list))))

(defun encode-modified (list) (collect (mapping ((x (scan (pack list)))) (if (single x) (car x) `(,(length x) ,(car x))))))

(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))

;; P12 (defun decode (list) (collect-nconc (mapping ((x (scan list))) (if (atom x) (list x) (make-list (first x) :initial-element (second x))))))

(decode '((4 A) B (2 C) (2 A) D (4 E))) ;=> (A A A A B C C A A D E E E E)

;; P13 ;; gdgd (defun encode-direct (list) (let ((cnt 0) (prev (gensym)) flag) (gathering ((ans collect)) (iterate ((x (scan (nconc (copy-list list) (list (gensym)))))) (if (or (equal prev x) (not flag)) (incf cnt) (progn (next-out ans (list cnt prev)) (setq cnt 1))) (setq prev x flag 'T)))))

(encode-direct '(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))

;; P14 (defun dupli (list) (collect-nconc (mapping ((x (scan list))) (list x x))))

(dupli '(a b c c d)) ;=> (A A B B C C C C D D)

;; P15 (defun repli (list times) (collect-nconc (mapping ((x (scan list))) (make-list times :initial-element x))))

(repli '(a b c c d) 3) ;=> (A A A B B B C C C C C C D D D)

;; P16 (defun drop (list n) (gathering ((ans collect)) (iterate ((x (scan list)) (pos (scan-range :from 1))) (unless (zerop (mod pos n)) (next-out ans x)))))

(drop '(1 2 3 4 5 6 7 8 9 10) 3) ;=> (1 2 4 5 7 8 10)

;; P17 (defun split (list n) (let ((front (gatherer #'collect))) (iterate ((tail (scan-sublists list)) (pos (scan-range :from 1))) (if (<= pos n) (next-out front (car tail)) (return-from split (list (result-of front) tail))))))

(split '(a b c d e f g h i k) 3) ;=> ((A B C) (D E F G H I K))

;; P18 (defun slice (list start end) (gathering ((ans collect)) (iterate ((x (scan list)) (pos (scan-range :from 1))) (when (<= start pos end) (next-out ans x)))))

(slice '(a b c d e f g h i k) 3 7) ;=> (C D E F G)

;; P19 (defun rotate (list n) (let ((front (gatherer #'collect)) (n (mod n (length list)))) (iterate ((tail (scan-sublists list)) (pos (scan-range :from 1))) (if (<= pos n) (next-out front (car tail)) (return-from rotate (append tail (result-of front)))))))

(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)

;; P20 (defun remove-at (list n) (gathering ((ans collect)) (iterate ((x (scan list)) (pos (scan-range :from 1))) (unless (= pos n) (next-out ans x)))))

(remove-at '(1 2 3 4 5 6) 4) ;=> (1 2 3 5 6)

;; P21 (defun insert-at (item list n) (gathering ((ans collect)) (iterate ((x (scan list)) (pos (scan-range :from 1))) (when (= pos n) (next-out ans item)) (next-out ans x))))

(insert-at 'alfa '(a b c d) 2) ;=> (A ALFA B C D)

;; P22 (defun range (start end) (collect (scan-range :from start :upto end)))

(range 4 9) ;=> (4 5 6 7 8 9)

;; P23 (defun rnd-pop (list) (if (null list) () (let ((n (1+ (random (length list))))) (gathering ((ans collect) (rem collect)) (iterate ((x (scan list)) (pos (scan-range :from 1))) (next-out (if (= pos n) rem ans) x))))))

(defun rnd-select (list n) (collect-nth (1- n) (nth-value 1 (scan-fn '(values t t) (lambda () (rnd-pop list)) (lambda (x ans) (multiple-value-bind (a b) (rnd-pop x) (values a (append b ans))))))))

(rnd-select '(a b c d e f g h) 3) ;=> (D A B)

;; P24 (defun lotto-select (n range) (rnd-select (range 1 range) n))

(lotto-select 6 50) ;=> (8 3 45 43 5 34)

;; P25 (defun rnd-permu (list) (rnd-select list (length list)))

(rnd-permu '(a b c d e f)) ;=> (C B A E F D)


サンプルコードによるITERATEマクロ入門 (番外編)

Posted 2008-07-11 04:50:00 GMT

LOOPマクロも一段落ついた気がするので、LOOPマクロのように繰り返し処理をを便利にするマクロであるITERATEを紹介してみることにしました。

インストール

(asdf-install:install :iterate)
一発です。

良いなと思ったところ

+LOOPマクロを知っていれば、ちょっとマニュアルを読むくらいで書けるようになる。
+外の世界の(通常のCLの)制御構文が使える。

不便だなと思ったところ

+ループ変数を並列に束縛できない。DOマクロで言えば、DO*しかない。回避するための仕組みもあるようですが、それを使ってもいまいち挙動が把握できない気がします。

使ってみる

どんなものか自分でもあまり良く分かっていないので、なんとなくL-99を25問目まで解いてみました。
(defpackage :l99-iter (:use :cl :iterate))
(in-package :l99-iter)

;; P01 (defun last-pair (list) (iter (for x :on list) (when (atom (cdr x)) (return x))))

(last-pair '(1 2 3 4)) ;=> (4)

(last-pair '(1 2 3 . 4)) ;=> (3 . 4)

;; P02 (defun last-2-pair (list) (iter (for x :on list) (when (atom (cddr x)) (return x))))

(last-2-pair '(1 2 3 4)) ;=> (3 4)

(last-2-pair '(1 2 3 . 4)) ;=> (2 3 . 4)

;; P03 (defun element-at (list position) (iter (for p :from 1) (for x :in list) (when (= position p) (return x))))

(element-at '(a b c d e) 13) ;=> NIL

(element-at '(a b c d e) 3) ;=> C

;; P04 (defun len (list) (iter (for x :in list) (count 'T)))

(len '(1 2 3 4)) ;=> 4

;; P05 (defun rev (list) (iter (for tem :initially () :then a) (for a :initially (copy-list list) :then (prog1 (cdr a) (rplacd a b))) (for b :initially () :then tem) (when (null a) (return b))))

(rev '(1 2 3 4)) ;=> (4 3 2 1)

;; P06 (defun palindrome-p (list) (iter (for nom :in list) (for rev :in (reverse list)) (always (equal nom rev))))

(palindrome-p '(1 2 3 2 1)) ;=> T

;; P07 (defun flatten (list) (iter (for x :in list) (if (listp x) (appending (flatten x)) (collect x))))

(flatten '(1 2 3 (4 5 (6 (7 (8 (9 (((10((((((())))))))))))))))) ;=> (1 2 3 4 5 6 7 8 9 10)

;; P08 (defun compress (list) (iter (for x :in list) (for prev :initially (gensym) :then x) (unless (equal prev x) (collect x))))

(compress '(a a a a b c c a a d e e e e)) ;=> (A B C A D E)

;; P09 (defun pack (list) (iter (for x :in (nconc (copy-list list) (list (gensym)))) (for prev :initially (gensym) :then x) (for tem :initially () :then (cons x tem)) (unless (or (equal prev x) (null tem)) (collect tem) (setq tem ()))))

(pack '(a a a a b c c a a d e e e e e)) ;=> ((A A A A) (B) (C C) (A A) (D) (E E E E E))

;; P10 (defun encode (list) (iter (for x :in (pack list)) (collect `(,(length x) ,(car x)))))

(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))

;; P11 (defun encode-modified (list) (iter (for x :in (pack list)) (collect (if (= 1 (length x)) (car x) `(,(length x) ,(car x))))))

(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))

;; P12 (defun decode (list) (iter (for x :in list) (if (atom x) (collect x) (appending (make-list (first x) :initial-element (second x))))))

(decode '((4 A) B (2 C) (2 A) D (4 E))) ;=> (A A A A B C C A A D E E E E)

;; P13 (defun encode-direct (list) (iter (for x :in (nconc (copy-list list) (list (gensym)))) (for prev :initially (gensym) :then x) (for tem :initially () :then (cons x tem)) (for cnt :initially 0 :then (1+ cnt)) (unless (or (equal prev x) (null tem)) (collect (if (= 1 cnt) prev (list cnt prev))) (setq tem () cnt 0))))

(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))

;; P14 (*) Duplicate the elements of a list. (defun dupli (list) (iter (for x :in list) (nconcing (list x x))))

(dupli '(a b c c d)) ;=> (A A B B C C C C D D)

;; P15 (defun repli (list times) (iter (for x :in list) (nconcing (iter (repeat times) (collect x)))))

(repli '(a b c) 3) ;=> (A A A B B B C C C)

;; P16 (defun drop (list n) (iter (for x :in list) (for pos :from 1) (unless (zerop (mod pos n)) (collect x))))

(drop '(a b c d e f g h i k) 3) ;=> (A B D E G H K)

;; P17 (defun split (list n) (iter (for x :on list) (for pos :from 1) (if (> pos n) (return (list tem x)) (collect (car x) :into tem)) (finally (return (list list () )))))

(split '(a b c d e f g h i k) 3) ;=> ((A B C) (D E F G H I K))

;; P18 (defun slice (list start end) (iter (for x :in list) (for pos :from 1) (when (<= start pos end) (collect x :into res)) (finally (return res))))

(slice '(a b c d e f g h i k) 3 7) ;=> (C D E F G)

;; P19 (defun rotate (list n) (iter (with n := (mod n (length list))) (for x :on list) (for pos :from 1) (if (> pos n) (return (append x tem)) (collect (car x) :into tem)) (finally (return list))))

(rotate '(a b c d e f g h) 3) ;=> (D E F G H A B C)

;; P20 (defun remove-at (list n) (iter (for x :in list) (for pos :from 1) (unless (= pos n) (collect x))))

(remove-at '(a b c d) 2) ;=> (A C D)

;; P21 (defun insert-at (item list n) (iter (for x :in list) (for pos :from 1) (if (= pos n) (appending (list item x)) (collect x))))

(insert-at 'alfa '(a b c d) 2) ;=> (A ALFA B C D)

;; P22 (defun range (start end) (iter (for i :from start :to end) (collect i)))

(range 4 9) ;=> (4 5 6 7 8 9)

;; P23 (defun remove-at (list n) "取り除く要素/残りの多値を返すバージョン" (iter (for x :in list) (for pos :from 1) (if (/= pos n) (collect x :into res) (collect x :into item)) (finally (return (values res item)))))

(remove-at '(1 2 3 4) 4) ;=> (1 2 3),(4)

(defun rnd-select (list n) (flet ((choose (lst) (if (null lst) () (multiple-value-list (remove-at lst (1+ (random (length lst)))))))) (iter (repeat (min n (length list))) (for (tem x) :initially (choose list) :then (choose tem)) (appending x))))

(rnd-select '(a b c d e f g h) 8) ;=> (H E G F D B C)

;; P24 (defun lotto-select (n range) (rnd-select (range 1 range) n))

(lotto-select 6 49) ;=> (14 37 4 8 9 46)

;; P25 (defun rnd-permu (list) (rnd-select list (length list)))

(rnd-permu '(a b c d e f)) ;=> (A C B F D E)


サンプルコードによるLOOPマクロ入門 (番外編 L-99)

Posted 2008-07-06 06:25:00 GMT

機能を順に紹介して行くのも良いのですが、実際に手を動かしてみるのも良いだろうということで、意味なくL-99のP25まで、無理にLOOPを使って解いてみました。

「できるだけLOOPマクロ内で完結させる」ということをテーマに書いてみました。
自分はLOOPマクロは苦手でしたが、それでも200行位LOOPばっかり書けば、いい加減馴れて来るようです…。
;; P01
(defun last-pair (list)
  (loop :for x :on list :when (atom (cdr x)) :return x))

(last-pair '(1 2 3 4)) ;=> (4)

(last-pair '(1 2 3 . 4)) ;=> (3 . 4)

;; P02 (defun last-2-pair (list) (loop :for x :on list :when (atom (cddr x)) :return x))

(last-2-pair '(1 2 3 4)) ;=> (3 4)

(last-2-pair '(1 2 3 . 4)) ;=> (2 3 . 4)

;; P03 (defun element-at (list position) (loop :for p := 1 :then (1+ p) :for x :in list :when (= position p) :return x))

(element-at '(a b c d e) 13) ;=> NIL

(element-at '(a b c d e) 3) ;=> C

;; P04 (defun len (list) (loop :for x :in list :count 'T))

(len '(1 2 3 4)) ;=> 4

;; P05 (defun rev (list) (loop :for a := (copy-list list) :then (prog1 (cdr a) (rplacd a b)) :and b := () :then a :when (null a) :return b))

(rev '(1 2 3 4)) ;=> (4 3 2 1)

;; P06 (defun palindrome-p (list) (loop :for nom :in list :and rev :in (reverse list) :always (equal nom rev)))

(palindrome-p '(1 2 3 2 1)) ;=> T

;; P07 (defun flatten (list) (loop :for x :in list :if (listp x) :append (flatten x) :else :collect x))

(flatten '(1 2 3 (4 5 (6 (7 (8 (9 (((10((((((())))))))))))))))) ;=> (1 2 3 4 5 6 7 8 9 10)

;; P08 (defun compress (list) (loop :for x :in list :and prev := (gensym) :then x :unless (equal prev x) :collect x))

(compress '(a a a a b c c a a d e e e e)) ;=> (A B C A D E)

;; P09 (defun pack (list) (loop :for x :in (nconc (copy-list list) (list (gensym))) :and prev := (gensym) :then x :and tem := () :then (cons x tem) :unless (or (equal prev x) (null tem)) :collect tem :and :do (setq tem () ) :end))

(pack '(a a a a b c c a a d e e e e e)) ;=> ((A A A A) (B) (C C) (A A) (D) (E E E E E))

;; P10 (defun encode (list) (loop :for x :in (pack list) :collect `(,(length x) ,(car x))))

(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))

;; P11 (defun encode-modified (list) (loop :for x :in (pack list) :when (= 1 (length x)) :collect (car x) :else :collect `(,(length x) ,(car x))))

(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))

;; P12 (defun decode (list) (loop :for x :in list :when (atom x) :collect x :else :append (make-list (first x) :initial-element (second x))))

(decode '((4 A) B (2 C) (2 A) D (4 E))) ;=> (A A A A B C C A A D E E E E)

;; P13 (defun encode-direct (list) (loop :for x :in (nconc (copy-list list) (list (gensym))) :and prev := (gensym) :then x :and tem := () :then (cons x tem) :and cnt := 0 :then (1+ cnt) :unless (or (equal prev x) (null tem)) :when (= 1 cnt) :collect prev :else :collect (list cnt prev) :end :and :do (setq tem () cnt 0) :end))

(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))

;; P14 (*) Duplicate the elements of a list. (defun dupli (list) (loop :for x :in list :nconc (list x x)))

(dupli '(a b c c d)) ;=> (A A B B C C C C D D)

;; P15 (defun repli (list times) (loop :for x :in list :nconc (loop :repeat times :collect x)))

(repli '(a b c) 3) ;=> (A A A B B B C C C)

;; P16 (defun drop (list n) (loop :for x :in list :and pos :from 1 :unless (zerop (mod pos n)) :collect x))

(drop '(a b c d e f g h i k) 3) ;=> (A B D E G H K)

;; P17 (defun split (list n) (loop :for x :on list :for pos :from 1 :when (> pos n) :do (return-from split (list tem x)) :else :collect (car x) :into tem) :end :finally (return-from split (list list () )))

(split '(a b c d e f g h i k) 3) ;=> ((A B C) (D E F G H I K))

;; P18 (defun slice (list start end) (loop :for x :in list :for pos :from 1 :when (<= start pos end) :collect x :into res :finally (return res)))

(slice '(a b c d e f g h i k) 3 7) ;=> (C D E F G)

;; P19 (defun rotate (list n) (loop :with n := (mod n (length list)) :for x :on list :for pos :from 1 :when (> pos n) :do (return-from rotate (append x tem)) :else :collect (car x) :into tem) :end :finally (return-from rotate list))

(rotate '(a b c d e f g h) 3) ;=> (D E F G H A B C)

;; P20 (defun remove-at (list n) (loop :for x :in list :and pos :from 1 :unless (= pos n) :collect x))

(remove-at '(a b c d) 2) ;=> (A C D)

;; P21 (defun insert-at (item list n) (loop :for x :in list :and pos :from 1 :when (= pos n) :append (list item x) :else :collect x))

(insert-at 'alfa '(a b c d) 2) ;=> (A ALFA B C D)

;; P22 (defun range (start end) (loop :for i :from start :to end :collect i))

(range 4 9) ;=> (4 5 6 7 8 9)

;; P23 (defun remove-at (list n) "取り除く要素/残りの多値を返すバージョン" (loop :for x :in list :and pos :from 1 :unless (= pos n) :collect x :into res :else :collect x :into item :finally (return-from remove-at (values res item))))

(remove-at '(1 2 3 4) 4) ;=> (1 2 3),(4)

(defun rnd-select (list n) (flet ((choose (lst) (multiple-value-list (remove-at lst (1+ (random (length lst))))))) (loop :for i :from 1 :to (min n (length list)) :for (tem x) := (choose list) :then (choose tem) :append x)))

(rnd-select '(a b c d e f g h) 7) ;=> (H E G F D B C)

;; P24 (defun lotto-select (n range) (rnd-select (range 1 range) n))

(lotto-select 6 49) ;=> (14 37 4 8 9 46)

;; P25 (defun rnd-permu (list) (rnd-select list (length list)))

(rnd-permu '(a b c d e f)) ;=> (A C B F D E)


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

Posted 2008-06-24 07:14:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
なんとなく無理矢理な感じですが、折角の遅延評価なので使ってみました。

(decode '((4 A) B (2 C) (2 A) D (4 E)))
;==> [A A A A B C C A A D E E E E]

(define (decode lst) (if (null lst) () (let ((head (hd lst))) (++ (if (atom head) [head] (take (hd head) (item-list (hd (tl head))))) (decode (tl lst))))))

(define (item-list item) (cons item (item-list item)))


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

Posted 2008-06-18 08:39:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
以前に定義した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)))


dylanでL-99 (P11 ランレングス圧縮 その2)

Posted 2008-06-17 07:18:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
CLのsubseqに相当するものがないか探したのですが見付からず。それらしきものの実装では、copy-sequenceして切り出していたので真似してみました。これで良いのでしょうか…。
また、良く考えると、文字列の圧縮表現は変かなあと思いはじめました(;´Д`)普通にリストにした方が良いかも。

format-out("%=\n",
           #(a:, a:, a:, a:, b:, c:, c:, a:, a:, d:, e:, e:, e:, e:).encode-modified);
//=> #(#(4, #"a"), #"b", #(2, #"c"), #(2, #"a"), #"d", #(4, #"e"))

format-out("%=\n", #[a:, a:, a:, a:, b:, c:, c:, a:, a:, d:, e:, e:, e:, e:].encode-modified); //=> #[#(4, #"a"), #"b", #(2, #"c"), #(2, #"a"), #"d", #(4, #"e")]

format-out("%=\n", "aaaabccaadeeee".encode-modified); //=> "4a;b;2c;2a;d;4e"

// Code: define generic single? (sequence :: <sequence>) => (result :: <boolean>);

define method single? (sequence :: <sequence>) => (result :: <boolean>) ~sequence.empty? & copy-sequence(sequence, start: 1).empty? end method single?;

define generic encode-modified (sequence :: <sequence>) => (result :: <sequence>);

define method encode-modified (sequence :: <list>) => (result :: <list>) as(<list>, next-method()) end method encode-modified;

define method encode-modified (sequence :: <vector>) => (result :: <vector>) as(<vector>, next-method()) end method encode-modified;

define method encode-modified (sequence :: <string>) => (result :: <string>) join(map(method(x) if (x.single?) x else format-to-string("%d%s", x.size, x.first) end if end, sequence.pack1), ";") end method encode-modified;

define method encode-modified (sequence :: <sequence>) => (result :: <sequence>) map(method(x) if (x.single?) x.first else list(x.size, x.first) end if end, sequence.pack1) end method encode-modified;

pfcでL-99 (P11 ランレングス圧縮 その2)

Posted 2008-06-16 09:08:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
ポール・グレアムで有名なsingleを定義して使ってみました。

(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]]

(define (single? lst) (and [(consp lst) (null (tl lst))]))

(define (encode-modified lst) (map (lambda (x) (if (single? x) (hd x) [(length x) (hd x)])) (pack lst)))

closでL-99 (P26 指定した個数を抜き出す組み合わせ)

Posted 2008-06-13 09:14:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
call-next-methodの連鎖で行くと、stringの次は、vectorになってしまって面倒臭いので、combination1という共通の補助メソッドを作成して呼んでいるわけなのですが、一番特定度の低いメソッドを呼び出す定番の方法があったりするんでしょうか?
再帰と、call-next-methodと、ディスパッチが混ざると、大分スパゲッティな感じです…。
再帰の度にlengthが呼ばれるのもどうしたものかと…。

(combination 3 '(a b c d e f))
;==> ((A B C) (A B D) (A B E) (A B F) ...

(combination 3 #(a b c d e f)) ;==> (#(A B C) #(A B D) #(A B E) #(A B F) ...

(combination 3 "abcdef") ;==> ("abc" "abd" "abe" "abf" "acd" "ace" "acf" ...

(defgeneric COMBINATION (n sequence) (:documentation "P26 (**) Generate the combinations of K distinct objects chosen from the N elements of a list"))

(defmethod COMBINATION :around ((n integer) (sequence sequence)) (if (not (<= 1 n (length sequence))) () (call-next-method)))

(defmethod COMBINATION ((n integer) (sequence string)) (combination1 n sequence 'string)) (defmethod COMBINATION ((n (eql 1)) (sequence string)) (map 'list #'string sequence))

(defmethod COMBINATION ((n integer) (sequence vector)) (combination1 n sequence 'vector)) (defmethod COMBINATION ((n (eql 1)) (sequence vector)) (map 'list #'vector sequence))

(defmethod COMBINATION ((n integer) (sequence list)) (combination1 n sequence 'list)) (defmethod COMBINATION ((n (eql 1)) (sequence list)) (map 'list #'list sequence))

(defmethod COMBINATION1 ((n integer) (sequence sequence) type) `(,@(mapcar (lambda (i) (concatenate type (subseq sequence 0 1) i)) (COMBINATION (1- n) (subseq sequence 1))) ,@(COMBINATION n (subseq sequence 1))))


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

Posted 2008-06-12 08:07:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
前回定義した、packの補助関数のpack1とjoinを使っています。
dylanのライブラリの取り込み方と定義方法が良く分からない…。

#(a:, a:, a:, a:, b:, c:, c:, a:, a:, d:, e:, e:, e:, e:).encode
//=> #(#(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:].encode //=> #[#(4, a:), #(1, b:), #(2, c:), #(2, a:), #(1, d:), #(4, e:)]

"aaaabccaadeeee".encode //=> "4a;1b;2c;2a;1d;4e"

// Code: define generic encode (sequence :: <sequence>) => (result :: <sequence>);

define method encode (sequence :: <list>) => (result :: <list>) as(<list>,next-method()) end method encode;

define method encode (sequence :: <vector>) => (result :: <vector>) as(<vector>,next-method()) end method encode;

define method encode (sequence :: <string>) => (result :: <string>) join(map(method(x) format-to-string("%d%s", x.size, x.first) end, sequence.pack1), ";") end method encode;

define method encode (sequence :: <sequence>) => (result :: <sequence>) map(method(x) list(x.size, x.first) end, sequence.pack1) end method encode;


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

Posted 2008-06-12 06:58:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
これもまた普通のLISP/Schemeみたいになってしまいました…。

(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]]

(define (encode lst) (map (lambda (x) [(length x) (hd x)]) (pack lst)))

closでL-99 (P25 ランダムに並び換え)

Posted 2008-06-08 15:29:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
以前に作ったものを組み合わせて解答せよとのことなのですが、以前に作ったremove-atが予期せぬ動きをしていたため、はまってしまいました。
原因は、

(concatenate (class-of '(a)) () ())
のような処理の個所で、class-ofでは、consと判定されるのですが、結果は、()なので、クラスはCONSではなくなってしまうということでした。
LISTならば、CONS+NULLなので大丈夫ですがLISTとCONSの扱いの違いで割とはまることが多いです(;´Д`)
(rnd-permu '(a b c d e f))
;==> (E A D F C B)
(rnd-permu #(a b c d e f))
;==> #(F E A C B D)
(rnd-permu "abcdef")
;==> "fdbaec"

(defgeneric RND-PERMU (sequence) (:documentation "P25 (*) Generate a random permutation of the elements of a list."))

(defmethod RND-PERMU ((sequence sequence)) (RND-SELECT sequence (length sequence)))

;; 修正版 (defmethod REMOVE-AT ((sequence sequence) (position integer)) (let ((class (if (listp sequence) 'list (class-of sequence)))) (values (concatenate class (subseq sequence 0 (1- position)) (subseq sequence position)) (elt sequence (1- position)))))

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

Posted 2008-06-05 14:11:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
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)))))


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

Posted 2008-06-05 13:17:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
前回定義したMY-PACKを利用しつつ、MAPCARがないので、自作しました。lisp 1.5ということで、引数の順番は逆に。
これまでlisp 1.5がLISP1なのか、LISP2なのか全然気にしてませんでしたが、下のコードからすれば、LISP1のようですね。

;ENCODE ((a a a a b c c a a d e e e e))
;
;  FUNCTION   EVALQUOTE   HAS BEEN ENTERED, ARGUMENTS..
; ENCODE
;
; ((A A A A B C C A A D E E E E))
;
;
; END OF EVALQUOTE, VALUE IS ..
; ((4 A) (1 B) (2 C) (2 A) (1 D) (4 E))

DEFINE(( (MAPCAR (LAMBDA (LST FN) (COND ((NULL LST) () ) (T (CONS (FN (CAR LST)) (MAPCAR (CDR LST) FN))))))

(ENCODE (LAMBDA (LST) (MAPCAR (MY-PACK LST) (QUOTE (LAMBDA (X) (LIST (LENGTH X) (CAR X))))))) ))

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

Posted 2008-06-04 10:25:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
Perlのjoin的なものがないので、自作してみました。
なんだか無闇に長い…。

#(a:, a:, a:, a:, b:, c:, c:, a:, a:, d:, e:, e:, e:, e:).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:].pack
//=> #[#(#"a", #"a", #"a", #"a"), #(#"b"), #(#"c", #"c"), #(#"a", #"a"), #(#"d"), #(#"e", #"e", #"e", #"e")]
"aaaabccaadeeee".pack
//=> "aaaa,b,cc,aa,d,eeee"

// Code module: l99-09

define generic pack (sequence :: <sequence>) => (result :: <sequence>);

define method pack (sequence :: <string>) => (result :: <string>) if (sequence.empty?) sequence else join(sequence.pack1, ",") end if end method pack;

define method pack (sequence :: <sequence>) => (result :: <sequence>) if (sequence.empty?) sequence else as(select (sequence by instance?) <list> => <list>; <vector> => <vector>; end select, sequence.pack1) end if end method pack;

define function pack1 (sequence :: <sequence>) => (result :: <sequence>) let prev = sequence.first; let res = make(<deque>); let tem = make(<deque>); for (x in sequence) unless (x = prev) push-last(res, as(<list>, tem)); tem := make(<deque>); end unless; push-last(tem, x); prev := x; end for; as(<list>, push-last(res, as(<list>, tem))); end function pack1;

define generic join (sequence :: <sequence>, delim :: <string>) => (result :: <sequence>);

define method join (sequence :: <sequence>, delim :: <string>) => (result :: <string>) let result = make(<deque>); for (c in sequence) push-last(result, c); push-last(result, delim); finally result.pop-last; apply(concatenate-as, <string>, result); end for end method join;


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

Posted 2008-06-03 19:20:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
うーん、これだ!というようなpfcでの良い書き方がありそうな気がする問題ではあるのですが、全然思い付けません。

(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]]

(define (pack lst) (if (null lst) () (pack1 lst () ())))

(define (pack1 lst tem res) (let ((head (hd lst)) (tail (tl lst))) (if (consp tail) (if (= head (hd tail)) (pack1 tail (++ [head] tem) res) (pack1 tail () (++ res [(cons head tem)]))) (++ res [(cons head tem)]))))

closでL-99 (P24 ロトくじ)

Posted 2008-05-30 14:54:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
以前に作成したrangeと、rnd-selectを組み合わせる、というお題です。
あまり必要ないけれどメソッド結合。
どうやら数が大きくなってしまう場合は、このお題の方法より、シャッフルして先頭のN個を取得、という風にした方が速いみたいです…。

(defgeneric lotto-select (n range)
  (:documentation
   "P24 (*) Lotto: Draw N different random numbers from the set 1..M.
 The selected numbers shall be returned in a list."))

(defmethod lotto-select :around ((n integer) (range integer)) (and (<= 1 n range) (call-next-method)))

(defmethod lotto-select ((n integer) (range integer)) (rnd-select (coerce (vec-from-1-to range) 'list) n))

(defun vec-from-1-to (end) (declare ((integer 1 *) end)) (loop :with res := (make-array end) :for i :from 0 :below end :do (setf (svref res i) (1+ i)) :finally (return res)))


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

Posted 2008-05-29 08:27:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
シーケンスの範囲切り出しには総称関数の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)))


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

Posted 2008-05-28 07:20:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
GENSYMはマクロ登場より前に存在していたりします。
一体どういう経緯でLISPにGENSYMが導入されたのか興味があるのですが、それはさておき、番兵的にGENSYMを使ってみました。番兵にもGENSYMは便利ではあります。
そして、もう一つPROG2について考えたこと。
PROG2はPROGN系で、一番最初に導入されたもので、PROG2→PROG1 & PROGNと進化し、PROG2自体はあまり使われることはなくなってしまいました。
それで、どうして最初からNではなくて2なのかと、いうことなのですが、
(PROG2 式 (GO 〜))という使い方を想定していたのではないかと、ふと考えました。
式の部分で、状態を変更して、GOTOする、というような…。
(PROG () 式 (GO 〜))では、あくまでPROG式の内部でGOTOするだけなので、複数の式をまとめつつGOTOしたい、という場合には、ちょっと不便です。
今回本当は、PROG2を使いたかったのですが、エミュレータには、PROG2がないので、PROGで書くことになり、そんなことを考えたのでした…。

MY-PACK((A A A A B C C A A D E E E E))

;FUNCTION EVALQUOTE HAS BEEN ENTERED, ARGUMENTS.. ;MY-PACK ; ; ((A A A A B C C A A D E E E E)) ; ; END OF EVALQUOTE, VALUE IS .. ; ((A A A A) (B) (C C) (A A) (D) (E E E E E))


DEFINE((
(MY-PACK (LAMBDA (LST)
           (PROG (RES TEM L)
                 (SETQ L (REVERSE 
                          (CONS (GENSYM) LST)))
              L  (COND ((NULL L) (RETURN RES)))
                 (COND ((null tem) (SETQ TEM (CONS (CAR L) TEM)))
                       ((EQUAL (CAR L) (CAR TEM))
                        (SETQ TEM (CONS (CAR L) TEM)))
                       (T (PROG ()
                                (SETQ RES (CONS TEM RES))
                                (SETQ TEM (CONS (CAR L) () )))))
                 (SETQ L (CDR L))
                 (GO L))))
))

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

Posted 2008-05-27 05:29:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
dylanにはdequeというコレクションクラスがあり、前後どちらの方向からも追加できるので、それを使って、蓄積して、最後に型変換してみました。

#(a:, a:, a:, a:, b:, c:, a:, a:, d:, e:, e:, e:, e:).compress
//==> #(#"a", #"b", #"c", #"a", #"d", #"e")

#[a:, a:, a:, a:, b:, c:, a:, a:, d:, e:, e:, e:, e:].compress //==> #[#"a", #"b", #"c", #"a", #"d", #"e"]

"aaaabcaadeeee".compress //==> "abcade"

// Code module: l99-08

define generic compress (sequence :: <sequence>) => (result :: <sequence>);

define method compress (sequence :: <sequence>) => (result :: <sequence>) let result = make(<deque>); for (elt in sequence) if (result.empty? | elt ~= result.last) push-last(result, elt) end if finally as(select (sequence by instance?) <list> => <list>; <string> => <string>; <vector> => <vector>; end select, result) end for end method compress;

pfcでL-99 (P07 リストの平坦化)

Posted 2008-05-26 02:57:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
なんだか無理矢理ですが、折角なのでカリー化してみました。

(flatten '((0 (1 ((((2 (((((3 (((4)))))))) 5))))) (6 (7 8) 9))))
;=> [0 1 2 3 4 5 6 7 8 9]

(define (flatten lst) (if (null? lst) () ((if (atom (hd lst)) (cons (hd lst)) (++ (flatten (hd lst)))) (flatten (tl lst)))))

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

Posted 2008-05-24 09:02:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
なんとなくポインタ操作系で。

compress((a a a a b c c a a d e e e e))
; FUNCTION   EVALQUOTE   HAS BEEN ENTERED, ARGUMENTS..
;COMPRESS
;
; ((A A A A B C C A A D E E E E))
;
;
; END OF EVALQUOTE, VALUE IS ..
; (A B C A D E)

DEFINE(( (COMPRESS (LAMBDA (LST) (PROG (L RES TEM) (SETQ L LST) (SETQ RES (LIST (GENSYM))) (SETQ TEM RES) L (COND ((NULL L) (RETURN (CDR RES)))) (COND ((NOT (EQ (CAR L) (CAR TEM))) (PROG () (RPLACD TEM (LIST (CAR L))) (SETQ TEM (CDR TEM))))) (SETQ L (CDR L)) (GO L)))) ))


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

Posted 2008-05-24 06:32:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
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)))


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

Posted 2008-05-24 04:08:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
P20で定義したREMOVE-ATを使えとありますが、L-99の元になったP-99では、REMOVE-ATが結果と残りのリストの両方を結果として返すものなので、このお題で使えるということのようです。
ということで、REMOVE-ATを修正して使ってみました。
しかし無駄に長いなあ…。

(rnd-select '(a b c d e f g h) 3)
;=> (G A F)

(rnd-select #(a b c d e f g h) 3) ;=> #(D E G)

(rnd-select "abcdefgh" 3) ;=> "gbc"

(defgeneric RND-SELECT (sequence number) (:documentation "P23 (**) Extract a given number of randomly selected elements from a list. The selected items shall be returned in a list." ))

(defmethod RND-SELECT :around ((sequence sequence) (count integer)) (let ((len (length sequence))) (cond ((zerop len) sequence) ((or (> 1 count) (< len count)) (MAKE-EMPTY-SEQUENCE sequence)) ('T (call-next-method sequence count)))))

(defmethod RND-SELECT ((sequence sequence) (count integer)) (loop :with seq := sequence :with res := () :for len := (length seq) :then (1- len) :for i :from count :downto 1 :when (> 1 count) :do (loop-finish) :do (multiple-value-bind (s item) (REMOVE-AT seq (1+ (random len))) (push item res) (setq seq s)) :finally (return (coerce res (class-of sequence))))))

(defgeneric REMOVE-AT (sequence position) (:documentation "P20 (*) Remove the K'th element from a list."))

(defmethod REMOVE-AT ((sequence sequence) (position integer)) (values (concatenate (class-of sequence) (subseq sequence 0 (1- position)) (subseq sequence position)) (elt sequence (1- position))))

(defgeneric make-empty-sequence (obj)) (defmethod make-empty-sequence ((obj list)) () ) (defmethod make-empty-sequence ((obj vector)) (make-array 0)) (defmethod make-empty-sequence ((obj string)) (make-string 0))

dylanでL-99 (P07 リストの平坦化)

Posted 2008-05-21 02:48:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
最近の?dylanはドットで連結できるのですが、これだと見た目は、かなりLispっぽくなくなる気がします。

let seq = #(1, #(2, 3, #(4, 5, #(#(#(6, 7)),8))), 9);
format-out("%= => %=\n",seq, seq.flatten);
//=> #(1, #(2, 3, #(4, 5, #(#(#(6, 7)), 8))), 9)
//  => #(1, 2, 3, 4, 5, 6, 7, 8, 9)

// Code module: l99-07

define generic flatten (sequence :: <sequence>) => (result :: <sequence>);

define method flatten (sequence :: <list>) => (result :: <list>) case sequence.empty? => sequence; instance?(sequence.head, <list>) => concatenate(sequence.head.flatten, sequence.tail.flatten); otherwise => pair(sequence.head, sequence.tail.flatten); end end method flatten;


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

Posted 2008-05-17 20:09:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
ここでいう左右で高さのバランスのとれた二分木とは、左右の木た高さの差が±1までの二分木とのこと。
本来バックトラックで解くところですが、全通り生成しております。
そして、hbal-treeで条件を満した木を選り分けているのですが、最初から条件を満した木を生成してしまっているため、意味のないことになっております…。

;(each x (firstn 5 (hbal-tree 3)) (prn x))
;>>>
;(x (x (x nil nil) (x nil nil)) (x (x nil nil) (x nil nil)))
;(x (x (x nil nil) nil) (x (x nil nil) (x nil nil)))
;(x (x nil (x nil nil)) (x (x nil nil) (x nil nil)))
;(x (x (x nil nil) (x nil nil)) (x (x nil nil) nil))
;(x (x (x nil nil) nil) (x (x nil nil) nil))

(def hbal-tree (h) (keep hbal-tree-p gen-tree-h.h))

(def gen-tree-h (h) (case h 0 '(()) 1 '((x () ())) (with (h-1 (gen-tree-h (- h 1)) h-2 (gen-tree-h (- h 2))) (map (fn (tree) `(x ,@tree)) `(,@(comb2 h-1 h-1) ,@(comb2 h-1 h-2) ,@(comb2 h-2 h-1))))))

(def hbal-tree-p (tree) (let (_ left right) tree (>= 1 (abs (- tree-height.left tree-height.right))))

(def tree-height (tree) (let (_ left right) tree (if tree (+ 1 (max tree-height.left tree-height.right)) 0)))


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

Posted 2008-05-17 18:52:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
色々な型に対応しつつ、コードの重複を避けるように考えているのですが、いまいちclos流というのが掴めていません…。
今回は、フロントに総称関数を置いて共通部分は、関数に括り出すという感じにしてみました。

;(range 4 9)
;=> (4 5 6 7 8 9)

;(mapc #'princ (range #\あ #\お)) ;=> あぃいぅうぇえぉお

(defgeneric RANGE (start end) (:documentation "P22 (*) Create a list containing all integers within a given range."))

(defmethod RANGE ((start integer) (end integer)) (RANGE1 start end #'values))

(defmethod RANGE ((start character) (end character)) (let ((start (char-code start)) (end (char-code end))) (RANGE1 start end #'code-char)))

(defun RANGE1 (start end fn) (declare (integer start end)) (if (< start end) (loop :for i :from start :to end :collect (funcall fn i)) (loop :for i :from start :downto end :collect (funcall fn i))))

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

Posted 2008-05-15 15:24:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
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)))


lisp 1.5でL-99 (P07 リストの平坦化)

Posted 2008-05-14 17:16:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
LISTPがないので自作。NILは空リストということで削除する方針で作成。

; FUNCTION   EVALQUOTE   HAS BEEN ENTERED, ARGUMENTS..
;FLATTEN
;
;((0 (1 ((((2 (((((3 (((4)))))))) 5))))) (6 (7 8) 9)))
;
;END OF EVALQUOTE, VALUE IS ..
;(0 1 2 3 4 5 6 7 8 9)

DEFINE(( (LISTP (LAMBDA (LST) (OR (NULL LST) (NOT (ATOM LST)))))

(FLATTEN (LAMBDA (LST) (COND ((NULL LST) () ) ((LISTP (CAR LST)) (APPEND (FLATTEN (CAR LST)) (FLATTEN (CDR LST)))) (T (CONS (CAR LST) (FLATTEN (CDR LST))))))) ))

pfcでL-99 (P06 リストが回文的かを判定)

Posted 2008-05-13 14:41:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
ううむ。もっと先の問題にならないとpfcならでは、というところが見えてこないのかもしれない…。
前回定義したrevを使用。

(palindrome? '(x a m a x))
;=> #t

(def (palindrome? lst) (= (rev lst) lst))


dylanでL-99 (P06 シーケンスが回文的かを判定)

Posted 2008-05-13 13:00:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
比較の=は、CLでいうequalみたいなもので、==だとeqになる様子。
doは、CLのmapc、Schemeのfor-each。

let lst = #(x:, a:, m:, a:, x:);
let str = "xamax";
let vec = #[x:, a:, m:, a:, x:, a:];

do (method (x) format-out("%= => %=\n", x, x.palindrome?) end, list(lst, str, vec)); //>>> // #(#"x", #"a", #"m", #"a", #"x") => #t // "xamax" => #t // #[#"x", #"a", #"m", #"a", #"x", #"a"] => #f

// code module: l99-06

define generic palindrome? (sequence :: <sequence>) => (result :: <boolean>);

define method palindrome? (sequence :: <sequence>) => (result :: <boolean>) (sequence = sequence.reverse) end method palindrome?;

ArcでL-99 (P58 線対称な二分木を探す)

Posted 2008-05-11 09:02:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
前に作成したcbal-treeとsymmetric?を組み合わせて作成。
また、57ノードの時に線対称な二分木は幾つかという問いもあり。
57ノードの場合、cbal-treeで作成する木が多くてコンスが多くなりすぎるためか、CLだと、2、3秒のところが、Arcだと、解答に11分位かかってしまいます。
keepは、CLでは、remove-if-notに相当します。

(each tr sym-cbal-trees.5
  prn.tr)
;>>> (x (x (x nil nil) nil) (x nil (x nil nil)))
;>>> (x (x nil (x nil nil)) (x (x nil nil) nil))

;(len:sym-cbal-trees 57) ;=> 256

(def sym-cbal-trees (n) (keep symmetric? cbal-tree.n))

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

Posted 2008-05-10 10:28:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
call-next-methodすると色々できそうなんだけど、乱発すると何だか良く分からないことになるなあ…。

(insert-at 'alfa '(a b c d) 2)
;=> (A ALFA C D)

(insert-at 'alfa #(a b c d) 2) ;=> #(A ALFA C D)

(insert-at 'alfa "abcd" 2) ;=> "aALFAcd"

(defgeneric INSERT-AT (item sequence position) (:documentation "P21 (*) Insert an element at a given position into a list."))

(defmethod INSERT-AT (item (sequence array) (position integer)) (call-next-method (if (stringp sequence) (to-string item) (vector item)) sequence position))

(defmethod INSERT-AT (item (sequence list) (position integer)) (call-next-method (list item) sequence position))

(defmethod INSERT-AT (item (sequence sequence) (position integer)) (concatenate (class-of sequence) (subseq sequence 0 (1- position)) item (subseq sequence position)))

(defgeneric TO-STRING (obj) (:documentation "coerce to string."))

(defmethod TO-STRING ((obj symbol)) (string obj))

(defmethod TO-STRING ((obj string)) obj)

(defmethod TO-STRING (obj) (write-to-string obj))


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

Posted 2008-05-10 09:03:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
色々な型に対応しようと思うと、どうも再帰というよりは、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)))


lisp 1.5でL-99 (P06 回文的かを調べる)

Posted 2008-05-07 09:41:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
LISP 1.5にも、EQと、EQUALがあって、いまいち使い分けが分かっていませんが、この文脈では、EQUALを使うべきなようです。

PALINDROMEP((X A M A X))

; END OF EVALQUOTE, VALUE IS .. ; *TRUE*

DEFINE(( (PALINDROMEP (LAMBDA (LST) (EQUAL (REVERSE LST) LST))) ))


dylanでL-99 (P05 シーケンスを反転させる )

Posted 2008-05-06 11:23:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
うーん、入力のクラスと同じクラスで出力させたいのだけれど、object-classでは上手く行かないので、selectで振り分け。
絶対変な書き方だと思うんだけれども…。
forは、CLのdoを強化したようなもので、loopの機能も取り入れていますが、基本的に構文はdoに良く似ています。

#(foo:, bar:, baz:).rev
//=> #(baz:, bar:, foo:)

#[foo:, bar:, baz:].rev //=> #[baz:, bar:, foo:]

"foobarbaz".rev //=> "zabraboof"

define generic rev (sequence :: <sequence>) => (result :: <sequence>);

define method rev (sequence :: <sequence>) => (result :: <sequence>) let result = make(<deque>); for (elt in sequence) push(result, elt); finally as(select (sequence by instance?) <list> => <list>; <string> => <string>; <vector> => <vector>; end select, result) end for end method rev;


pfcでL-99 (P05 リストを反転させる)

Posted 2008-05-06 03:49:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
pfcでは、appendを++とも書けるようです。listがないので、[]で囲んでいます。

(def (rev lst)
  (if (null lst)
      ()
      (++ (rev (tl lst)) [(hd lst)])))

ArcでL-99 (P57 二分探索木の作成)

Posted 2008-05-03 01:51:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
久々のArc。今回のお題は、数値のリストを二分探索木的に配置しましょう、というもの。
また、その結果を前回作成した、symmetric?で確認してみよう、とのことです。

(construct '(3 2 5 7 1))
;=> (3 (2 (1 nil nil) nil) (5 nil (7 nil nil)))

;; symmetric?で確認 (symmetric? (construct '(5 3 18 1 4 12 21))) ;=> t

(symmetric? (construct '(3 2 5 7 1))) ;=> nil

(def add-leaf (leaf tree) (with ((root left right) tree node `(,leaf () () )) (if (<= leaf root) (if no.left `(,root ,node ,right) `(,root ,(add-leaf leaf left) ,right)) (if no.right `(,root ,left ,node) `(,root ,left ,(add-leaf leaf right))))))

(def construct (lst) (reduce (fn (lst leaf) (add-leaf leaf lst)) (let (head . tail) lst (cons `(,head () () ) tail))))


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

Posted 2008-05-02 20:54:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
なんとなく、「面倒版」ではベクタを基本にして、他は型変換させるように書いてみましたが、色々な型に対応する関数を書くときはやっぱりリストを基本にするんでしょうか。
型変換するにもコストが掛かるだろうし、型ごとに個別に記述するのも面倒だし、落し所の判断が難しいなあ(;´Д`)
ベンチマーク取ったりして判断するのかな?

(remove-at #(1 2 3 4 5 6) 1)
;=> #(2 3 4 5 6)
(remove-at '(1 2 3 4 5 6) 1)
;=> (2 3 4 5 6)
(remove-at "123456" 1)
;=> "23456"

(defgeneric REMOVE-AT (sequence position) (:documentation "P20 (*) Remove the K'th element from a list."))

;; 単純版 (defmethod REMOVE-AT ((sequence sequence) (position integer)) (concatenate (class-of sequence) (subseq sequence 0 (1- position)) (subseq sequence position)))

;; 面倒版 (defmethod REMOVE-AT ((sequence vector) (position integer)) (let ((len (length sequence))) (if (not (<= 1 position len)) (copy-seq sequence) (loop :with res := (if (stringp sequence) (make-string (1- len)) (make-array (1- len))) :and ridx := 0 :for x :across sequence :for idx :from 1 :to len :unless (= position idx) :do (setf (aref res ridx) x) (incf ridx) :finally (return res)))))

(defmethod REMOVE-AT ((sequence sequence) (position integer)) (coerce (remove-at (coerce sequence 'vector) position) (class-of sequence)))

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

Posted 2008-05-01 06:02:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
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)))


lisp 1.5でL-99 (P05 リストを逆転させる)

Posted 2008-04-29 19:41:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回も再帰と繰り返しバージョンを作ってみました。

REV((FOO BAR BAZ))
REV-ITER((FOO BAR BAZ))

; FUNCTION EVALQUOTE HAS BEEN ENTERED, ARGUMENTS.. ; REV ; ; ((FOO BAR BAZ)) ; ; ; END OF EVALQUOTE, VALUE IS .. ; (BAZ BAR FOO) ; ; FUNCTION EVALQUOTE HAS BEEN ENTERED, ARGUMENTS.. ; REV-ITER ; ; ((FOO BAR BAZ)) ; ; ; END OF EVALQUOTE, VALUE IS .. ; (BAZ BAR FOO)

DEFINE(( (REV (LAMBDA (LST) (COND ((NULL LST) () ) (T (APPEND (REV (CDR LST)) (LIST (CAR LST)))))))

(REV-ITER (LAMBDA (LST) (PROG (L ACC) (SETQ L LST) L (COND ((NULL L) (RETURN ACC))) (SETQ ACC (CONS (CAR L) ACC)) (SETQ L (CDR L)) (GO L)))) ))


dylanでL-99 (P04 リストの長さ)

Posted 2008-04-28 18:31:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
dylanでは、シンボルの大文字と小文字を区別しないみたいです。つまりCLと同じ。
ということは、好きに大文字と小文字を混在させて書いたりできるわけですね。
今回reduceを使ってみましたが、引数の順番が決まってるところが違う位でCLのreduceと緒です。
mapや、reduceとなると、無名関数を使いたくなるわけですが、dylanでは、(lambda() ...)はmethod() ... endと書かれ、クロージャを作るのにもmethodです。

((lambda (x) (+ 3 x)) 97)
は、
method(x)
  3 + x
end(97);
といった感じになるみたいです。
うーん、知れば知るほど中間記法のCLOSという印象は強まります…。
format-out("%d\n", len(#(foo:, bar:, baz:, quux:)));
//=> 4
format-out("%d\n", "foo bar baz".len); // こういう風にも書けるらしい
format-out("%d\n", len("foo bar baz"));
//=> 11

// Code module: l99-04

define generic LEN (sequence :: <sequence>) => (result :: <integer>);

define method LEN (sequence :: <sequence>) => (result :: <integer>) reduce(method(res, _) 1 + res end, 0, sequence) end method LEN;

pfcでL-99 (P04 リストの長さ)

Posted 2008-04-28 15:50:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
そもそもpfcの特長をあまり把握していないので、普通にscheme的なものとして書いてしまうなあ…。
pfcにはlengthが備え付けで存在しています。

(len '(1 2 3 4))
;=> 4

(def (len lst) (if (null lst) 0 (1+ (len (tl lst)))))

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

Posted 2008-04-23 21:43:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
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))))


lisp 1.5でL-99 (P04 リストの長さ)

Posted 2008-04-23 16:37:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
lisp 1.5には標準でLENGTHがあるようです。(エミュレータには何故か無いのですが…。)
SIZEは、再帰版で、SIZE-ITERは、ループ版ってことで書いてみました。ちなみに、DEFINEのは一度に複数の定義が書けます。

SIZE((A B C D E F))
SIZE-ITER((A B C D E F))

; FUNCTION EVALQUOTE HAS BEEN ENTERED, ARGUMENTS.. ; SIZE ; ; ((A B C D E F)) ; ; ; END OF EVALQUOTE, VALUE IS .. ; 6 ; ; FUNCTION EVALQUOTE HAS BEEN ENTERED, ARGUMENTS.. ; SIZE-ITER ; ; ((A B C D E F)) ; ; ; END OF EVALQUOTE, VALUE IS .. ; 6

DEFINE (( (SIZE (LAMBDA (LST) (COND ((NULL LST) 0) (T (ADD1 (SIZE (CDR LST)))))))

(SIZE-ITER (LAMBDA (LST) (PROG (L CNT) (SETQ CNT 0) (SETQ L LST) L (COND ((NULL L) (RETURN CNT))) (SETQ CNT (ADD1 CNT)) (SETQ L (CDR L)) (GO L)))) ))

dylanでL-99 (P03 K番目の要素)

Posted 2008-04-22 12:40:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
dylanでCLのcondに相当するものは、caseで、CLのcaseに相当するものは、selectになります。使い勝手も大体同じ。というか、途中からS式からAlgol表記へ乗り換えた経緯もあり、LISP系でお馴染のものは大体あります。CLをAlgol風に表記しても、多分dylanみたいになるのでしょう…。
自分は、C/Algol系の言語は殆ど書いたことがなくて、S式系の言語ばかりやっているのですが、Algol記法では
+セミコロンの使いどころが把握できない。
+リストの要素を一々コンマで区切らないといけないのがしんどい、というかコンマを忘れても気付けない。
+括弧で囲まれていると前置記法として読み書きしてしまうので、if (= x y)等がエラーになってもずっと発見できない。
+括弧の使いどころが分からない。(foo 1 2 3)は、foo(1, 2, 3)と書かれるんだと思いますが、foo 1 2 3としてしまう。
という感じで、良くC/Algol系の人がLISPで遭遇する困難と正反対になっている気がしないでもありません。
そして、この辺の問題は気付けないってのが、非常にストレスに感じます。
この辺は、馴れなんじゃないかなと思いますが、自分のように最初からLISPの割合が高い人間が正反対の性質を持つということは、もしかしたら、「どっちににも馴れる」というのは比較的難しいところで、「どっちか」で落着いてしまうところなのかもしれません。
もちろん、ピアノもギターも弾ける人はいる訳で、訓練次第だとは思いますが、多分、楽器の乗換え位しんどい気がします。

element-at(#(a:, b:, c:, d:), 3)
//=> #"c"

;; Code module: l99-03

define generic element-at (sequence :: <sequence>, position :: <integer>) => (result :: false-or(<symbol>));

define method element-at (sequence :: <list>, position :: <integer>) => (result :: false-or(<symbol>)) case empty?(sequence) => #f; 1 >= position => head(sequence); otherwise => element-at(tail(sequence), position - 1); end case end method element-at;


pfcでL-99 (P03 K番目の要素)

Posted 2008-04-21 17:48:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
pfcには、condがないようなので、ifの組み合わせで書いてみました。

;(element-at '(a b c d e) 100)
;=> c

(def (element-at lst k) (if (null lst) () (if (>= 1 k) (hd lst) (element-at (tl lst) (1- k)))))

ArcでL-99 (P56 二分木が線対称な構成かを調べる)

Posted 2008-04-19 09:59:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
バックトラックをどうしようか、と考えていたら全然進めなくなったので、それは置いておいて、まずは普通にリスト操作で解いて後で考えることにしました。
後ではやらない可能性もありますが…(笑)
mirrorという補助関数を定義して解いてみよう、ということなので、反転して同じ構成かを比較しろ、ということなのかと思い、そういう風に書いてみました。
個々の葉の要素が同じかではなく、構成が同じかどうか、ということなので、skeltonという構成をコピーする関数を定義して比較しています。

(symmetric? '(x nil (x (x (x nil nil) (x nil nil))
                       (x nil (x nil nil)))))
;=> nil

(symmetric? '(x (x (x (x nil nil) (x nil nil)) (x nil (x nil nil))) (x (x (x nil nil) nil) (x (x nil nil) (x nil nil))))) ;=> t

(def mirror (tree) (if no.tree () (let (rt l r) tree `(,rt ,mirror.r ,mirror.l))))

(def skelton (tree) (if no.tree () (let (rt l r) tree `(x ,(skelton l) ,(skelton r)))))

(def symmetric? (tree) (let skel (skelton tree) (iso skel (mirror skel))))

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

Posted 2008-04-18 09:02:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
前回までは、closの型でディスパッチする機能にIF式の代わりをさせるという妙なことをしていましたが、大体パターンが分かったのと、これ以降はかなり複雑になるということで、普通にリストだけでなく色んなオブジェクトに対応することでclosらしさを出して行くことにしました。しかし、GOOとかDylanと被るんだなあ…。
今回のお題は、範囲の切り出しで、標準の関数だと、subseqがあります。
リストの処理は普通ですが、ベクタは、普通版と、共通部分をaroundメソッドで括り出す書き方をしてみました。
中間処理は、リストを使い、最後に入力の型に合せて型変換する、という流れです。
aroundはこういう使い方もするのかなあ、と手元のソースを調べてみたのですが、こういう風にはあまり書かないようです(笑)
AOP系のソースにはちらっとありましたが、どうなんでしょうねえ。
確かにメソッド結合を濫用していると、あっという間に把握できないコードになるというのは分かる気がします…。

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

(defgeneric slice (lst start end) (:documentation "Given two indices, I and K, the slice is the list containing the elements between the I'th and K'th element of the original list (both limits included). Start counting the elements with 1."))

(defmethod slice ((sequence list) (start integer) (end integer)) (loop :for idx := 1 :then (1+ idx) :for x :in sequence :when (<= start idx end) :collect x))

;; 1 普通に (defmethod slice ((sequence array) (start integer) (end integer)) (loop :for idx := 1 :then (1+ idx) :for x :across sequence :when (<= start idx end) :collect x :into res :finally (return (coerce res (class-of sequence)))))

;; 2 共通部分をaroundメソッドに分割したバージョン (defmethod slice ((sequence array) (start integer) (end integer)) (loop :for idx := 1 :then (1+ idx) :for x :across sequence :when (<= start idx end) :collect x))

(defmethod slice :around ((sequence sequence) (start integer) (end integer)) (coerce (call-next-method) (class-of sequence)))


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

Posted 2008-04-17 08:45:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
何となく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))


dylanでL-99 (P02 最後2つの要素)

Posted 2008-04-16 05:42:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
マニュアルを読んでも、あまり書法が理解できないので、参考にできそうなコードを探してみたところ、DylaのCL風ライブラリというものを発見。
-[http://www.opendylan.org/cgi-bin/viewcv.cgi/trunk/fundev/sources/lib/cl/]
作者は、Scott MacKay氏ですが、元Symbolicsの人で、現在ITAに所属しているらしいというLISP街道まっしぐらな方のようです。
Dynamic Languages Wizards Series, Spring 2001にもDavid Moon氏等と一緒にパネリストとして出演してたのを見たことがあります。
-(http://www.ai.mit.edu/projects/dynlangs/Talks/runtime-panel.htm)
とりあえず、真似するのが良いかなと思って、MacKay氏のスタイルを真似。
最初にgenericを作成して、後で特定化されたmethodを追加し、dylanでは、返り値の型を明示することができるのですが、そこはきっちり書くというスタイルのようです。

let list = #(foo:, bar:, baz:);
format-out("%=\n", last2(list));
// => #(#"bar", #"baz")

let list = #(); format-out("%=\n", last2(list)); // => #()

// Code module: l99-02

define generic last2 (sequence :: <sequence>) => (result :: <sequence>);

define method last2 (sequence :: <list>) => (result :: <list>) if (2 >= size(sequence)) sequence else last2(tail(sequence)) end if end method last2;

比較としてCLOSでも考えてみました。
dylanと違ってdefgenericで返り値の型は指定できないようなので、documentationを付けてるだけです(笑)
返り値の型の指定はどうやったら良いかなと思いましたが、theを付ければ良いだけなんでしょうか。どういうのが定石なんでしょう…。
もしくは、aroundや、afterメソッドで返り値の型をチェックする、なども可能だったりするんでしょうか?
返り値の型を明示するというのは、CLのようにインクリメンタルにコンパイル可能で会話的に開発できる言語でも、割と御利益が多いんじゃないかと思うのですが、どうでしょう。
自分はコンパイラが教えてくれる情報が多くなるので、なんとなく好みです。
(defgeneric last2 (sequence)
  (:documentation "last2"))

(defmethod last2 ((sequence list)) (if (>= 2 (length sequence)) (the list sequence) (last2 (cdr sequence))))


dylanでL-99 (P01 最後のペアを返す)

Posted 2008-04-15 16:27:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
自分は何度かdylanに挑戦してはいるのですが、処理系のインストールの時点で挫折したり、動いてもコンパイルの仕方をすぐ忘れたり、S式でないので文法を憶えられなかったりして何度も挫折しています。
…ということで、L-99なのですが…。
dylanには複数の処理系があります。Gwydion dylanと、Open dylanがあるのですが、今回はOpen dylanにしておきます。
どうしてかというと、Open dylanで最近SWANK(SLIMEのバックエンド)が動いてるらしく、SLIMEで開発できるっぽいので、Open dylanの方が面白そうだということで…。
とりあえず、
http://www.opendylan.org/downloads/opendylan/1.0beta4/
にパッケージがあるので、ダウンロードしてインストールします。
これだけで動くようになりました。
それで、dylanの開発環境なのですが、この辺も謎なところです。
昔のdylanのスクリーンショット等をみると非常にリッチな開発環境を持っていたようなのですが、フリーでもこういう環境はあるのでしょうか。
とりあえず、追々探って行くことにして、Emacsで書いてコンパイル、という方向で行きます。
Open dylanの場合、make-dylan-appコマンドがインストールされます。
好きなディレクトリで、例えば、l99-01というプロジェクトの場合、

$ make-dylan-app l99-01
とすると、l99-01というディレクトリが作成され、その中に色々謎なものが生成されます。
それで、ソースファイルは、l99-01.dylanなのですが、これはHello, Woldのテンプレートになっています。
とりあえず、これを編集して、makeファイルも自動生成されるので、ソースを書いたらmakeする、ということになるみたいです。

dylanでは、
シンボル→foo: もしくは、#"foo"
リスト→#(foo:, bar:, baz)
のようです。
formatのような、format-outがあるんですが、書法は、Cのprintf的です。
headは、carで、tailはcdr
empty?は、空かどうかを判定する総称関数。
コメントは、//で、C++っぽいです。
ちなみに、今回、一番驚いたのは、はてなのシンタックスハイライトにdylanがあったことです(笑)
let list = #(foo:, bar:, baz:);
format-out("%=\n", my-last(list));
// => #(#"baz")

// Code module: l99-01

define function my-last(list) if (empty?(tail(list))) list; else my-last(tail(list)); end if; end function my-last;

lisp 1.5でL-99 (P03 K番目の要素)

Posted 2008-04-15 10:00:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
最初は<や>はLISPには存在していなくて、greaterp、lesspでした。
また、1+、1-は、add1、sub1でした。MacLISPや、Lispマシン位までは両方使えましたが、Common Lispで廃止されたようです。

;  FUNCTION   EVALQUOTE   HAS BEEN ENTERED, ARGUMENTS..
; ELEMENT-AT
;
; ((A B C D E) 3)

; END OF EVALQUOTE, VALUE IS .. ; C

DEFINE (( (ELEMENT-AT (LAMBDA (LST K) (COND ((NULL LST) () ) ((GREATERP 2 K) (CAR LST)) (T (ELEMENT-AT (CDR LST) (SUB1 K)))))) ))

ELEMENT-AT((A B C D E) 3)


lisp 1.5でL-99 (P01 最後のペアを返す)

Posted 2008-04-13 11:37:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今年は、LISP生誕50年であり、色々やるなら、やはりlisp 1.5は外せないだろう…、ということで…。
全部大文字で書いてますが、LISP 1.5も大文字と小文字は区別せず、エミュレータに読み込ませるソースは小文字で書いても大丈夫なので、大文字にする必要はありません。
気分というか趣味の問題ですね…。

; FUNCTION   EVALQUOTE   HAS BEEN ENTERED, ARGUMENTS..
; LAST
;
; ((FOO BAR BAZ))
;
; END OF EVALQUOTE, VALUE IS ..
; (BAZ)

DEFINE(( (LAST (LAMBDA (LST) (COND ((NULL (CDR LST)) LST) (T (LAST (CDR LST)))))) ))

LAST((FOO BAR BAZ))

pfcでL-99 (P02 最後2つの要素)

Posted 2008-04-13 10:43:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
自分は毎回混乱しているのですが、2番目の問題は、最後2つの要素を取り出す問題です。
標準でdropがあるので、それを使ってみました。
dropはSRFI-1由来だと思いますが、CLだと、LASTがdropの代わりに使えます。
(last '(1 2 3 4) 2) => (3 4)

(last2 [1 2 3 4])
;=> [3 4]

(def (last2 lst) (drop (- (length lst) 2) lst))

(def (last2 lst) (if (>= 2 (length lst)) lst (last2 (cdr lst))))


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

Posted 2008-04-12 00:13:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
前回(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)) ","))


pfcでL-99 (P01 最後のペアを返す)

Posted 2008-04-11 22:38:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
なんとなく面白そうだったので、pfcでも、L-99に挑戦してみることにしました。
GaucheのWilikiのページで、letzf等の内包表記が使える処理系ということで知ったのですが、処理系探してもずっと見付けられないでいました。
処理系の名前がどうやら、pfcらしいということが分かって、pfcで検索していたらGaucheのLingr部屋のログに配布先があったので、ソースを入手して試してみました。
ソースは、Darcsで入手できます。

darcs get http://www.sampou.org/repos/pfc
srcディレクトリの中で、makeすれば、pfcの実行ファイルが生成されますので、それを実行します。
ドキュメントはないようですが、電通大の岩崎教授が中心となって、Haskell/Schemeで有名な山下氏、伊東氏が開発に参加している処理系のようです。
まだ良く分かっていないのですが、標準で遅延評価やambがあったりするようです。
pfcでの関数定義は、Schemeと同じようなのですが、defineの代わりにdefも使えるようで、MIT記法もあります。

リスト、タプル/ベクタ

リストはCL/Schemeと違ってGOOのように真性リストしかないようです。
ドット対リストに相当するものは、(pair 1 1) =>{1 1}のように作る様子。要素にはfstとsndでアクセスでQiのタプルと同じ感じ。
また、(list 1 2 3)の代わりに、[1 2 3]と書くところもQiに似ています。

細々したこと

null ≡ null?、cdr ≡ tl(tailから?)、car ≡ hd(headから?)、cons? ≡ consp等、MacLISP系の関数名とScheme畑や関数言語畑の名前が好みに応じて使えるようです。
(my-last '(a b c d))
;=> (d)

(def (my-last lst) (if (null (tl lst)) lst (my-last (tl lst))))

(def (my-last lst) (drop (1- (length lst)) lst))

(def (my-last lst) [((! lst) (1- (length lst)))])

;; ~~~ (index '(0 1 2 3) 0) ; or (! '(0 1 2 3) 0) ;=> 0

(let ((!lst (! '(0 1 2 3)))) (!lst 0)) ;=> 0

QiでL-99 (P26 指定した個数を抜き出す組み合わせ)

Posted 2008-04-10 23:14:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
Qiでは今迄あまり無名関数を使ってませんでしたが、(lambda (x) x)は、Qiでは、(/. X X)と書きます。/.をλと見立てているようなんですが…。

(combination 3 [a b c d e f])
\=> [[a b c] [a b d] [a b e] ... ]
\

(length (combination 3 (range 1 12))) \=> 220 \

(define combination 0 Lst -> [ ] 1 Lst -> (map (/. X [X]) Lst) N Lst -> [ ] where (> N (length Lst)) N [H | T] -> (append (map (/. X [H | X]) (combination (- N 1) T)) (combination N T)))


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

Posted 2008-04-10 22:32:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
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)) ","))

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

Posted 2008-04-09 19:23:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回も無駄にリストだけでなくコレクションクラスに対応してみました。
また、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)))

;))))))))))

QiでL-99 (P25 ランダムに並び換え)

Posted 2008-04-09 17:36:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)

(rnd-permu [a b c d e f])
\=> [e a d f c b]
\

(define rnd-permu U -> (rnd-select U (length U)))

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

Posted 2008-04-08 16:24:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
コレクションクラスに対応してみました。
コレクションクラスがどういう位置付けなのかいまいち分かっていませんが、リストやベクタのスーパークラスのようです。

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)))))


QiでL-99 (P24 ロトくじ)

Posted 2008-04-08 15:35:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
Qiでも、もう少しでリスト篇が終わり!

(lotto-select 6 49)
\=> [29 5 24 18 23 2]
\

(define lotto-select N M -> (rnd-select (range 1 M) N))

GOOでL-99 (P07 リストの平坦化)

Posted 2008-04-07 21:38:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
flattenは、恐らくリストにしか使わないので、総称関数ではなく普通の関数にしてみました。
リストかどうかを判定する関数が見付からなかったのでlst?を作成。
また、GOOでは、引数の指定で戻り値の型をDylanのような記法で明記することができるので折角なので使ってみました。
pairはCL/Schemeでいうところのconsなのですが、GOOは慣例的な名前を悉く否定しているとしか思えません(笑)

(flatten '(1 () 2 3 4 5 6 ((7((((())))))) (8)))
;=> (1 2 3 4 5 6 7 8)

(df flatten (u|<lst> => <lst>) (cond ((nul? u) () ) ((lst? (head u)) (cat (flatten (head u)) (flatten (tail u)))) (#t (pair (head u) (flatten (tail u))))))

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

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

Posted 2008-04-07 20:07:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今迄なんとなくQiっぽくなくなるかなと思ってあまりifを使ってきませんでしたが、Qiにもifはあります。
今回は、whereだけでは、lengthを2回呼ぶことになるのでifを使ってみました。

(rnd-select [a b c d e f g h] 3)  
\=> [g c e]
\

(define rnd-select [ ] _ -> [ ] Lst N -> (let Len (length Lst) (if (> N Len) [ ] (rnd-select* Lst N [ ] Len))))

(define rnd-select* [ ] _ Acc _ -> Acc Lst N Acc Len -> Acc where (>= 0 N) Lst N Acc Len -> (let Pos (+ 1 (random Len)) (rnd-select* (remove-at Lst Pos) (- N 1) [(nth Pos Lst) | Acc] (- Len 1))))


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

Posted 2008-04-06 09:18:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)

(range 0.5 10)
\=> [0.5 1.5 2.5 3.5 4.5 5.5 6.5 7.5 8.5 9.5]
\

(define range Start End -> [ ] where (> Start End) Start End -> [Start | (range (+ 1 Start) End)])


GOOでL-99 (P06 回文的かを調べる)

Posted 2008-04-06 09:11:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
意味なく、回文数にも対応してみました。

(palindrome '(x a m a x)) ;=> #t
(palindrome #(x a m a x)) ;=> #t
(palindrome "xamax")      ;=> #t
(palindrome 12321)        ;=> #t

(dm palindrome (u|<col>) (= u (rev u)))

(dm palindrome (u|<num>) (palindrome (num-to-str u)))


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

Posted 2008-04-05 12:57:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
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 左右のバランスがとれた二分木)

Posted 2008-04-04 15:54:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、左右のバランスがとれた二分木を生成するのがお題ですが、元がPrologの問題ということもあってバックトラックを使用して解くように、ということになっています。
バランスが取れていることの定義ですが、各々の部分木ごとにノード数が同じか、1つ違うだけ、とのこと。
ここは、Scheme風のバックトラックを使うかどうか迷いましたが、分からなくなったので前にCLで作ったものを移植しました(;´Д`)…。
これは、バックトラックではなくて、力技で全部の組み合わせのリストを生成します。
しかし、バックトラックを使って解けるようにならないと、この先かなり苦戦すると思うので、ここはちょっと保留して、Scheme風のバックトラックでどう書けるのか、考えてみた方が良いのかもしれない…。

細々

+0と、0.0が同じものであると判定する方法が分からなかったので、(iso 0 0.0) -> nil、==というものを作って比較しています。
+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)))

GOOでL-99 (P05 リストを逆転させる)

Posted 2008-04-03 16:23:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回もlstクラスとflatクラスに対応させてみました。
matchはパターンマッチで変数を束縛するものです。しかし、なんだかあまり使い勝手は良くないような…。
catは、concatenateの略で、append的なところはcatを使うようです。
asは型変換で、CLだと、coerceですが、恐らくDylanの命名法からとってきたんだと思います。
pushfはCLでいうpushですが、引数の順番が逆です。
微妙に色々違っていて非常に憶えづらい(;´Д`)…。
また、GOOには標準でrevがあります。

(my-rev '(1 2 3 4)) ;=> (4 3 2 1)
(my-rev "foo") ;=> "oof"
(my-rev #(a b c)) ;=> #(c b a)
(my-rev #[a b c]) ;=> #[c b a]

(dm my-rev (u|<lst>) (if (nul? u) () (match u ((,H ,@T) (cat (my-rev T) (lst H))))))

(dm my-rev (u|<flat>) (def res () ) (for ((x u)) (pushf res x)) (as (class-of u) res))


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

Posted 2008-04-03 15:42:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
若干ダレて来たような(;´Д`)…。

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

(define remove-at [ ] _ -> [ ] X K -> X where (>= 0 K) [H | T] 1 -> T [H | T] K -> [H | (remove-at T (- K 1))])

ArcでL-99 (P54a 二分木かどうかを判定)

Posted 2008-04-02 12:21:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回から二分木篇に突入です。番号はどういう訳かいきなり54a。
ここでの二分木とは、(x nil nil)という風に定義し、(根 葉 葉)というリストで表現されるとのことです。
木は根と葉から成り、根はアトム、葉は木から成ります。
それで今回のお題は、二分木になっているかを判定する関数を書けとのこと。

(atree '(1 2 3)) ;=> nil
(atree '(x nil nil)) ;=> t
(atree '(x (x nil nil) (x nil (x nil nil)))) ;=> t
(atree '(x (x nil nil) (x nil (x nil nil x)))) ;=> nil

(def atree (tree) (if atom.tree no.tree 'else (and (is 3 len.tree) (let (root left right) tree (and atom.root root atree.left atree.right)))))

QiでL-99 (P19 指定した位置でローテーションさせる)

Posted 2008-04-01 09:06:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今迄、Qiに1+とか、1-が備え付けで存在すると思っていましたが、なんとQiでは関数名を全部大文字で書くと、下層のCLの関数が直接呼べるんだそうで、1+はCLから呼んでいたのでした。また、DEFUNや、DEFMACROで下層のCLの関数も定義可能とのこと。

(my-rotate [a b c d e f g h] 3)
\=>  [d e f g h a b c]
\

(my-rotate [a b c d e f g h] -2) \=> [g h a b c d e f] \

(define my-rotate [ ] _ -> [ ] Lst N -> (xappend (split Lst (+ N (length Lst)))) where (> 0 N) Lst N -> (xappend (split Lst N)))

(define xappend [H T] -> (append T H))


Older entries (156 remaining)