#!/usr/bin/perl # This script makes it easier to handle relative neural connections in f1 genotypes when adding/deleting neurons. # Usage: # perl del_neuro.pl # If not provided, the will be read from stdin. # is 1-based. # TODO: handle bounds (1..N) of and display a warning when exceeded # FIXME: deleting does not work well now! see for example perl del_neuro.pl 2 X[N,1:1][N][N,-1:1] # TODO: test thoroughly my $num = shift @ARGV; my $geno; if (@ARGV) { $geno = "@ARGV"; } else { $geno = (); } my @out; my $idx = 0; my $ratio = 1; for (split /\[/, $geno) { if ($idx == 0) { push @out, $_; $idx++; next; } my ($neuro, $rest) = split /\]/; if ($num != $idx) { my @neuroOut; foreach (split /,/, $neuro) { if (/([-0-9]+):(.*)/ && ($ratio * ($1 + $idx) >= $ratio * ($num))) { push @neuroOut, join (':', ($1 + $ratio, $2)); } else { push @neuroOut, $_; } } push @out, join(',', @neuroOut) . ']' . $rest; } else { my $tmp = pop @out; push @out, $tmp . $rest; } $idx++; } printf "%s\n", join('[', @out);