「リストの内容比較」を解いてみる

お題：リストの内容比較 - No Programming, No Lifeを解いてみた。

なんか思ったよりすっきり書けませんでした orz

「ランダム文字列」をGaucheで解いてみる

お題：ランダム文字列 - No Programming, No Lifeを書いてみる。

すっきり。#[\w]は文字集合、\wは単語を構成する文字の集合でa-zA-Z_。#[a-zA-Z0-9_]でもいいかな。

char-set->stringで文字集合を文字列に変換するためにsrfi-14

文字列をshuffleでシャッフルするのにgauche.sequence

16文字抜き打すのにsrfi-13のstring-takeを使っています。

追記

さっき

(use gauche.sequence)
(use srfi-13)
(use srfi-14)
(string-take (shuffle (char-set->string #[a-zA-Z0-9_])) 16)

こんなの書いてましたが誤りです。これだと同じ文字が2連続しない。ランダムではない。恥ずかしい。

これでどうだ!

(use gauche.sequence)
(use srfi-14)
(use srfi-42)
(string-ec (: i 16) (~ (shuffle (char-set->string #[a-zA-Z0-9_])) 0))

また追記

実行時間をはかろうとしてtimeしたら

gosh> (time (length '(1 2 3)))
 ERROR: failed to link /usr/local/Cellar/gauche/0.9.2/lib/gauche-0.9/0.9.2/i386-apple-darwin11.0.1/gauche--auxsys.so dynamically: dlopen(/usr/local/Cellar/gauche/0.9.2/lib/gauche-0.9/0.9.2/i386-apple-darwin11.0.1/gauche--auxsys.so, 10): Symbol not found: _environ
Referenced from: /usr/local/Cellar/gauche/0.9.2/lib/gauche-0.9/0.9.2/i386-apple-darwin11.0.1/gauche--auxsys.so
Expected in: flat namespace
in /usr/local/Cellar/gauche/0.9.2/lib/gauche-0.9/0.9.2/i386-apple-darwin11.0.1/gauche--auxsys.so
Stack Trace:
_______________________________________
0  (sys-times)
[unknown location]

こんな表示が。

後でググろう…

さっきのだと遅いかな、と思って書き直してみた

実行時間をはかる。

前のをちょっと変えたのをa.scmと今のをb.scmに書いて実行する

前の

a.scm

(use gauche.sequence)
(use srfi-14)
(use srfi-42)
(dotimes (n 1000)
(let ((src (char-set->string #[a-zA-Z0-9_])))
(string-ec (: i 16) (~ (shuffle src) 0))))

$ time gosh a.scm

real	0m1.475s
user	0m1.463s
sys	0m0.010s

今の

b.scm

(use srfi-14)
(use srfi-27)
(use srfi-42)
(dotimes (n 1000)
(let* ((src (char-set->string #[a-zA-Z0-9_]))
(src-len (string-length src)))
(string-ec (: i 16) (~ src  (random-integer src-len)))))

$ time gosh b.scm

real	0m0.105s
user	0m0.098s
sys	0m0.006s

もっといい方法があるに違いない。

「文字列を先頭から見て同じところまで除去」をGaucheで解いてみた

お題：文字列を先頭から見て同じところまで除去 - No Programming, No Life

をGaucheで解いてみた。多分0.9じゃないと動かないです。

とりあえずこんな感じです
(use srfi-13)
(define (q . los)
(map (^s (string-drop s (apply min (map (^s (string-prefix-length (car los) s)) los)))) los))

2011-08-14 00:22:07 via YoruFukurou

つぶやける長さになった!



学校卒業するまでの間はSchemeいっぱい書いて生きたい。

追記

あまりにも説明なさ過ぎな気がしたのでちょっとだけ説明も書いてみる。

後述するstring-prefix-lengthっていう便利な関数を使うため(use srfi-13)でSchemeのライブラリsrfi-13を読み込む。

(define (q . los) ～)のように書くとqに渡された引数が全て入ったリストがlosに束縛される。

qの中身を内側から見て行く。

srfi-13に用意されているstring-prefix-lengthを使うと2つの文字列の先頭から見て同じとこまでの長さが得られる。

(map (^s (string-prefix-length (first los) s)) los)

(^s ～)は(lambda (s) ～)のシンタックスシュガー、Gaucheの機能。

mapを使ってlosの全ての文字列sとlosの最初の文字列、2つの文字列の「先頭から見て同じとこまでの長さ」のリストを得る。

(apply min ～)でもっとも短い「先頭から見て同じとこまでの長さ」を取り出す。

そしてstring-dropでlosの全ての文字列sから、もっとも短い「先頭から見て同じとこまでの長さ」の分の文字を取り除く。

そんな流れです。

自分の理解を助けるためにも、もう一度さっくりまとめると

• 2つの文字列の「先頭から見て同じとこまでの長さ」を返す便利な関数、string-prefix-lengthがsrfi-13で定義されてるのでそれを使う。


• 関数に渡された全ての引数(文字列)をリストとして受け取る


• 全ての文字列と最初に渡された文字列との「先頭から見て同じとこまでの長さ」を求める


• 一番短い「先頭から見て同じとこまでの長さ」まで文字を取り除いた文字列を返す。

以上です。まじめに書こうとすると日本語難しい。

追記

何も考えず別解。



引数の中に空文字列か、先頭の1文字が他のと同じでない文字列があったら引数をそのまま返す。

それ以外の場合は引数の文字列を先頭から1文字取り除いて再帰

再帰! 再帰!

テストの件

id:yamanetoshi さんのところでgauche.testについて触れられてたので自分でも試行錯誤してみた。

gauche.test の件 - /var/log/messages

GWなのでよく理解しないままマクロでコネコネした結果こうなったとさ。

f-testでテストしたい関数fと[answer args ...]のリストをつらつら書くとargs ...をfに与えた時の結果がanswerと一緒かテストしてくれます。ついでなんで関数名でtest-sectionも吐くように。argsは勝手にquoteするようにしてみた。でもこれだと数がargsやanswerな時まずいかもなぁ。まぁいっか。後で考える。

(use gauche.test)
(add-load-path ".")
(load "func")

(define-syntax test-q&a (syntax-rules () ((_ q a) (test* (quote q) a q))))
(define-syntax f-test
(syntax-rules ()
((_ f (a args ...) ...)
(begin
(test-section (symbol->string (quote f)))
(test-q&a (f (quote args) ...) (quote a)) ...))))

(test-start "chapter 3")

(f-test
rember
[(lamb chops and jelly) mint (lamb chops and mint jelly)]
[(lamb chops and flavored mint jelly) mint (lamb chops and mint flavored mint jelly)]
[(bacon lettuce and tomato) toast (bacon lettuce and tomato)]
[(coffee tea cup and hick cup) cup (coffee cup tea cup and hick cup)]
[(lettuce and tomato) bacon (bacon lettuce and tomato)]
[(bacon lettuce tomato) and (bacon lettuce and tomato)]
[(soy and tomato sauce) sauce (soy sauce and tomato sauce)])

(f-test
firsts
[(apple plum grape bean) ((apple peach pumpkin)
(plum pear cherry)
(grape raisin pea)
(bean carrot eggplant))]
[(a c e) ((a b) (c d) (e f))]
[() ()]
[(five four eleven) ((five plums) (four) (eleven green oranges))]
[((five plums) eleven (no)) (((five plums) four)
(eleven green oranges)
((no) more))])

(f-test
seconds
[(b d f) ((a b)
(c d)
(e f))])

(f-test
insertR
[(ice cream with fudge topping for dessert)
topping fudge (ice cream with fudge for dessert)]
;; Gauche
;; [(tacos tamales and |jalapeño| salsa) |jalapeño| and (tacos tamales and salsa)]
[(tacos tamales and jalapeno salsa) jalapeno and (tacos tamales and salsa)]
[(a b c d e f g d h) e d (a b c d f g d h)])

;; my insertL test
(f-test
insertL
[(ice cream with topping fudge for dessert) topping fudge (ice cream with fudge for dessert)]
[(tacos tamales jalapeno and salsa) jalapeno and (tacos tamales and salsa)]
[(a b c e d f g d h) e d (a b c d f g d h)])

(f-test
subst
[(ice cream with topping for dessert) topping fudge (ice cream with fudge for dessert)])

(f-test
subst2
[(vanilla ice creamwith chocolate topping)
vanilla chocolate banana (banana ice creamwith chocolate topping)])

(f-test
multirember
[(coffee tea and hick) cup (coffee cup tea cup and hick cup)])

;; my multiinsertR test
(f-test
multiinsertR
[(a b c d e f g d e h) e d (a b c d f g d h)]
[(w r y y y y y y y y y y) y y (w r y y y y y)])

(f-test
multiinsertL
[(chips and fried fish or fried fish and fried) fried fish (chips and fish or fish and fried)]
[(j o j o) j o (o o)])

(f-test
multisubst
[(o p p a o) o i (i p p a i)]
[() o i ()])

(test-end)

なんかだ随分寂しい感じ。すっかすか。

実行結果がこれ。diffとったけど普通に最初書いたテストと変わらなかった。

> gosh 3.scm
Testing chapter 3 ...
<rember>-----------------------------------------------------------------------
test (rember 'mint '(lamb chops and mint jelly)), expects (lamb chops and jelly) ==> ok
test (rember 'mint '(lamb chops and mint flavored mint jelly)), expects (lamb chops and flavored mint jelly) ==> ok
test (rember 'toast '(bacon lettuce and tomato)), expects (bacon lettuce and tomato) ==> ok
test (rember 'cup '(coffee cup tea cup and hick cup)), expects (coffee tea cup and hick cup) ==> ok
test (rember 'bacon '(bacon lettuce and tomato)), expects (lettuce and tomato) ==> ok
test (rember 'and '(bacon lettuce and tomato)), expects (bacon lettuce tomato) ==> ok
test (rember 'sauce '(soy sauce and tomato sauce)), expects (soy and tomato sauce) ==> ok
<firsts>-----------------------------------------------------------------------
test (firsts '((apple peach pumpkin) (plum pear cherry) (grape raisin pea) (bean carrot eggplant))), expects (apple plum grape bean) ==> ok
test (firsts '((a b) (c d) (e f))), expects (a c e) ==> ok
test (firsts '()), expects () ==> ok
test (firsts '((five plums) (four) (eleven green oranges))), expects (five four eleven) ==> ok
test (firsts '(((five plums) four) (eleven green oranges) ((no) more))), expects ((five plums) eleven (no)) ==> ok
<seconds>----------------------------------------------------------------------
test (seconds '((a b) (c d) (e f))), expects (b d f) ==> ok
<insertR>----------------------------------------------------------------------
test (insertR 'topping 'fudge '(ice cream with fudge for dessert)), expects (ice cream with fudge topping for dessert) ==> ok
test (insertR 'jalapeno 'and '(tacos tamales and salsa)), expects (tacos tamales and jalapeno salsa) ==> ok
test (insertR 'e 'd '(a b c d f g d h)), expects (a b c d e f g d h) ==> ok
<insertL>----------------------------------------------------------------------
test (insertL 'topping 'fudge '(ice cream with fudge for dessert)), expects (ice cream with topping fudge for dessert) ==> ok
test (insertL 'jalapeno 'and '(tacos tamales and salsa)), expects (tacos tamales jalapeno and salsa) ==> ok
test (insertL 'e 'd '(a b c d f g d h)), expects (a b c e d f g d h) ==> ok
<subst>------------------------------------------------------------------------
test (subst 'topping 'fudge '(ice cream with fudge for dessert)), expects (ice cream with topping for dessert) ==> ok
<subst2>-----------------------------------------------------------------------
test (subst2 'vanilla 'chocolate 'banana '(banana ice creamwith chocolate topping)), expects (vanilla ice creamwith chocolate topping) ==> ok
<multirember>------------------------------------------------------------------
test (multirember 'cup '(coffee cup tea cup and hick cup)), expects (coffee tea and hick) ==> ok
<multiinsertR>-----------------------------------------------------------------
test (multiinsertR 'e 'd '(a b c d f g d h)), expects (a b c d e f g d e h) ==> ok
test (multiinsertR 'y 'y '(w r y y y y y)), expects (w r y y y y y y y y y y) ==> ok
<multiinsertL>-----------------------------------------------------------------
test (multiinsertL 'fried 'fish '(chips and fish or fish and fried)), expects (chips and fried fish or fried fish and fried) ==> ok
test (multiinsertL 'j 'o '(o o)), expects (j o j o) ==> ok
<multisubst>-------------------------------------------------------------------
test (multisubst 'o 'i '(i p p a i)), expects (o p p a o) ==> ok
test (multisubst 'o 'i '()), expects () ==> ok
passed.

f-testとかも適当に名前つけちゃった。どうなんだろこれ。なんか分かりづらくなってしまったような気がしないでもない。