METHINKS IT IS A WEASEL in Perl DouKaku?

ランダムな文字からMETHINKS IT IS A WEASELを作るプログラムを作れ。

簡単に流れを書いてみます。

１：ランダムな２０文字を持つ文字列をもった３００個作ります。

２：その文字列が"METHINKSITISAWEASEL"に近いものからソートします。

３：それぞれの文字列のなか1文字を別の文字に変化させたものを３つ用意します。

４：それを２：のソートをして上位３００個残す。（９００個あるうちで上位３００個残すということです。）

５：以後３：と４：を繰り返す。

ランダムな文字変化は大文字だけでいいです。簡単にするために空白文字を外してあります。

METHINKS IT IS WEASELができたら終了。３と4の間でソートしたもので一番上位のものを毎回表示させると変化が楽しめます。:-)

Rickard Dawkinsがブラインドウォッチメイカー(現題：盲目の時計職人）の３章で書いていた有名なものです。さらに一般化してもらってもいいです。

参考

http://home.pacbell.net/s-max/scott/weasel.html (JAVA アプレット)
http://en.wikipedia.org/wiki/Weasel_program

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

#!/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";

密かに20文字じゃなくて19文字じゃないかと。。。。ちょっと無駄なところを省いて動いています。 perlが入っていれば第一引数の任意の文字列で同じことができます。(コマンドライン|ターミナル)からも動くので遊んでみてください。正規表現で最初点数つけていたのですがまったく速度的に異常なことに.... いろいろ考えさせてもらって楽しかったですytakenakaさんありがとう!!

use strict;

my $goal = uc(@ARGV[0]) || q{METHINKSITISAWEASEL};

my @table;
     # $table[$id]->[0] 文字列
     # $table[$id]->[1] 近似スコア
my $total_calc;
     #キャッシュ数
my $cash = 3; 


$|=1; # 計算途中に結果を見たいのでバッファオフ


INIT: 
      #@tableに300個ランダムな文字列を生成
    for my $id (0..299){
     my @alpha = ("A".."Z");
      for(0..(length($goal)-1)){
        $table[$id]->[0] .= $alpha[int rand(26)];
      }
    }
    
BEGIN:
    ++$total_calc;
    
        #各項目を1文字何かに変えて$cash数分配
    for my $cnt (0..$#table){
     for(1..$cash) {
     $table[$cnt + $_ * 300] = [one_chr_enig($table[$cnt]->[0]),undef];
     }
    }
        #各項目を点数化 0 -> undef
    @table = set_score(@table);
        # 順列にソート
    @table = sort{$b->[1]<=>$a->[1]} @table;
        #@tabel の299以下の要素を切り捨てる
    $#table = 299;

        #結果出力
    print ($table[0]->[0]
              .  q{ (score) : } . $table[0]->[1]
              .  q{ (steps) : } ." $total_calc  \n"
          );
    
unless($table[0]->[1] == length($goal))
 {goto BEGIN};

    #計算結果を算出    
sub set_score {
   my @table = @_;
         for (0..$#table){
              my $str = $table[$_]->[0];
              my @pre =split//,$goal;
              my $score = undef;
                for (0..(length($goal)-1)){
                  if (substr($str, $_, 1) eq $pre[$_]){
                   ++$score;
                  }
                }
              $table[$_]->[1] = $score;
         }
  return @table;
}

    #与えた文字列をランダムに一文字交換
sub one_chr_enig {
  my @str = split//,shift;
  my @alpha = ("A".."Z");
  $str[int rand(length($goal))] =  $alpha[int rand(26)];
  return join("",@str);
}

訂正

    #与えた文字列をランダムに一文字交換
sub one_chr_enig {
  my @str = split//,shift;
  my @alpha = ("A".."Z");
  $str[int rand(length($goal))] =  $alpha[int rand(26)];
  return join("",@str);
}

よりも下記のほうが俄然早いです。

    #与えた文字列をランダムに一文字交換
sub one_chr_enig {
  my $str = shift;
  my @alpha = ("A".."Z");
  substr($str,int rand(length($goal)),1) = $alpha[int rand(26)];
  return $str;
}

DouKaku?

METHINKS IT IS A WEASEL

Posted feedbacks - Perl

Index

Feed

Other

Link

Pathtraq