Initial data commit

Task/Evolutionary-algorithm/VBScript/evolutionary-algorithm.vb

@@ -0,0 +1,60 @@
+Option explicit
+
+Function rand(l,u) rand= Int((u-l+1)*Rnd+l): End Function
+
+Function fitness(i)
+  Dim d,j
+  d=0
+  For j=1 To lmod
+     If Mid(model,j,1)=Mid(cpy(i),j,1) Then d=d+1
+  Next
+fitness=d
+End Function
+
+Sub mutate(i)
+Dim j
+ cpy(i)=""
+ For j=1 To lmod
+ If Rnd<mut Then
+  cpy(i)=cpy(i)& Chr(rand(lb,ub))
+ Else
+  cpy(i)=cpy(i)& Mid(cpy(0),j,1)
+ End If
+ Next
+End sub
+
+Sub print(s):
+   On Error Resume Next
+    WScript.stdout.WriteLine (s)
+   If  err= &h80070006& Then WScript.Echo " Please run this script with CScript": WScript.quit
+End Sub
+
+Dim model,lmod,ub,lb,c,cpy,fit,best,i,d,mut,cnt
+model="METHINKS IT IS LIKE A WEASEL"
+model=Replace(model," ","@")
+lmod=Len(model)
+Randomize Timer
+ub=Asc("Z")
+lb=Asc("@")
+c=10
+mut=.05
+best=0
+ReDim cpy(c)
+
+
+For i=0 To lmod-1
+ cpy(best)=cpy(best)& chr(rand(lb,ub))
+Next
+best=0
+cnt=0
+do
+  cpy(0)=cpy(best)
+  fit=0
+  For i=1 To c
+   mutate(i)
+   d=fitness(i)
+   If d>fit Then fit=d:best=i
+  Next
+  cnt=cnt+1
+  If (fit=lmod) Or ((cnt mod 10)=0)  Then print cnt &" " & fit & " "& Replace (cpy(best),"@"," ")
+Loop While fit <>lmod