Project EulerをSchemeで(26-30)

1ヶ月ほどご無沙汰してたけど、Kyoto.lispにも行ってきたことだし、もっとLisp勉強しよう。
今度参加するときはLT出来るようにネタを作っときたいな。


今回からGaucheのver.が0.9.2->0.9.3になりました。
iotaがコアに入って楽、という程度の使いこなしなんですがね…

(use srfi-1)

(define (primes n)
  (if (<= n 2)
      '()
      (let1 u (truncate (sqrt n))
        (let loop ((ps '(2))
                   (l (unfold (cut < n <>) values (cut + 2 <>) 3)))
          (let1 m (car l)
            (if (> m u)
                (append (reverse ps) l)
                (loop (cons m ps)
                      (remove (^(x) (zero? (modulo x m)))
			      l))))))))

(define (integer->list i)
  (letrec ((i->rl (^(i) (cons (modulo i 10)
			      (if (< i 10)
				  '()
				  (i->rl (quotient i 10)))))))
    (reverse (i->rl i))))

問26.

d < 1000 なる 1/d の中で循環節が最も長くなるような d を求める問題

; 小数部の循環 <=> 余りの循環 なので同じ余りが出るまで計算すればよい
; また, p / q の余りは0 ~ q-1の範囲なので, 循環節の長さは最大でq
; よって大きいnから調べ, それまでの最大値よりもnが小さくなれば計算を終了できる
(define (e26)
  (define (recurring-length n)
  (let1 v (make-vector n #f)
    (vector-set! v 1 0)
    (let loop ((p 1) (c 0))
      (if (< p n)
	  (loop (* p 10) (+ c 1))
	  (let1 r (remainder p n)
	    (if (zero? r)
		0
		(if (vector-ref v r)
		    (- c (vector-ref v r))
		    (begin (vector-set! v r c)
			   (loop (* r 10) (+ c 1))))))))))
  (let loop ((n 999) (ans '(0 0)))
    (if (< n (cadr ans))
	(car ans)
	(loop (- n 1) (let1 len (recurring-length n)
			(if (< (cadr ans) len)
			    (list n len)
			    ans))))))

問27.

n^2 + an + b のnに連続した整数を与えて素数を生成するとき、その長さが最大となるようなa, bを求める問題

; f(n) = n^2 + an + b とすると
; f(0) = b, f(1) = a + b + 1
; ∴ b: 素数, a + b + 1: 素数 と考えて良い
; また, b = 2 のときを考えると
; f(2) = 2^2 + 2a + 2 となり,
; これは明らかに2以上の偶数なので, bは3以上の素数と考えて良い
; またこのとき, aは奇数となる
(define (e27)
  (let ((v (make-vector 1000000 #f))
	(ps_1000 (primes 1000)))
    (for-each (cut vector-set! v <> #t) (primes 1000000))
    ((^(ans) (* (car ans) (cadr ans)))
     (fold
      (^(val prev) (if (> (caddr val) (caddr prev)) val prev))
      '(0 0 0)
      (append-map
       (^(a)
	 (map (^(b)
		(list a b (length
			   (take-while
			    (^(n) (let1 y (+ (* n n) (* a n) b)
				    (and (positive? y) (vector-ref v y))))
			    (iota b)))))
	      ps_1000))
       (iota 1000 -999 2))))))

問28.

ルールに従って作成した1001×1001の升目の、対角線上の数字の合計を求める問題

; 1周毎の四隅の合計を足し続ける
(define (e28)
  (let loop ((sides 1) (pos 1) (ans 1) (d 2))
    (if (= sides 1001)
	ans
	(loop (+ sides 2)
	      (+ pos (* 4 d))
	      (+ ans (* 4 pos) (* 10 d))
	      (+ d 2)))))

問29.

a^bを 2<=a<=100, 2<=b<=100 で動かしたときに何種類の数字が生成されるか求める問題

; 力押し
(define (e29)
  (length (delete-duplicates
	   (append-map
	    (^(a)
	      (map (^(b)
		     (expt a b))
		   (iota 99 2)))
	    (iota 99 2)))))

問30.

各桁を5乗した数の和が元の数と一致するような数の総和を求める問題

; そのまんま
(define (e30)
  (let1 max-e (* 5 (expt 9 5))
    (apply + (filter-map
	      (^(n) (and (= n (apply + (map (cut expt <> 5)
					    (integer->list n))))
			 n))
	      (iota (- max-e 1) 2)))))

Clojureでスクレイピングしてみる - 並列ver.

前回の並列化ver.が思いの外簡単にできたので。


参加者の一覧を取得した後、並列でtwitterのURLを取得する(parallel-get-twitter-url*1の部分)ように変更。
他はprintlnの場所を変えただけ。

(ns hoge.core
  (:use [net.cgrand.enlive-html]))
(import 'java.net.URL)

(defn get-members
  "ATNDのイベントidを引数に参加者のプロフィールURLのリストを返す"
  [eid]
  (map #(str "http://atnd.org" (get-in % [:attrs :href]))
       (-> (str "http://atnd.org/events/" eid) URL.
           html-resource (select [:section#members-join :a]))))

(defn get-twitter-url
  "ATNDプロフィールURLを引数にtwitterのURLを取得(無ければnil)して印字"
  [p-url]
  (println
   (get-in (first (filter #(-> % :attrs :href (.startsWith "http://twitter.com"))
                          (-> p-url URL.
                              html-resource (select [:div#users-show-info :a]))))
           [:attrs :href])))

(defn parallel-get-twitter-url
  "並列でget-twitter-urlを呼び出す"
  [urls]
  (let [threads (doall (map #(future (get-twitter-url %)) urls))]
    (doall (map deref threads))))

(defn -main
  "ATNDのイベント番号を引数に参加者のtwitterのURLを表示する"
  [event-id]
  (parallel-get-twitter-url (get-members event-id))
  (System/exit 0))


実行する。

$ lein run 27149
http://twitter.com/bouzuya
http://twitter.com/emanon001
http://twitter.com/ponkore
http://twitter.com/keiskS
http://twitter.com/camomileo
http://twitter.com/nomnel
http://twitter.com/manjilab
nil
http://twitter.com/mid_f
http://twitter.com/farvel
http://twitter.com/d_e_k_o_p_o_n
http://twitter.com/taki__taki__
http://twitter.com/rika_t
http://twitter.com/sawam___
http://twitter.com/toshi_a
http://twitter.com/memememomo
http://twitter.com/nitro_idiot
http://twitter.com/murase_syuka
http://twitter.com/_yuu_k
http://twitter.com/Kuchitama

早い…!圧倒的…!
nilも入っちゃったけど、まぁ。

*1:ひどい名前

Clojureでスクレイピングしてみる

Clojureの勉強会に参加するので、勉強がてら参加者のtwitterのURL一覧を取得するスクリプトを書いてみた。


([@2012/4/20 14:40] lein run のようにシェルから実行出来るように書き換えました)
まず、Leiningenでプロジェクトを作成する。

lein new hoge
cd hoge

enlive(スクレイピング用)を使いたいのでproject.cljに以下のように記述。

(defproject hoge "1.0.0-SNAPSHOT"
  :description "FIXME: write description"
  :dependencies [[org.clojure/clojure "1.3.0"]
                 [org.clojure/clojure-contrib "1.2.0"]
                 [enlive "1.0.0"]]
  :main hoge.core)

で、

lein deps

とやると依存関係の解決とか必要なファイルの取得とかをLeiningenがやってくれる(らしい)。


後はhoge/src/hoge/core.cljに本体を記述していく。

(ns hoge.core
  (:use [net.cgrand.enlive-html]))
(import 'java.net.URL)

(defn get-members
  "ATNDのイベント番号を引数に参加者のプロフィールURLのリストを返す"
  [eid]
  (map #(str "http://atnd.org" (get-in % [:attrs :href]))
       (-> (str "http://atnd.org/events/" eid) URL.
           html-resource (select [:section#members-join :a]))))

(defn get-twitter-url
  "ATNDプロフィールURLを引数にtwitterのURLを返す(無ければnil)"
  [p-url]
  (get-in (first (filter #(-> % :attrs :href (.startsWith "http://twitter.com"))
                         (-> p-url URL.
                             html-resource (select [:div#users-show-info :a]))))
          [:attrs :href]))

(defn -main
  "ATNDのイベント番号を引数に参加者のtwitterのURLを表示する"
  [event-id]
  (apply println (map get-twitter-url (get-members event-id))))

へ、並列化はまた勉強します…><


で、

lein run 27149

のように http;//atnd.org/events/を引数に実行すると

http://twitter.com/mid_f http://twitter.com/Kuchitama http://twitter.com/_yuu_k http://twitter.com/bouzuya http://twitter.com/emanon001 http://twitter.com/taki__taki__ http://twitter.com/murase_syuka http://twitter.com/d_e_k_o_p_o_n http://twitter.com/keiskS http://twitter.com/nitro_idiot http://twitter.com/nomnel http://twitter.com/ponkore http://twitter.com/toshi_a nil http://twitter.com/manjilab http://twitter.com/camomileo http://twitter.com/sawam___ http://twitter.com/memememomo http://twitter.com/rika_t http://twitter.com/farvel

と出力される。
あれ、改行されてないけど


今度は自動でtwitterのリスト作成するとこまで出来るようにしたいなぁ。

Delphiでグリッドに列を挿入する

環境はDelphi 6。
グリッドはとりあえずTStringGridを使う。


プログラム中でグリッドに列を挿入したいとき、

procedure InsertCol(G: TStringGrid; c: Integer);
var
    i, j: Integer;
begin
    G.ColCount := G.ColCount + 1;

    for i := G.ColCount - 1 downto c + 1 do
        for j := G.FixedRows to G.RowCount - 1 do
            G.Cells[i, j] := G.Cells[i - 1, j];
end;

みたいに自分で列のデータを移動したりするのは面倒だし、グローバルにこの関数を置きたくない。


まず、自分で列のデータを移動するのは面倒という話。
そもそもドラッグで列移動できるのに、それ用のメソッドが無いわけない。
それがこれ。

procedure TCustomGrid.MoveColumn(fromCol, toCol: Integer);

ただし、protected。
つまり、このメソッドを使うためにはTCustomGridを継承したコンポーネントを新たに作らなければならない。
すると、新たに作ったコンポーネントをパレットに追加しなければならない。
それは、嫌だ。


プログラム中で継承すればいい。

type
    TExGrid = class(TStringGrid)
    public
        procedure InsertCol(c: Integer);
    end;

として、実際の呼び出しには

procedure Test(G: TStringGrid);
begin
    TExGrid(G).InsertCol;
end;

のようにダウンキャストしてやればよい。
「グローバルにあの関数を置きたくない」はこれで解決。


メソッドの実装は簡単に*1こんな感じになる。

procedure TExGrid.InsertCol(c: Integer);
begin
    ColCount := ColCount + 1;

    MoveColumn(ColCount - 1, c);
end;

「自分で列のデータを移動するのは面倒」も解決した。


ちなみに他にも

procedure DeleteRow(ARow: Integer);
procedure DeleteColumn(ACol: Integer);
procedure MoveRow(fromRow, toRow: Integer);

などがprotectedで隠されている。

*1:引数のチェックやらグリッドの選択領域の処理やらは省略

sxpathが分かりにくかった

sxpathが分かりにくかったのでメモ。

使い方

まず、sxpathは関数を返す

gosh> (sxpath '())
#<closure (sxpath loop)>

ので使うときはこんな感じになる。(以下でshtmlはSHTMLデータとする)

(use sxml.sxpath)

((sxpath '(html head title)) shtml)

クエリ

上で'(html head title)としたようにクエリを与えて目的のデータを取得する。
この例だと「html要素の直下にあるhead要素の直下にあるtitle要素」を取得できる。
他にも

((sxpath '(// (div (@ class (equal? "hoge"))) *)) shtml)

でshtml内の、「class属性の値がhogeであるdiv要素の全ての子ノード」を取得できる。
記号の意味はそれぞれ、

  • //:そのノード自身と全ての子孫ノード
  • @:属性リスト
  • *:任意の要素(属性リストやテキストノードは含まない)。

また、括弧で条件が指定できて、上の例だと
「全てのノードを取り出す(//)」→「その中でdiv要素なものを取り出す」→「その中でclass属性を持つものを取り出す」→「その中で値がhogeであるものを取り出す」
の様に適用されている。
(「sxpathがとてもわかりにくい - 再帰の反復blog」で丁寧に解説されている)

XPath

クエリにはXPathを使うこともできる。
SXPathと比較して書くと以下の様になる。

; SXPath
((sxpath '(// (div (@ id (equal? "content"))))) shtml)
;XPath
((sxpath "//div[@id='content']") shtml)

; SXPath
((sxpath '(// h2 *text*)) shtml)
;XPath
((sxpath "//h2/text()") shtml)

; SXPath
((sxpath '(// (div (@ title)) *text*)) shtml)
;XPath
((sxpath "//div[@title]/text()") shtml)

; SXPath
((sxpath '(// (div (@ class (equal? "problem_content"))) *)) shtml)
;XPath
((sxpath "//div[@class='problem_content']/*") shtml)

個人的にはXPathの方が読みやすいので好み。

継続を理解するために見たページ達

メモ的に列挙。ありがとうございます。


継続の概念
http://practical-scheme.net/docs/cont-j.html


継続渡し形式
http://practical-scheme.net/docs/cont-j.htmlhttp://practical-scheme.net/wiliki/wiliki.cgi?Scheme%3A%E4%BD%BF%E3%81%84%E3%81%9F%E3%81%84%E4%BA%BA%E3%81%AE%E3%81%9F%E3%82%81%E3%81%AE%E7%B6%99%E7%B6%9A%E5%85%A5%E9%96%80


call/cc
http://practical-scheme.net/wiliki/wiliki.cgi?Scheme%3A%E3%81%AA%E3%81%9CScheme%E3%81%AB%E3%81%AFreturn%E3%81%8C%E7%84%A1%E3%81%84%E3%81%AE%E3%81%8Bhttp://practical-scheme.net/wiliki/wiliki.cgi?Scheme%3A%E4%BD%BF%E3%81%84%E3%81%9F%E3%81%84%E4%BA%BA%E3%81%AE%E3%81%9F%E3%82%81%E3%81%AE%E7%B6%99%E7%B6%9A%E5%85%A5%E9%96%80


部分継続
http://practical-scheme.net/wiliki/wiliki.cgi?Scheme%3A%E4%BD%BF%E3%81%84%E3%81%9F%E3%81%84%E4%BA%BA%E3%81%AE%E3%81%9F%E3%82%81%E3%81%AE%E7%B6%99%E7%B6%9A%E5%85%A5%E9%96%80部分継続チュートリアル


おまけ
クロージャとcall/ccの違い
http://blog.practical-scheme.net/shiro?20090306a-return-and-callcc

クロージャ→静的環境のキャプチャ、call/cc→動的環境のキャプチャ

Project EulerをSchemeで(21-25)

今回は問21から問25の5問。処理系はGauche
そういえば25問解いたのは全体の18%しか居ないらしい…


まずはユーティリティ関数とか。factorizeはに定義したのとちょっと変えてたり。

(use srfi-1)

;; Sieve of Eratosthenes                                                                                                
; (primes 10) => (2 3 5 7)                                                                                              
(define (primes n)
  (if (<= n 2)
      '()
      (let1 u (truncate (sqrt n))
        (let loop ((ps '(2))
                   (l (unfold (cut < n <>) values (cut + 2 <>) 3)))
          (let1 m (car l)
            (if (> m u)
                (append (reverse ps) l)
                (loop (cons m ps)
                      (remove (lambda (x) (zero? (modulo x m))) l))))))))

; (factorize 20 '(2 3 5 7)) => ((2 2) (5 1))                                                                            
(define (factorize n ps)
  (map (lambda (p)
         (let loop ((n (/ n p)) (c 1))
           (if (zero? (modulo n p))
               (loop (/ n p) (+ c 1))
               (list p c))))
       (filter (lambda (p) (and (<= p n) (zero? (modulo n p))))
               ps)))

;; sum of proper divisor                                                                                                
; (D 12 '(2 3 5)) => 16 ;(+ 1 2 3 4 6)                                                                                  
; (D 11 '(2 3 5)) => 1                                                                                                  
(define (D n ps)
  (let1 d (apply * (map
                    (lambda (l) (apply + (map (cut expt (car l) <>)
                                              (iota (+ 1 (cadr l))))))
                    (factorize n ps)))
    (- d (if (= d 1) 0 n))))

問21.

10000未満の友愛数の合計を求める問題。

(define (e21)
  (let1 ps (primes 5000)
    (apply + (filter (lambda (a) (let1 b (D a ps)
                                   (and (not (= a b))
                                        (= a (D b ps)))))
                     (iota 9998 2)))))

問22.

指定のテキストファイル中の全名前のスコア(指定の方法で算出)の合計を求める問題。

(use gauche.sequence)

(define (e22)
  (define (score s)
    (apply + (map (lambda (c) (- (char->integer c) 64))
                  (string->list s))))
  (apply + (map-with-index (lambda (i s) (* (+ 1 i) (score s)))
                           (sort (map (lambda (s) (substring s 1 (- (string-length s) 1)))
                                      (string-split (call-with-input-file "./names.txt" read-line) ","))
                                 string<?))))

問23.

2つの過剰数の和で書き表せない正の整数の総和を求める問題。
過剰数の和で書ける = その数から過剰数を引くと過剰数になるような過剰数のペアがある
初めは過剰数の判定にリスト(al)で比較していたけど、処理が全く終わらないのでベクタを使用。

(define (e23)
  (let* ((m 28123)
         (ps (primes (quotient m 2)))
         (fv (make-vector (+ m 1) #f))
         (al (filter (lambda (n) (< n (D n ps)))
                     (iota m 1))))
    (for-each (cut vector-set! fv <> #t) al)
    (apply + (remove (lambda (x)
                       (any (lambda (y) (vector-ref fv (- x y)))
                            (filter (cut > x <>) al)))
                     (iota m 1)))))

問24.

0,1,2,3,4,5,6,7,8,9からなる順列を辞書式に並べたときの100万番目を求める問題。
permutations-for-eachで順番にアクセスして100万番目で終了するにはcall/ccを使うとよいみたい。
けどまだ勉強不足なので今回は使えない。
総数は高々10!通り(3,628,800通り)なのでpermutationsで全て生成して100万番目を取得。

(use util.combinations)

(define (e24)
  (list-ref (permutations (iota 10)) (- 1000000 1)))

(追記)

という理解でcall/cc使うと

(define (e24-call/cc)
  (let1 c 1
    (call/cc (lambda (return)
               (permutations-for-each (lambda (n)
                                        (when (= c 1000000) (return n))
                                        (inc! c))
                                      (iota 10))))))

ってなります。

問25.

フィボナッチ数列において1000桁になる最初の項の番号を求める問題。

(define (e25)
  (let1 goal (expt 10 999)
    (let loop ((a 1) (b 1) (n 3))
      (let1 c (+ a b)
        (if (< goal c)
            n
            (loop b c (+ 1 n)))))))