Comment detail

METHINKS IT IS A WEASEL (Nested Flatten)
派生文字列の生成方法を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
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))

Index

Feed

Other

Link

Pathtraq

loading...