Comment detail

METHINKS IT IS A WEASEL (Nested Flatten)

安直な実装。 派生文字列が3つだとうまく収束しなかったので、10個にしています。

 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
#!/usr/bin/perl

use strict;
use warnings;

my @alphabets = "A" .. "Z";
my @strings   = ();
my $goal      = "METHINKSITISAWEASEL";

sub random_int($) { int rand shift }

sub similarity($) {
    my $str   = shift;
    my $score = 0;

    for ( 0 .. length($str) - 1 ) {
        $score++ if substr( $str, $_, 1 ) eq substr( $goal, $_, 1 );
    }
    return $score;
}

sub derive_string($) {
    my $origin_string   = shift;
    my @derived_strings = ();
    for ( 1 .. 10 ) {
        my $derived_string = $origin_string;
        substr( $derived_string, random_int length $origin_string, 1 ) =
          $alphabets[ random_int @alphabets ];
        push @derived_strings, $derived_string;
    }

    return @derived_strings;
}

for ( 1 .. 300 ) {
    my $string = "";
    $string .= $alphabets[ random_int @alphabets ] for 1 .. length $goal;
    push @strings, $string;
}

my $count = 0;
until ( $strings[0] eq $goal ) {
    my @next_gen = ();
    print $count++, ": ", $strings[0], "\n";
    push @next_gen, derive_string $_ for @strings;
    @strings =
      ( map { $_->[1] }
          sort { $b->[0] <=> $a->[0] } map { [ similarity $_, $_ ] } @next_gen )
      [ 0 .. 299 ];
}

print $count, ": ", $strings[0], "\n";

お題の通りに実装すると収束しませんね。突然変異の確率が高すぎるのが良くないようです。変異する文字数を1にすれば収束しました。(変異がおこる確率をいじるとさらに早く、80世代ほどで終わります)

すいません。問題の設定が甘くて お許しください。

Index

Feed

Other

Link

Pathtraq

loading...