genetic-algorithms/

# аппроксимация функции с помощью полинома степени MAX_POWER
# поиск коэффициентов производится генетическим алгоритмом
# (c) Alexandr A Alexeev 2010 | http://remontka.com/

use strict ;
# аппроксимируем функцию полиномом ___ степени
use constant MAX_POWER => 4 ;
# сколько особей отбираем в каждом поколении
use constant BEST_CNT => 64 ;
# используем каждую ___ точку
use constant POINT_USE_FREQ => 1 ;

# загружаем координаты точек аппроксимируемой функции
my %f_tbl ;

my $fname = shift ;
die «Usage: $0 fname.csv n » unless ( $fname ) ;

open FID , «<» , $fname ;
my $t ;
while ( <FID> ) {
if ( ++ $t == POINT_USE_FREQ ) {
$t = 0 ;
chomp ;
my ( $x , $y ) = split / ;/;
$f_tbl { $x } = $y ;
}
}
close FID ;

# $p[i]->{data} = [a0, a1, a2, …]
# $p[i]->{rslt} = f
my @p ;

# нулевое поколение
for ( 0 .. BEST_CNT — 1 ) {
my @t ;
push @t , 100 — rand ( 200 ) for ( 0 .. MAX_POWER ) ;
push @p , { data => @t } ;
}

my $gen = 0 ; # номер поколения
$p [ 0 ] -> { rslt } = 10 ; # для входа в цикл

# поиск коэффициентов с помощью ГА
while ( $p [ 0 ] -> { rslt } >= 0.0001 ) {
$gen ++;
# 1. ——— скрещивание + мутации ———
for my $i ( 0 .. BEST_CNT — 2 ) {
for my $j ( $i + 1 .. BEST_CNT — 1 ) {
my @t ;

# скрещивание
push @t , ( $p [ $i ] -> { data } [ $_ ] + $p [ $j ] -> { data } [ $_ ] ) / 2
for ( 0 .. MAX_POWER ) ;

# 50% потомства — мутанты
if ( rand ( ) < 0.5 ) {
$t [ $_ ] += $t [ $_ ] * ( 4 — rand ( 8 ) )
for ( 0 .. MAX_POWER ) ;
}

push @p , { data => @t } ;
}
} # for …

# предки вымирают
shift @p for ( 0 .. BEST_CNT — 1 ) ;

# ——— 2. селекция ———
my $n_items = scalar @p ;

# вычисляем значения целевой функции
$p [ $_ ] -> { rslt } = rslt_f ( $p [ $_ ] -> { data } )
for ( 0 .. $n_items — 1 ) ;

# сортируем особей по значению целевой функции
@p = sort { $a -> { rslt } <=> $b -> { rslt } } @p ;

# отбираем лучших особей
my @next_p ;
push @next_p , $p [ $_ ] for ( 0 .. BEST_CNT — 1 ) ;
@p = @next_p ;

# выводим номер поколения и значение
# целевой функции у «лучшего» потомка
print $gen . «;» . $p [ 0 ] -> { rslt } . «;» ;

# выводим формулу для OpenOffice
my $i = 0 ;
for ( @ { $p [ 0 ] -> { data } } ) {
my $str = sprintf «%.05f» , $_ ;
$str =~ s/./,/ ;
my $sign = $str =~ /^-/ ? «» : «+» ;
if ( $i > 0 ) {
print $sign ;
$str .= $i == 1 ? «*A2» : «*POWER(A2;$i)» ;
}
$i ++;
print $str ;
}
print » n » ;
}

# функция приспособленности
sub rslt_f {
my ( $aref ) = @_ ;
my $max_delta = 0 ;
for my $x ( keys %f_tbl ) {
my $delta = abs ( $f_tbl { $x } — calc_f ( $aref , $x ) ) ;
$max_delta = $delta > $max_delta ? $delta : $max_delta ;
}
return $max_delta ;
}

# вычисление функции-аппроксимации
# в точке x при заданных коэффициентах
sub calc_f {
my ( $aref , $x ) = @_ ;
my $rslt ;
for ( 0 .. MAX_POWER ) {
$rslt += $aref -> [ $_ ] * ( $x ** $_ ) ;
}
return $rslt ;
}