Last change
on this file since 112 was
37,
checked in by Maciej Komosinski, 15 years ago
|
added scripts that help handle relative neural connections in f1 genotypes when adding/deleting neurons
|
File size:
1.1 KB
|
Line | |
---|
1 | #!/usr/bin/perl |
---|
2 | |
---|
3 | # This script makes it easier to handle relative neural connections in f1 genotypes when adding/deleting neurons. |
---|
4 | # Usage: |
---|
5 | # perl del_neuro.pl <neuron_number> <f1_genotype> |
---|
6 | # If not provided, the <f1_genotype> will be read from stdin. |
---|
7 | # <neuron_number> is 1-based. |
---|
8 | |
---|
9 | # TODO: handle bounds (1..N) of <neuron_number> and display a warning when exceeded |
---|
10 | # FIXME: deleting does not work well now! see for example perl del_neuro.pl 2 X[N,1:1][N][N,-1:1] |
---|
11 | # TODO: test thoroughly |
---|
12 | |
---|
13 | my $num = shift @ARGV; |
---|
14 | |
---|
15 | my $geno; |
---|
16 | if (@ARGV) { |
---|
17 | $geno = "@ARGV"; |
---|
18 | } else { |
---|
19 | $geno = (<STDIN>); |
---|
20 | } |
---|
21 | |
---|
22 | my @out; |
---|
23 | my $idx = 0; |
---|
24 | my $ratio = 1; |
---|
25 | for (split /\[/, $geno) { |
---|
26 | if ($idx == 0) { |
---|
27 | push @out, $_; |
---|
28 | $idx++; |
---|
29 | next; |
---|
30 | } |
---|
31 | my ($neuro, $rest) = split /\]/; |
---|
32 | |
---|
33 | if ($num != $idx) { |
---|
34 | my @neuroOut; |
---|
35 | foreach (split /,/, $neuro) { |
---|
36 | if (/([-0-9]+):(.*)/ && ($ratio * ($1 + $idx) >= $ratio * ($num))) { |
---|
37 | push @neuroOut, join (':', ($1 + $ratio, $2)); |
---|
38 | } else { |
---|
39 | push @neuroOut, $_; |
---|
40 | } |
---|
41 | } |
---|
42 | push @out, join(',', @neuroOut) . ']' . $rest; |
---|
43 | } else { |
---|
44 | my $tmp = pop @out; |
---|
45 | push @out, $tmp . $rest; |
---|
46 | } |
---|
47 | |
---|
48 | $idx++; |
---|
49 | } |
---|
50 | |
---|
51 | printf "%s\n", join('[', @out); |
---|
52 | |
---|
Note: See
TracBrowser
for help on using the repository browser.