davidw - check this Tcl environment out: http://www.sprave.com/Ease/Ease.html
looks pretty interestingArjen Markus Following up on a discussion on the newsgroup, I translated a simple implementation of genetic algorithms from Fortran into Tcl (the original can be found at: [3] and was written by Scott Robert Ladd).I make no claim to correctness (even though for the listed test case it does seem to work) or to performance (even though it does not turn out that bad, judging from my tests).
Drawbacks of this implementation:
- The interface needs improvements (no way to examine the population)
- The fitness function has to take care of scaling the input parameters from "GA-typical" data (32-bits integers) to real-world values (in the test case: floating-point numbers between 0 and 1)
- A few items were left out (quadratic weighing for instance)
- A few uncertainties with regard to the range of the generated integers (does the sign-bit get set? What if we have a 1s-complement machine?)
TS Converting the hardcoded constants using int2bits from Binary representation of numbers on my Pentium4/WinXP/Tcl8.4a4 led to - at least for me - surprising results
% int2bits -2147483647 32 (should be all bits set) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 % int2bits 2147483000 32 (used for chromosome initialisation) 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 1 1 1 1 0 0 0Lars H: Which int2bits are you talking about here? There are oodles of them on that page, and several of them assume non-negative input (e.g. have main loops
while {$i>0} {). Also, it is in 32-bit 1's complement notation that -2147483647 has all bits set. Tcl bit operations work with 2's complement notation, in which it is always -1 that has all bits set. # genetic_alg.tcl --
#
# Package for implementing simple genetic algorithms
# (Tcl-only version)
#
# Notes:
# This package is shamelessly modelled after a publically
# available program by Scott Robert Ladd (http://www.coyotegulch.com)
#
# Version information:
# version 0.1: initial implementation, february 2002
package provide GeneticAlgorithms 0.1
namespace eval ::GeneticAlgorithms {
variable crossover 0.5
variable mutation 0.1
variable elitism 1
variable quadweight 0
variable best_guess {}
variable population {}
variable child_pop {}
namespace export setting optimise optimiseStep
# limitvalue
# Limit the argument between two bounds
#
# Arguments:
# value New value (if not present, return current value)
# minimum Minimum bound
# maximum Maximum bound
#
# Result:
# Value or one of the bounds
#
proc limitvalue {value minimum maximum} {
if { $value < $minimum } {
return $minimum
}
if { $value > $maximum } {
return $maximum
}
return $value
}
# setting
# Set/get the settings
#
# Arguments:
# name Name of a variable to set or get
# value New value (if not present, return current value)
#
# Result:
# New value for given variable
#
# Side effects:
# Sets given variable to new value
#
proc setting {name {value NONE} } {
variable $name
if { $value != "NONE" } {
switch -- $name {
"crossover" { set $name [limitvalue $value 0.0 1.0] }
"mutation" { set $name [limitvalue $value 0.0 1.0] }
"elitism" { set $name [expr $value!=0] }
"quadweight" { set $name [expr $value!=0] }
default { error "setting: unknown parameter $name" }
}
set $name
}
}
# optimise --
# Optimise the given function using a genetic algorithm
#
# Arguments:
# pop_size Size of the population
# max_gen Maximum number of generations
# no_genes Number of "genes" - degrees of freedoms
# fitness Function of the degrees of freedom, returns the fitness
# of the solution (as a non-negative number!)
#
# Result:
# Best guess of degrees of freedom, as a list
#
proc optimise { pop_size max_gen no_genes fitness } {
variable best_guess
optimiseInit $pop_size $no_genes
for { set i 0 } { $i < $max_gen } { incr i } {
optimiseStep $pop_size $no_genes $fitness
puts "$best_guess - [$fitness $best_guess]"
}
return $best_guess
}
# optimiseInit --
# Initialise the population
#
# Arguments:
# pop_size Size of the population
# no_genes Number of "genes" - degrees of freedoms
#
# Result:
# None
#
# Side effects:
# Initialised list variable population
#
proc optimiseInit { pop_size no_genes } {
variable population
variable child_pop
set population {}
for { set i 0 } { $i < $pop_size } { incr i } {
set member {}
for { set j 0 } { $j < $no_genes } { incr j } {
lappend member [expr {int(2147483000.0*rand())}]
}
lappend population $member
}
set child_pop $population
}
# optimiseStep --
# Perform a single step in the optimisation
#
# Arguments:
# pop_size Size of the population
# no_genes Number of "genes" - degrees of freedoms
# fitness Function for determining the fitness
#
# Result:
# None
#
# Side effects:
# New population, best_guess set
#
proc optimiseStep { pop_size no_genes fitness } {
variable population
variable child_pop
variable best_guess
variable mutation
variable crossover
variable quadweight
variable elitism
#
# Copy the child population
#
set population $child_pop
#
# Determine the fitness per member
#
set high_fit -1
set tot_fit 0.0
set pop_fit {}
foreach member $population {
set fit [eval $fitness $member]
if { $high_fit < $fit } {
set high_fit $fit
set best_guess $member
}
lappend pop_fit $fit
set tot_fit [expr {$tot_fit+$fit}]
}
#
# Scale the fitness (quadratic weight)
#
# PM
#
# Elitism: keep the best in any case
#
set child_pop {}
set no_child $pop_size
if { $elitism } {
lappend child_pop $best_guess
incr no_child -1
}
#
# Breed the children
#
for { set i 0 } { $i < $no_child } { incr i } {
set selection [expr {$tot_fit*rand()}]
set father 0
set father_fit [lindex $pop_fit $father]
while { $selection > $father_fit } {
set selection [expr {$selection-$father_fit}]
incr father
set father_fit [lindex $pop_fit $father]
}
set selection [expr {$tot_fit*rand()}]
set mother 0
set mother_fit [lindex $pop_fit $mother]
while { $selection > $mother_fit } {
set selection [expr {$selection-$mother_fit}]
incr mother
set mother_fit [lindex $pop_fit $mother]
}
set child [combineGenes [lindex $population $mother] \
[lindex $population $father] ]
set child [mutateGenes $child]
lappend child_pop $child
}
#puts $population
#puts $pop_fit
}
# combineGenes --
# Combine the genes of the two parents (using cross-over)
#
# Arguments:
# mother Genes of the first parent
# father Genes of the second parent
#
# Result:
# Genes of the child
#
proc combineGenes { mother father } {
variable crossover
set all_bits_set -2147483647
set child {}
foreach first $mother second $father {
set bit_no [expr int(32.0*rand())]
set bitmask [expr {($all_bits_set>>$bit_no)<<$bit_no}]
set newgene [expr {$first&$bitmask|$second&~$bitmask}]
lappend child $newgene
}
return $child
}
# mutateGenes --
# Mutate the genes of a child (flip a bit)
#
# Arguments:
# child Genes of the child to be mutated
#
# Result:
# Mutated genes
#
proc mutateGenes { child } {
variable mutation
set newgenes {}
foreach gene $child {
if { [expr {rand()}] < $mutation } {
set bit_no [expr {int(32.0*rand())}]
set bitmask [expr {1<<$bit_no}]
set bitset [expr {($gene&$bitmask) != 0}]
if { $bitset } {
set newgene [expr {$gene&~$bitmask}]
} else {
set newgene [expr {$gene|$bitmask}]
}
} else {
set newgene $gene
}
lappend newgenes $newgene
}
return $newgenes
}
} ;# End of namespace
#namespace import ::GeneticAlgorithms::*
proc testFunc { var } {
expr {1.0-abs($var/2147483647.0-0.5)}
}
puts [::GeneticAlgorithms::optimise 100 40 1 testFunc]['Nother keyword I want to discuss eventually: Simulated annealing.]
RS did not look at all code in detail, but the very first proc struck him - could be written very much more concisely:
proc limitValue {val min max} {
expr {$val<$min? $min: $val>$max? $max: $val}
}Arjen Markus I would go for proper min/max functions in expr:
proc limitValue {val min max} {
expr {min($max,max($min,$val))}
}which is even more concise: every variable appears but once!But I agree: my first objective was to get things working, and I did not want to think to much on the syntax of ?:Donal Fellows - It doesn't make much difference in recent versions of Tcl anyway; the bytecode out the back should be pretty similar...What: GAGS Where: http://kal-el.ugr.es/gags.htmlAGS
AM (4 april 2005) Witnessed a rather nice application of genetic programming the other day - a method to approximate complicated functions by combining and mutating expression trees. Because you do not prescribe the family of functions to try, as with more classical approaches, there is a lot of freedom in the final result. With a bit of insight in the corresponding physical problem, the people who performed this study were able to come up with a concise formula that made some physical sense.
Lithium Genetic Programming Toolkit
: a framework for experimenting with Genetic Programming. Written in C++ with Tcl bindings.