source: scripts/neurons_in_f1/del_neuro.pl @ 660

#!/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 <neuron_number> <f1_genotype>
# If not provided, the <f1_genotype> will be read from stdin.
# <neuron_number> is 1-based.

# TODO: handle bounds (1..N) of <neuron_number> 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 = (<STDIN>);
}

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);