To commemorate the birth of my first yungin' on the 22nd of March 2013, I've built Amelia. It's amazing what a little positive motivation can bring about. (She's already a little monkey!)
What follows is the implementation followed by a fibonacci program written in Amelia.
Implementation:
#!/usr/bin/perl
#use warnings;
use strict;
use Data::Dumper;
my $file = "sequence.ama";
my $string = get_file($file);
my $still_alive = 1000;
my @C = get_chromosome($string);
my @R = qw//;
wrapper(0,$still_alive);
sub get_file{
my $infile = shift;
my $string;
open (my $fh, "<", $infile) or die "nopen $infile, $!";
while (<$fh>){
chomp;
s/:.*//; #comments
s/(\d)\s/$1,/g; #space to comma
s/(\d);/$1,;/g; # forgottn comma before ;
s/\s//g; #get rid of space
s/,,+/,/g; #get rid of duplicate commas
$string .= $_
}
return $string;
}
sub output{
for (@R){
print "$_ ";
}
}
sub finish{
my $message = shift;
print "$message \nthe end. let's print output:\n";
output (\@R);
die
}
sub deathcount{
$still_alive--;
finish ("counted down\n") unless ($still_alive);
}
sub get_chromosome{
my $Genome = shift;#string
my @C =
map {
[
map{
[
/(\d+),/g # the parens excise the commas
]
}
/\d+,\d+,\d+,/g
]
} split /;/, $Genome;
for (@C){
if ($#$_ > 1) {
unless ($#$_ % 2){
splice @$_, -1, 1
}
}
}
@C # @C[gene[codon[base,base,base]]]
}
sub wrapper{
my $ptr = shift; #genome pointer
my $dead_count = shift; #max iterations before death
my $i = $dead_count + 1; #iterator for top level call()
while (1) {
$ptr = call ($ptr, $i);
#ptr is changed to call()'s return value if we
#ever get to this point
}
}
sub call{
my $ptr = shift;
my $i = shift;
my $alt_ptr = -1;
for (1 .. $i){
deathcount(); #count down to process death
my @g = map { [@$_] }@{$C[$ptr]}; #gene
my $call = shift $g[0]; #1st base of 1st codon
my $modcall = $call % 2;
($call % 2)?($alt_ptr = MOV(\@g,$ptr)):(MOD(\@g));
(return $alt_ptr) if ($alt_ptr >= 0);
$ptr == $#C ? $ptr = 0 : $ptr++;#circular chromosome
}
return $alt_ptr;
#if alt_ptr >= 0
#alt_ptr is used to reset ptr permanently.
#the recursive calls to call() are unwound in favor of alt_ptr
}
sub MOD{
my $g = shift; #gene
my ($loc,$reftype) = @{(shift @$g)};
my @ops = qw/+ - * \/ ** %/;
$loc = abs($loc);
$loc = $R[$loc] if ($reftype%2);
$loc = 0 unless $loc;
$R[$loc] = expression_processor($g,\@ops);
}
sub MOV{
my $g = shift;
my $ptr = shift; #needed to check for infi-loop
my @ops = qw/== > < >= <= != and or not xor/;
my ($loc,$i) = @{(shift @$g)};
$loc = abs $loc;
$loc = 0 if $loc > $#C;
$i = abs $i;
if (expression_processor($g, \@ops)){
(finish ("pointer collision")) if ($loc == $ptr);
return $loc unless $i;
return call($loc,$i);
}
return -1
}
sub filter_v_or_o{
my ($v,$o,$total_bits,$orig) = @_;
(return 0) if ($v-1 <= $o);
(return 1) if ($v >= ($total_bits / 2));
return ($orig % 2)
}
sub expression_processor{ #build a polish notation expression from tri
+plets.
my $g = shift; #gene
my $ops = shift; #operators
my ($v,$o) = 0; #init counting vars
my $total_bits = $#$g;
my @expression;
while (@$g){
my ($v_or_o, $data, $ref_type) = @{(shift @$g)};
$v_or_o = filter_v_or_o($v,$o,$total_bits,$v_or_o);
$ref_type = ($ref_type % 3);
($data = $R[abs($data)]) if ($ref_type == 1);
($data = $R[$R[abs($data)]]) if ($ref_type == 2);
$data = 0 unless $data;
($data = $ops->[$data % ($#$ops +1)]) if ($v_or_o);
($v_or_o)?($o++):($v++);
unshift @expression, $data;
}
return solve(\@expression)
}
sub solve{
my $exp = shift;
#print "this is the expression:";
#print Dumper $exp;
#sleep 1;
my $a = shift @$exp;
($a=~/\d/)?
(return $a) :
($a = eval(solve($exp) . " $a " . solve($exp)));
(finish("termination with n/0\n")) if ($@=~ /Illegal/);
return $a;
}
Fibbonacci code in Amelia:
0,0,0, :assigns a value to register 0,
0,5,0,; :the value is 5
0,3,0, : register 3
0,0,0,; : gets a 0
0,4,0, : register 4
0,1,0,; : gets a 1
0,1,0, : register 1 gets
0,1,0, : 1
0,0,1, : register[0]
0,1,0,; : -
: - register[0] 1 (prefix notation)
0,2,0, : register 2 gets
0,1,0, : 1
0,1,1, : register[1]
0,1,0,; : -
: - register[1] 1 (prefix notation)
0,0,1, : location referenced by register [0]
0,1,2, : value in register[2] is a reference to
0,2,2, : another register (this changes during run)
0,0,0,; : +
: this produces each value in the
: Fibonacci sequence
0,0,0, : add 1 to register[0]
0,0,1,
0,1,0,
0,0,0,;
1,7,0, : go to gene 7
0,25,1,; : if register[25] has a value
: (other than 0)
: this is gene 7 (infinite loop)
: this is one way to end the program
1,3,0, :go to gene 3
1,1,0,; :if (1)
:this is how we iterate
##################
: this following is alternate way to terminate a program
0,0,0, : (gene 9) assign a divide by zero
0,0,0,
0,0,0,
0,3,0,; : / 0 0 (illegal devide by 0 -
:ends program and outputs)
Output from Fibonacci:
26 24 23 0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 17711
The first three numbers are used for flow control.
$winks = 40;
$food = crow;
$state{$tired}?sleep($winks):eat($food);