Evolutionary Algorithm

first publish in rosettacode.org

Module WeaselAlgorithm {
      Print "Evolutionary Algorithm"
      \\ Weasel Algorithm
      \\ Using dynamic array, which expand if no fitness change,
      \\ and reduce to minimum when fitness changed
      \\ Abandon strings when fitness change
      \\ Also lambda function Mutate$ change when topscore=10, to change only one character
      l$="ABCDEFGHIJKLMNOPQRSTUVWXYZ "
      randomstring$=lambda$ l$ ->{
            res$=""
            For i=1 to 28: res$+=Mid$(L$,Random(1,27),1):next i
            =res$
      }
      m$="METHINKS IT IS LIKE A WEASEL"
      lm=len(m$)
      fitness=lambda m$, lm (this$)-> {
            score=0 : For i=1 to lm {score+=If(mid$(m$,i,1)=mid$(this$, i, 1)->1,0)} : =score
      }
      Mutate$=lambda$ l$ (w$)-> {
            a=random(1,28) : insert a, 1 w$=mid$(l$, random(1,27),1)
            If random(3)=1 Then b=a:while b=a {b=random(1,28)} : insert b, 1 w$=mid$(l$, random(1,27),1)
            =w$
      }
      Mutate1$=lambda$ l$ (w$)-> {
            insert random(1,28), 1 w$=mid$(l$, random(1,27),1) : =w$
      }
      f$=randomstring$()
      topscore=0
      last=0
      Pen 11 {Print "Fitness |Target:", @(16),m$, @(47),"|Total Strings"}
      Print Over $(3,8), str$(topscore/28,"##0.0%"),"",$(0),f$, 0
      count=0
      gen=30
      mut=0
      {
            last=0
            Dim a$(1 to gen)<<mutate$(f$)
            mut+=gen
            oldscore=topscore
            For i=1 to gen {
                  topscore=max.data(topscore, fitness(a$(i)))
                  If oldscore<topscore Then last=i:Exit
            }
            If last>0 Then {
                  f$=a$(last) : gen=30 : If topscore=10 Then mutate$=mutate1$
            } Else gen+=50
            Print Over $(3,8), str$(topscore/28,"##0.0%"), "",$(0),f$, mut : refresh
            count+=min(gen,i)
            If topscore<28 Then loop
      }
      Print
      Print "Results"
      Print "I found this:"; a$(i)
      Print "Total strings which evalute fitness:"; count
      Print "Done"
}
WeaselAlgorithm

Fitness |Target: METHINKS IT IS LIKE A WEASEL |Total strings
    3,6%         ZZBZSVEOWPSQGJXNIXTFQCDQTJFE        30
    7,1%         ZZBZSVEOWPSQGJXNIXTFQCDQAJFE        60
   14,3%         ZZBZSVEOWPTQGJXNIXTFACDQAJFE        90
   17,9%         ZZBZSVEOWPTQGJXNIXTFA DQAJFE       200
   21,4%         ZEBZSVEOWPTQGJXNIXTFA DQAJFE       230
   25,0%         ZEBZSVEOWPTQGJXNIXT A DQAJFE       260
   28,6%         MEBZSVEOCPTQGJXNIXT A DQAJFE       290
   32,1%         MEBZSVEOCITQGJXNIXT A DQAJFE       320
   35,7%         MEBZSVEOCITQGJXNIKT A DQAJFE       350
   39,3%         MEBZSVEOCITQGJ NIKT A DQAJFE       380
   42,9%         MEBZSVEOCITQGJ NIKT A WQAJFE       410
   46,4%         MEBZSVESCITQGJ NIKT A WQAJFE       440
   50,0%         MEBZSVESCITQIJ NIKT A WQAJFE       680
   53,6%         MEBZSVESCIT IJ NIKT A WQAJFE      1100
   57,1%         MEBZSVESCIT IJ LIKT A WQAJFE      1130
   60,7%         MEBZSVKSCIT IJ LIKT A WQAJFE      1240
   64,3%         MEBZSVKS IT IJ LIKT A WQAJFE      1480
   67,9%         MEBZSNKS IT IJ LIKT A WQAJFE      1900
   71,4%         MEBHSNKS IT IJ LIKT A WQAJFE      2010
   75,0%         METHSNKS IT IJ LIKT A WQAJFE      2430
   78,6%         METHSNKS IT IJ LIKE A WQAJFE      2670
   82,1%         METHSNKS IT IJ LIKE A WQAJFL      3090
   85,7%         METHSNKS IT IJ LIKE A WEAJFL      3330
   89,3%         METHSNKS IT IJ LIKE A WEASFL      3980
   92,9%         METHINKS IT IJ LIKE A WEASFL      4400
   96,4%         METHINKS IT IJ LIKE A WEASEL      5050
  100,0%         METHINKS IT IS LIKE A WEASEL      5290
Results
I found this:METHINKS IT IS LIKE A WEASEL
Total strings which evaluate fitness:3230