METHINKS IT IS A WEASEL
Posted feedbacks - PostScript
Nemo
#6374()
[
PostScript
]
PostScript で素直に実装してみたのですが、 なかなか収束しないので皆さんと同様、 5個のバリエーションを生成、元の文字列も 残す方向です。
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 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 | %!PS
% ---- Parameters ----------------------------------
/String (ABCDEFGHIJKLMNOPQRSTUVWXYZ) def
/Target (METHINKSITISAWEASEL) def
/NumStrings 300 def
/NumMutations 5 def
/Keep true def
% ---------------------------------------------------
/TargetLength Target length def
/StringLength String length def
/RandomLetter {
String rand StringLength mod get
} bind def
/Diff { % (TargetString) (string) Diff (TargetString) (string) integer
0
0 1 TargetLength 1 sub {
% (str) (tar) sum count
dup 4 index exch get
% (str) (tar) sum count let
exch 3 index exch get
% (str) (tar) sum count let let2
% sub abs add
% sub dup mul add
sub 0 ne { 1 add } if
} for
} bind def
/GenStrings { % NumStrings TargetLength GenStrings [(String1) ... (String N)]
exch
[ 3 1 roll
% [ Len Num
{
% [ Len
dup dup string exch
% [ Len (Str) Len
0 1 3 -1 roll 1 sub {
% [ Len (Str) count
1 index exch RandomLetter put
} for
exch
} repeat
pop
]
} bind def
/CalcDistance { % (TargetString) (String) CalcDistance (Target) [dist (str)]
Diff exch 2 array astore
} bind def
/Sort { % [[x y] [x1 y1] Array Data ] Sort [ArrayData]
[ exch
aload length
% func -mark- [] [] [] [] [] len
-1 2 { % func -mark- [] [] [] [] [] len2
-1 2 {
3 1 roll
2 copy 0 get exch 0 get sub
0 gt { exch } if
3 -1 roll
1 roll
} for
counttomark 1 roll
} for
counttomark 1 roll
]
} bind def
/Mutation { % (String) Mutation (String')
dup dup length rand exch mod RandomLetter put
} bind def
NumStrings TargetLength GenStrings
[ exch Target exch {
CalcDistance exch
} forall pop ]
Sort
{
[ exch {
1 get
% (str)
NumMutations {
% (str) (str') (str') 0
dup length string dup 0 3 index putinterval
Mutation
} repeat
Keep not { NumMutations 1 add -1 roll pop } if
} forall ]
[ exch Target exch {
CalcDistance exch
} forall pop ]
Sort
0 NumStrings getinterval
dup 0 get dup == flush
0 get 0 eq {quit} if
} loop
|
ytakenaka
#6287()
Rating4/8=0.50
ランダムな文字からMETHINKS IT IS A WEASELを作るプログラムを作れ。
簡単に流れを書いてみます。
１：ランダムな２０文字を持つ文字列をもった３００個作ります。
２：その文字列が"METHINKSITISAWEASEL"に近いものからソートします。
３：それぞれの文字列のなか1文字を別の文字に変化させたものを３つ用意します。
４：それを２：のソートをして上位３００個残す。（９００個あるうちで上位３００個残すということです。）
５：以後３：と４：を繰り返す。
ランダムな文字変化は大文字だけでいいです。簡単にするために空白文字を外してあります。
METHINKS IT IS WEASELができたら終了。３と4の間でソートしたもので一番上位のものを毎回表示させると変化が楽しめます。:-)
Rickard Dawkinsがブラインドウォッチメイカー(現題：盲目の時計職人）の３章で書いていた有名なものです。さらに一般化してもらってもいいです。
参考
[ reply ]