Tcl the weasel

Submitted by Eric Amundsen

#!/usr/bin/env tclsh
proc pick {{range 27}} {
 return [expr {int(rand() * $range)}]
} 

set alphabet " abcdefghijklmnopqrstuvwxyz"
for {set j 0} {$j < [string length $alphabet]} {incr j} {
  set ::[string index $alphabet $j] $j
}

proc calcOffspringScore {offspring} {
  set score 0
  for {set j 0} {$j < [string length $::target]} {incr j} {
    set score [expr {$score + abs([set ::[string index $::target $j]] - [set ::[string index $offspring $j]])}]
  }
  return $score
}

proc createOffspring {parent} {
  set splitPoint [pick [string length $parent]]
  set offspring [string range $parent 0 [expr {$splitPoint - 1}]]
  append offspring [string index $::alphabet [pick]]
  append offspring [string range $parent [expr {$splitPoint + 1}] end]
  return $offspring
}

proc breed {parent numOffspring} {
  set bestKid -1
  set bestScore 10000
  for {set j 0} {$j < $numOffspring} {incr j} {
    set kid [createOffspring $parent] 
    set kids($j) $kid
    set score [calcOffspringScore $kid]
    if {$bestScore > $score} {
       set bestKid $j
       set bestScore $score
     }
  }
  return $kids($bestKid)
}

if {[llength $argv] == 0} {
  puts "methink.tcl usage : 
methink.tcl <# offspring / gen> <(optional) target string>
default target => \"methinks it is like a weasle\"
target string can only include a-z lowercase and space"
  return
} elseif {[llength $argv] == 1} {
  set ::target "methinks it is like a weasle"
} else {
  set ::target [lindex $argv 1]
}

set numOffspring [lindex $argv 0]

set initString ""
for {set j 0} {$j < [string length $target]} {incr j} {
  append initString [string index $alphabet [pick]]
}

puts [set genString $initString]
for {set j 0} {$j < 10000000} {incr j} {
  puts [set genString [breed $genString $numOffspring]]
  if {$genString == $target} {
    puts "[incr j] generations"
    return
  }
}
puts "sorry, gave up after [incr j] generations"