Hatena::Groupcadr

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

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

2008-05-18

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

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

ここでいう左右で高さのバランスのとれた二分木とは、左右の木た高さの差が±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)))

2008-05-11

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

| 18:02 | ArcでL-99 (P58 線対称な二分木を探す) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P58 線対称な二分木を探す) - わだばLisperになる

前に作成した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))

2008-05-03

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

| 10:51 | ArcでL-99 (P57 二分探索木の作成) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P57 二分探索木の作成) - わだばLisperになる

久々の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))))

2008-04-19

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

| 18:59 | ArcでL-99 (P56 二分木が線対称な構成かを調べる) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P56 二分木が線対称な構成かを調べる) - わだばLisperになる

バックトラックをどうしようか、と考えていたら全然進めなくなったので、それは置いておいて、まずは普通にリスト操作で解いて後で考えることにしました。

後ではやらない可能性もありますが…(笑)

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

2008-04-06

Arcでletrec、内部define

| 03:32 | Arcでletrec、内部define - わだばLisperになる を含むブックマーク はてなブックマーク - Arcでletrec、内部define - わだばLisperになる

ArcにはSchemeのletrecや、CLのlabelsに相当する構文がないのだけれど、

(def fact (n)
  (let f1 ()
    (= f1
       (fn (c acc)
         (if (is 0 c)
             acc
             (f1 (- c 1) (* c acc)))))
    (f1 n 1)))

のように書くことになるのだろうか。

同様に内部defineは、

(def fact (n)
  (let f1 ()
    (def f1 (c acc)
      (if (is 0 c)
          acc
          (f1 (- c 1) (* c acc))))
    (f1 n 1)))

のように書くことになるのだろうか。

どっちにしろ、letでローカル束縛を作れば、大域定義になるのを防げる。

2008-04-05

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

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

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

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

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

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

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

細々

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

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

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

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

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

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

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

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

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

2008-04-02

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

| 21:21 | ArcでL-99 (P54a 二分木かどうかを判定) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P54a 二分木かどうかを判定) - わだばLisperになる

今回から二分木篇に突入です。番号はどういう訳かいきなり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)))))

2008-03-31

ArcでL-99 (P50 ハフマン符号化)

| 20:35 | ArcでL-99 (P50 ハフマン符号化) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P50 ハフマン符号化) - わだばLisperになる

算術と符号化篇の最後である、今回のお題は、ハフマン符号化です。

出現頻度の高いものには、より短い符号を与えることにより圧縮を実現する符号化のようで、LHAや、JPEG等の圧縮で用いられているそうです。

(huffman-table '(a b c d e f g g g g g e))
;=> ((g "1") (f "011") (c "0101") (d "0100") (a "0011") (b "0010") (e "000"))

;; ----
(def freq (lst)
  (let h (table)
    (each item lst 
      (if (h item)
          (++ (h item))
          (= (h item) 1)))
    (tablist h)))

;(freq '(a b c d e f g g g g g e))
;=> ((a 1) (d 1) (b 1) (e 2) (c 1) (f 1) (g 5))

(def huffman-tree (lst)
  ((afn (lst)
     (if single.lst caar.lst
         'else
         (let ((ai an) (bi bn) . rest) (sort (fn ((_ a) (_ b)) (< a b)) 
                                             lst)
           (self `(((,ai ,bi) ,(+ an bn))
                   ,@rest)))))
   freq.lst))

;(huffman-tree '(a b c d e f g g g g g e))
;=> (g ((f (b c)) ((a d) e)))

;;動作状況
;-> ((a d) 2), (b 1), (c 1), (f 1), (e 2), (g 5)
;-> ((b c) 2), (f 1), ((a d) 2), (e 2), (g 5)
;-> ((f (b c)) 3), ((a d) 2), (e 2), (g 5)
;-> (((a d) e) 4), ((f (b c)) 3), (g 5)
;-> (((f (b c)) ((a d) e)) 7), (g 5)
;-> ((g ((f (b c)) ((a d) e))) 12)
;=> (g ((f (b c)) ((a d) e)))

(def huffman-code-tree (lst)
  ((afn (tree (o code ""))
     (if (no alist.tree) `(,tree ,code)
         no.tree ()
         'else
         `(,(self car.tree (+ code "1"))
           ,(self cadr.tree (+ code "0")))))
   (huffman-tree lst)))

;(huffman-code-tree '(a b c d e f g g g g g e))
;=> ((g "1") (((f "011") ((c "0101") (d "0100"))) (((a "0011") (b "0010")) (e "000"))))

(def huffman-table (lst)
  (pair:flat:huffman-code-tree lst))
  • 符号化と復号化を試してみる。

"% huffman(Fs,Hs) :- Hs is the Huffman code table for the frequency table Fs"

という75文字の文字列の場合、下記のenhuffmanでは、326ビットになります。

元の文字列が1文字あたり6ビット(64種類の文字が可能)だとすると、450ビットなので、元より100ビット位圧縮されている、という解釈で良いんでしょうか?(´▽`*)…。

(withs (lst (coerce "% huffman(Fs,Hs) :- Hs is the Huffman code table for the frequency table Fs" 'cons)
        tab (huffman-table lst))
  (let code (enhuffman lst tab)
    (prn "\nencode:\n" (string lst) " => " code)
    (prn "\ndecode:\n" code " => " (string (dehuffman code tab)))
    nil))
;==>>
;encode:
;% huffman(Fs,Hs) :- Hs is the Huffman code table for the frequency table Fs => 10001000000111010010010001001110110100110101011011000101101100010000101101010000101000101111000010000101000101101010100011000011111100001000010010010001001110110100110000100111001010001111100011001101100000111111100000101001001101000110000111111000001001101111101110010011110011010011101001000110011011000001111111000011000101
;
;decode:
;10001000000111010010010001001110110100110101011011000101101100010000101101010000101000101111000010000101000101101010100011000011111100001000010010010001001110110100110000100111001010001111100011001101100000111111100000101001001101000110000111111000001001101111101110010011110011010011101001000110011011000001111111000011000101 => % huffman(Fs,Hs) :- Hs is the Huffman code table for the frequency table Fs
;nil

; ----
(def exch-key/val (lst)
  (map (fn ((a b)) (list b a))
       lst))

;(exch-key/val (huffman-table '(a b c d e f g g g g g e)))
;=> (("1" g) ("011" f) ("0101" c) ("0100" d) ("0011" a) ("0010" b) ("000" e))

(def enhuffman (lst tab)
  (let h (listtab tab)
    (apply + (map [h _] lst))))

;(let lst '(a b c d e f g g g g g e)
;  (let tab (huffman-table lst)
;    (enhuffman lst tab)))
;=> "001100100101010000001111111000"

(def dehuffman (code tab)
  (with (h (listtab (exch-key/val tab)) res () cur "")
    (each c code
      (zap + cur (string c))
      (awhen (h cur)
        (push it res)
        (= cur "")))
    rev.res))

;(let lst '(a b c d e f g g g g g e)
;  (let tab (huffman-table lst)
;    (let code "001100100101010000001111111000"
;      (dehuffman code tab))))
;=> (a d b c e f g g g g g e)

2008-03-29

ArcでL-99 (P49 グレイ・コード)

| 13:19 | ArcでL-99 (P49 グレイ・コード) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P49 グレイ・コード) - わだばLisperになる

グレイ・コードとは、一度に1ビットしか変化しないような二進符号のことだそうです。

去年Common Lispで解答を作成したときには、2進数を右シフトしてXORを取るという方法で解答しましたが、メモ化してみるという課題もあるので、今回は再帰で。

メモ化で効率はどう変化するかということですが、Arcには、defmemoというメモ化してくれるマクロがあるので安直にそれを利用。

キャッシュが効くと速くなります。

(gray 4)
;=> ("0000" "0001" "0011" "0010" "0110" "0111" "0101" "0100"
     "1100" "1101" "1111" "1110" "1010" "1011" "1001" "1000")

(def gray (n)
  (if (is 1 n)
      '("0" "1")
      (let g (gray (- n 1))
        (+ (map [+ "0" _] g)
           (map [+ "1" _] rev.g)))))

;; メモ化版
(defmemo graym (n)
  (if (is 1 n)
      '("0" "1")
      (let g (graym (- n 1))
        (+ (map [+ "0" _] g)
           (map [+ "1" _] rev.g)))))
(graym 12)(gray 12)
1time: 159 msec.time: 265 msec.
2time: 0 msec. time: 327 msec.
3time: 0 msec.time: 206 msec.

2008-03-26

ArcでL-99 (P48 真偽値表 その3)

| 20:31 | ArcでL-99 (P48 真偽値表 その3) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P48 真偽値表 その3) - わだばLisperになる

Common Lispで作成したものを移植。

大したことはしていないのに、なんだか長〜くなりました。

(table/c (A B C)
  A *and (B *or C) *equ A *and B *or A *and C)
;=> nil, nil, nil => t
;   nil, nil, t => t
;   nil, t, nil => t
;   nil, t, t => t
;   t, nil, nil => t
;   t, nil, t => t
;   t, t, nil => t
;   t, t, t => t

(set *operator-precedence-list* '(*and *nand *or *nor *impl *equ *xor))

(mac table/c (args . expr)
  (let argl (len args)
    `(each ,args (make-truth-table ,argl)
       (prall (list ,@args))
       (pr " => " ,(to-prefix/c expr *operator-precedence-list*) "\n"))))

(def nth-truth (size num (o true t) (o false nil))
  ((afn (cnt acc)
     (if (is 0 cnt)
         rev.acc
         (let cnt (- cnt 1)
           (self cnt
                 (cons (if (odd:trunc (/ num (expt 2 cnt))) true false) 
                       acc)))))
   size () ))

(def make-truth-table (size (o true t) (o false nil))
  ((afn (cnt acc)
     (if (is cnt (expt 2 size))
         rev.acc
         (self (+ cnt 1) 
               (cons (nth-truth size cnt true false)
                     acc))))
   0 () ))

;; 前回定義のconjunct-not-exprが必要
(def to-prefix/c (expr precedence)
  ((afn (expr)
     (if atom.expr expr
         ;; 
         (and acons.expr (is 'no car.expr))
         (if (acons cadr.expr)
             `(no ,(self cadr.expr))
             expr)
         ;; 
         (atom car.expr)
         (let (a pred b) expr
           `(,pred ,a ,self.b))
         ;; 
         'else 
         (let (a pred b) expr
           `(,pred ,self.a ,self.b))))
   (car:set-operator-predence conjunct-not-expr.expr precedence)))

(def conjunct-infix-expr (pred expr)
  (if atom.expr expr
      ;; 
      (is pred cadr.expr)
      (let (a pred b . rest) expr
        `((,(conjunct-infix-expr pred a)
           ,pred
           ,(conjunct-infix-expr pred b))
          ,@(conjunct-infix-expr pred rest)))
      ;; 
      (atom car.expr)
      (cons car.expr (conjunct-infix-expr pred cdr.expr))
      ;; 
      (is 3 (len car.expr))
      (cons car.expr (conjunct-infix-expr pred cdr.expr))
      ;; 
      'else
      (cons (conjunct-infix-expr pred car.expr)
            (conjunct-infix-expr pred cdr.expr))))

(def set-operator-predence (expr precedence)
  ((afn (lst res)
     (if no.lst
         res
         (self cdr.lst (conjunct-infix-expr car.lst res))))
   precedence expr))
;    

2008-03-25

ArcでL-99 (P47 真偽値表 その2)

| 14:38 | ArcでL-99 (P47 真偽値表 その2) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P47 真偽値表 その2) - わだばLisperになる

今回は、前回のものを一捻りして、与える式をより普通の数式に近い表現で与えられるようにするというお題です。

適当に、2引数であることを決め打ちにして、中間記法→前置記法変換を書いてみました。

conjunct-not-exprという表現が英語として正しいのかどうかは謎です…。

(let (A B) '(t nil)
  (table/b (A B)
   ;; 式
   A *and (A *or not B)))
;=> ====
;   t: t => t
;   t: nil => t
;   nil: t => nil
;   nil: nil => nil

(mac table/b ((a b) . expr)
  `(do (prn "\n====")
       (each (,a ,b) (perm (list ,a ,b))
         (prf "~ : ~  => ~ \n" ,a ,b ,(to-prefix expr)))))

(def to-prefix (expr)
  ((afn (expr)
     (if atom.expr expr
         ;; not X ...
         (and (acons expr) (is 'no car.expr)) 
         (if (acons cadr.expr)
             `(no ,(self cadr.expr))
             expr)
         ;; X ...
         (atom car.expr) 
         (let (a pred b) expr
           `(,pred ,a ,self.b))
         ;; (X ...) ...
         'else
         (let (a pred b) expr
           `(,pred ,self.a ,self.b))))
   (conjunct-not-expr expr)))

;; notを先に結合させるための関数
(def conjunct-not-expr (expr)
  (if no.expr ()
      ;; not X ...
      (is 'not car.expr) 
      `((no ,(if (atom cadr.expr)
                  cadr.expr
                  (conjunct-not-expr cadr.expr)))
        ,@(conjunct-not-expr cddr.expr))
      ;; X ...
      (atom car.expr)
      (cons car.expr (conjunct-not-expr cdr.expr))
      ;; (X ...) ...
      'else 
      (cons (conjunct-not-expr car.expr)
            (conjunct-not-expr cadr.expr))))

Arcのマクロ

| 14:11 | Arcのマクロ - わだばLisperになる を含むブックマーク はてなブックマーク - Arcのマクロ - わだばLisperになる

(mac foo (a b)
  `(prf "#,a #,b"))

で、

(foo x y)
;=> (prf "#x #y")

となることを期待してしまうが、残念ながら今のところ

(prf "#,a #,b")

となる。

便利なので、展開されると良いなと思ったり。

2008-03-24

ArcでL-99 (P46 真偽値表)

| 09:25 | ArcでL-99 (P46 真偽値表) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P46 真偽値表) - わだばLisperになる

前回で、算術篇は終わり、今回から論理と符号篇です。ということで、番号が飛んでP46から。

これまでの問題を細かく分けると、43問あるので2問足りてない感じです。

今回のお題は、2引数のand、or、nand、nor、xor、impl、equを定義を定義し、真偽値表を出力するプログラムで結果を表示させるというものです。

implがなんだか良く分かりませんでしたが、検索してみると、IMPLY B (AならばB)のことのようなので、それらしいものを作ってみましたが、これで良いのか自信がありません。

(table t nil *impl)
;=> ====
;   t : t => t
;   t : nil => nil
;   nil : t => t
;   nil : nil => t
;   nil

(def *nand (a b) (no:and a b))
(def *nor (a b) (no:or a b))
(set *and ~*nand)
(set *or ~*nor)
(def *equ (a b) (*or (*and a b) (*and no.a no.b)))
(set *xor  ~*equ)
(def *impl (a b) (*or no.a b))

(def perm (lst)
  ((afn (u res)
     (if no.u
         res
         (self cdr.u `(,@res ,@(map [list car.u _] lst)))))
   lst () ))

(def table (a b f)
  (prn "\n====")
  (each (a b) (perm (list a b))
    (prf "#a : #b => ~ \n" (f a b))))

2008-03-23

ArcでL-99 (P41c ゴールドバッハ予想をリスト表示)

| 08:17 | ArcでL-99 (P41c ゴールドバッハ予想をリスト表示) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P41c ゴールドバッハ予想をリスト表示) - わだばLisperになる

前回のものをさらにひねって、2〜3000の範囲で該当するものが何件あるかと求めよ、とのこと。

目視で数えるのはアレなので、数えるプログラムを書いてみました。

(goldbach-list/c 2 3000 50)
;=> 10

(def goldbach-list/c (start end limit)
  (count (fn ((x y)) (< limit (min x y)))
         (trues goldbach (range start end))))

ArcでL-99 (P41b ゴールドバッハ予想をリスト表示)

| 08:17 | ArcでL-99 (P41b ゴールドバッハ予想をリスト表示) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P41b ゴールドバッハ予想をリスト表示) - わだばLisperになる

前回は範囲をそのまま出力するものでしたが、ちょっとひねって、50より大きいものだけを出力するというものです。

ちょっと改造して終了。

(goldbach-list/b 1 3000 50)
;=> 992 = 73 + 919
;   1382 = 61 + 1321
;   1856 = 67 + 1789
;   1928 = 61 + 1867
;   2078 = 61 + 2017
;   2438 = 61 + 2377
;   2512 = 53 + 2459
;   2530 = 53 + 2477
;   2618 = 61 + 2557
;   2642 = 103 + 2539

(def goldbach-list/b (start end limit)
  (each p (range start end)
    (whenlet (x y) (goldbach p)
      (when (< 50 (min x y))
        (prf "#p = #x + #y\n")))))

2008-03-22

ArcでL-99 (P41a ゴールドバッハ予想をリスト表示)

| 01:10 | ArcでL-99 (P41a ゴールドバッハ予想をリスト表示) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P41a ゴールドバッハ予想をリスト表示) - わだばLisperになる

今回のお題は、ある数値の範囲を与え、その範囲のゴールドバッハ予想をリスト表示するというものです。

前回定義したgoldbachを使用します。

おまけの質問があるのですが、それは、P41bということで次回に解答することにしました。

(goldbach-list 9 20)
;=> 10 = 3 + 7
;   12 = 5 + 7
;   14 = 3 + 11
;   16 = 3 + 13
;   18 = 5 + 13
;   20 = 3 + 17

(def goldbach-list (start end)
  (each a (range start end)
    (whenlet (x y) (goldbach a)
      (prf "#a = #x + #y\n"))))

2008-03-21

ArcでL-99 (P40 ゴールドバッハ予想)

| 01:10 | ArcでL-99 (P40 ゴールドバッハ予想) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P40 ゴールドバッハ予想) - わだばLisperになる

Wikipediaによれば、一般的には、6以上の偶数は、2つの奇素数の和で表わすことができる、という予想らしいのですが、この問題では、2より大きい偶数は2つの素数の和で表わせる、という説明になっています。

ということで、一応お題の定義の方で作成してみました。

(goldbach 88888888888)
;=> (29 88888888859)

(def goldbach (n)
  (point RETURN
    (if (or odd.n (> 4 n))
        RETURN.nil
        ((afn (i)
           (let j (- n i)
             (when prime.j
               (RETURN:list i j)))
           (self next-prime.i))
         2)))))