METHINKS IT IS A WEASEL
Posted feedbacks - Scheme
派生文字列の生成方法を３パターン作ってみました。 これなら収束します。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | (use srfi-1)
(use srfi-27)
(define GOAL "METHINKSITISAWEASEL")
(random-source-randomize! default-random-source)
(define random-char (lambda ()
(let ((str "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
(string-ref str (random-integer (string-length str))))))
(define make-element (lambda ()
(let loop ((n (string-length GOAL)) (ret '()))
(if (<= n 0)
(list->string ret)
(loop (- n 1) (cons (random-char) ret))))))
(define make-element-list (lambda ()
(let loop ((n 300) (ret '()))
(if (<= n 0) ret
(loop (- n 1) (cons (make-element) ret))))))
(define check-element (lambda (e)
(fold + 0 (map
(lambda (x y) (abs (- (char->integer x) (char->integer y))))
(string->list e)
(string->list GOAL)))))
(define sort-element-list (lambda (ls)
(sort ls (lambda (x y) (< (check-element x) (check-element y))))))
(define make-mutant-1 (lambda (e)
(let ((mutant (string-copy e)))
(string-set! mutant (random-integer (string-length e)) (random-char)))))
(define make-mutant-2 (lambda (e)
(let* ((mutant (string-copy e))
(i (random-integer (string-length e)))
(ci (- (char->integer (string-ref e i)) 1)))
(string-set! mutant i
(if (< ci (char->integer #\A)) #\Z (integer->char ci))))))
(define make-mutant-3 (lambda (e)
(let* ((mutant (string-copy e))
(i (random-integer (string-length e)))
(ci (+ (char->integer (string-ref e i)) 1)))
(string-set! mutant i
(if (< (char->integer #\Z) ci) #\A (integer->char ci))))))
(define main (lambda (args)
(let loop ((count 0) (ls (sort-element-list (make-element-list))))
(print count ":" (car ls))
(if (string=? (car ls) GOAL)
(begin (display "OK!") (newline))
(loop (+ count 1)
(take (sort-element-list
(fold
(lambda (x ret)
(cons (make-mutant-1 x)
(cons (make-mutant-2 x)
(cons (make-mutant-3 x)
ret))))
'() ls)) 300))))
0))
|
Gauche で書きました。他の方も書いていらっしゃるように単純に変異を起こすだけでは n = 3 ではなかなか収束しません。上位のものを交叉するなどの工夫が必要でしょう。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 | (use srfi-1)
(use srfi-27)
(use srfi-42)
(use srfi-43)
(define random-upper-alphabet
(let* ((s "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
(n (string-length s)))
(lambda ()
(string-ref s (random-integer n)))))
(define (mutate v)
(let ((v* (vector-copy v)))
(vector-set! v* (random-integer (vector-length v)) (random-upper-alphabet))
v*))
(define (similarity v1 v2)
(vector-fold (lambda (_ knil c1 c2)
(+ knil (if (char=? c1 c2) 1 0)))
0 v1 v2))
(define (sort-by xs f)
(map car (sort (map (lambda (x) (cons x (f x))) xs)
(lambda (a b) (negative? (compare (cdr a) (cdr b)))))))
(define (main args)
(random-source-randomize! default-random-source)
(let ((goal (list->vector (string->list "METHINKSITISAWEASEL"))))
(let search ((candidates
(list-tabulate 300
(lambda (_)
(vector-ec (: _ (vector-length goal))
(random-upper-alphabet))))))
;#?=(similarity (car candidates) goal)
(if (equal? (car candidates) goal)
0
(search
(take (sort-by
(append-map! (lambda (v)
(list-ec (: _ 3) (mutate v)))
candidates)
(lambda (v)
(- (similarity v goal))))
300))))))
|
ytakenaka
#6287()
Rating4/8=0.50
ランダムな文字からMETHINKS IT IS A WEASELを作るプログラムを作れ。
簡単に流れを書いてみます。
１：ランダムな２０文字を持つ文字列をもった３００個作ります。
２：その文字列が"METHINKSITISAWEASEL"に近いものからソートします。
３：それぞれの文字列のなか1文字を別の文字に変化させたものを３つ用意します。
４：それを２：のソートをして上位３００個残す。（９００個あるうちで上位３００個残すということです。）
５：以後３：と４：を繰り返す。
ランダムな文字変化は大文字だけでいいです。簡単にするために空白文字を外してあります。
METHINKS IT IS WEASELができたら終了。３と4の間でソートしたもので一番上位のものを毎回表示させると変化が楽しめます。:-)
Rickard Dawkinsがブラインドウォッチメイカー(現題：盲目の時計職人）の３章で書いていた有名なものです。さらに一般化してもらってもいいです。
参考
[ reply ]