source: scripts/neurons_in_f1/del_neuro.pl @ 193

Last change on this file since 193 was 193, checked in by Maciej Komosinski, 10 years ago

Set svn:eol-style native for all textual files

  • Property svn:eol-style set to native
File size: 1.1 KB
RevLine 
[37]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
13my $num = shift @ARGV;
14
15my $geno;
16if (@ARGV) {
17        $geno = "@ARGV";
18} else {
19        $geno = (<STDIN>);
20}
21
22my @out;
23my $idx = 0;
24my $ratio = 1;
25for (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
51printf "%s\n", join('[', @out);
52
Note: See TracBrowser for help on using the repository browser.