if-clause seems not to be executed under certain arbitrary conditions - perl

I am trying to divide a triangular matrix into parts, which hold approximately the same amount of elements.
I wrote the following code, which works nicely for most combinations of inputs, and segments my matrix into the given number of parts from 0 to $length.
However, there are input combinations like $length = 2003 and $number_of_segments = 50, where the last segment is missing in the output.
I tested the values of $threshold and $total, but they seem to be correct even in those odd cases.
Do you have any ideas, where the bug is?
#!/usr/bin/perl
use strict; #should always be used
use warnings; #that one too
use autodie; #just in case I forgot to check anything
my $length = shift or die "ERROR: Not enough arguments!\n"; #number of rows in the matrix
my $number_of_segments = shift or die "ERROR: Not enough arguments!\n"; #number of segments we want to get
my #segments = ÷ #array of segment-limits
print "$_\n" foreach #segments;
sub divide {
my #segments = (0); #the first segment starts at 0
my $number_of_pairs = ($length*($length+1))/2; #number of elements in matrix
my $total = 0; #counter for the elements we already visited
my $segment_counter = 1; #we are in the first segment
for (my $i=0; $i<$length; $i++){ #going over the rows of the matrix
$total += $length-$i; #counting the elements in each row
my $threshold = ($number_of_pairs/$number_of_segments)*$segment_counter; #threshold for the next segment
if ($total >= $threshold){ #if our current segment is large enough
push #segments, $i+1; #save the limit
$segment_counter++; #and open the next segment
}
}
return #segments;
}

The problem is that you can't generally compare floating-point numbers for equality because of their limited accuracy. The final value of $threshold comes out fractionally high (2007006.0000000002 on my 32-bit Perl) so you have to allow for a margin of error.
If you change the test to
if ( $total + 1E-8 >= $threshold ) { ... }
then you will get the results you expect. You may have to adjust the delta value to get the correct results.
Note that this is a very slow and inaccurate way of doing things. You should really keep all the arithmetic to integers instead of floating point values, but I don't have time at present to refactor your code

Related

Newton's Method in perl

Okay so for my math class we were asked to write a program that performs and prints Newton's method until the values converge and we have a root for the function. At first I thought it would be easy. It was until I just couldn't get the values derived from the first time to be used the second time. My knowledge of the language is basic. Really basic, so what you're about to see might not be pretty.
#!usr/bin/perl
use PDL;
print "First guess? (this is x0)\n";
$xorig = <>;
do {
&fx;
} until ($fex == 0);
sub fx {
if ($xn == 0) {
$x = $xorig;
}
else {
$x = $xn;
}
print "What is the coefficient (for each factor) of your function?\n";
$fcx = <STDIN>;
push #coefficient_of_x, $fcx;
print "... times x to the (enter exponent, if no exponent, enter 1. if no x, enter 0)?\n";
$fex = <STDIN>;
push #exponent_x, $fex;
chomp ($fcx, $fex, $x, $xorig);
$factor = $fcx * ($x ** $fex);
push #fx, $factor;
}
my $fx = 0;
foreach my $variable (#fx) {
$fx = $variable + $fx #THIS PROVIDES A VALUE FOR THE GIVEN F(X) WITH A GIVEN X VALUE
}
print "f($x)=$fx\n";
do {
&fprimex;
} until ($fprimeex == 0);
sub fprimex {
if ($xn == 0) {
$x = $xorig;
}
else {
$x = $xn;
}
print "What is the coefficient (for each factor) of your derivative function?\n";
$fprimecx = <STDIN>;
push #coefficient_of_fpx, $fprimecx;
print "... times x to the (enter exponent, if no exponent, enter 1. if no x, enter 0)?\n";
$fprimeex = <STDIN>;
push #exponent_fpx, $fprimeex;
chomp ($fprimecx, $fprimeex, $x, $xorig);
$factorprime = $fprimecx * ($x ** $fprimeex);
push #fprimex, $factorprime;
}
$fprimex = 0;
foreach my $variableprime (#fprimex) {
$fprimex = $variableprime + $fprimex #THIS PROVIDES A VALUE FOR THE GIVEN F'(X) WITH THAT SAME X VALUE
}
print "f'($x)=$fprimex\n";
sub x0 {
$xn = $xorig - $fx / $fprimex; #THIS IS NEWTON'S METHOD EQUATION FOR THE FIRST TIME
push #newxn, $xn;
print "xn ia $xn\n";
}
&x0;
foreach $value (#exponent_x) {
$exponent_x = $xn ** $value;
push #part1, $exponent_x;
$part1 = #part1;
}
foreach $value2 (#coefficient_of_x) {
$part2 = $value2 * #part1;
push #final1, $part2;
}
print "#part1\n";
print "#final1\n";
Essentially what it is is I first ask for the first guess. I use this value to define the coefficients and the exponents of f(x) to get a value for f(x) in terms of the given x. I do it again for f'(x). Then I perform newton's method the first time and get the new value xn. But I'm having a hard time to get values for f(xn) and f'(xn), meaning I can't get x(n+1) and can't continue newton's method. I need help.
Welcome to Perl.
I would strongly recommend the following changes to your code:
Always include use strict; and use warnings; in EVERY Perl script.
Always chomp your input from STDIN as your taking it:
chomp( my $input = <STDIN> );
Don't needlessly create subroutines, especially for one-off scripts such as this.
Instead of using the statement modifier form of do, I would recommend using an infinite while with loop control statements to exit:
while (1) {
last if COND;
}
Finally, since the coefficients of your polynomial are all associated with an exponent for X, I would recommend using a %hash for conveniently saving those values.
As demonstrated:
#!usr/bin/env perl
use strict;
use warnings;
print "Build your Polynomial:\n";
my %coefficients;
# Request each Coefficient and Exponent of the Polynomial
while (1) {
print "What is the coefficient (for each factor) of your function? (use a bare return when done)\n";
chomp( my $coef = <STDIN> );
last if $coef eq '';
print "... times x to the (enter exponent, if no exponent, enter 1. if no x, enter 0)?\n";
chomp( my $exp = <STDIN> );
$coefficients{$exp} = $coef;
}
print "\nFirst guess? (this is x0)\n";
chomp( my $x = <> );
# Newton's Method Iteration
while (1) {
my $fx = 0;
my $fpx = 0;
while ( my ( $exp, $coef ) = each %coefficients ) {
$fx += $coef * $x**$exp;
$fpx += $coef * $exp * $x**( $exp - 1 ) if $exp != 0;
}
print " f(x) = $fx\n";
print " f'(x) = $fpx\n";
die "Slope of 0 found at $x\n" if $fpx == 0;
my $new_x = $x - $fx / $fpx;
print "Newton's Method gives new value for x at $new_x\n";
if ( abs($x - $new_x) < .0001 ) {
print "Accuracy reached\n";
last;
}
$x = $new_x;
}
I am having trouble working out what you intended with your code. The main problem seems to be that don't have it clear in your head what each of your subroutines do, as fx and fprimex ask for the data as well as evaluating the function (except for summing the terms which, oddly, is done outside the subroutine). That isn't what you want at all, as the exponents and coefficients remain constant throughout a program that has to evaluate those functions many times, and you really don't want to ask for the values again each time.
Here are some pointers to getting Perl code working in general
Write your program in tiny chunks -- a line or two at a time -- and check after each addition that the program compiles and runs and produces the expected results. Writing an entire program before you even try to run it is a recipe for disaster
Always use strict and use warnings, and declare every variable with my as close as possible to the point where it is first used. You have many undeclared variables which are therefore global, and passing information between sections of code using global variables is a good way to lose yourself in your own code. It is a good rule for a subroutine to use only parameters passed to it or variables declared within it
chomp variables as soon as they are read, either from a file or from the terminal. A useful idiom to trim input strings at source is
chomp(my $input = <>)
which will ensure that there are no stray newlines anywhere in your data
That at least should get you started.
I'm in two minds about showing this. I hope it will help you, but I really don't want to drag you into parts of Perl that you're not familiar with.
It's a program that uses the Newton–Raphson method to find the root of polynomials. I've skipped the terminal input for now, and hard-coded the data. As it stands it finds the square root of 3,000 by finding the positive root of x2 - 3000.
Note that #f and #f_prime hold the coefficients of the function and its derivative backwards from the usual order, so #f is (-3000, 0, 1). The program also calculates the coefficients of the derivative function, as it is a simple thing to do and far preferable to asking the user for another set of values.
There is just one subroutine polynomial, which takes a value for x and a list of coefficients. This is used to calculate the value of both the function and its derivative for a given value of x.
The algorithm step is in the line
my $new_x = $x - polynomial($x, #f) / polynomial($x, #f_prime);
which calculates x - f(x) / f'(x) and assigns it to $new_x. Each successive estimate is printed to STDOUT until the loop exits.
Comparing floating-point values for equality is a bad idea. The precision of computer floating-point values is, obviously, limited, and a sequence will probably never converge to the point where the last two values of the sequence are equal. The best that can be done is to check whether the absolute value of the difference between the last two values is below a reasonable delta. An accuracy of 10E12 is reasonable for 32-bit floating-point numbers. I have found that the series converges to within 10E14 quite reliably, but if you find that your program hangs in an endless loop then you should increase the margin.
use strict;
use warnings;
my #f = reverse (1, 0, -3000);
my #f_prime = map { $f[$_] * $_ } 1 .. $#f;
my $x = 0.5;
print $x, "\n";
while () {
my $new_x = $x - polynomial($x, #f) / polynomial($x, #f_prime);
last if abs($new_x - $x) < $x / 1e14;
$x = $new_x;
print $x, "\n";
}
sub polynomial {
my ($x, #coeffs) = #_;
my $total = 0;
my $x_pow = 1;
for my $coeff (#coeffs) {
$total += $x_pow * $coeff;
$x_pow *= $x;
}
$total;
}
output
0.5
3000.25
1500.62495833681
751.312062703027
377.652538627869
192.798174296885
104.179243809523
66.4878834504349
55.8044433107163
54.7818016853582
54.7722565822241
54.7722557505166

Need help to understand Perl code implementing Sieve of Eratosthenes

I found the following code written in Perl about the Sieve of Eratosthenes (an algorithm to find primes in a given range of numbers) and it's working fine, but I don't understand it. Can somebody comment it out for me, so I'll get a better understanding of how the primes are found?
$max= 120;
#primes= ();
#tested= (1);
$j= 1;
while ($j < $max) {
next if $tested[$j++];
push #primes, $j;
for ($k= $j; $k <= $max; $k+=$j) {
$tested[$k-1]= 1;
}
}
print "#primes\n";
I would rewrite (clean up) that script like the following to make it more clear.
Take this as lesson that if one gives variables meaningful names, code can become self-documenting:
use strict;
use warnings;
my $max = 120;
my #primes;
my #notprime;
for my $num (2..$max) {
next if $notprime[$num];
push #primes, $num;
for (my $multiple = 2 * $num; $multiple <= $max; $multiple += $num) {
$notprime[$multiple] = 1;
}
}
print "#primes\n";
The wikipedia article on Sieve of Eratosthenes is going to explain the algorithm fully, and provide pretty little visuals on the process. However, the summary is just this:
Iterate over all the integers from 2 to max.
If an integer hasn't been marked as notprime, then it's prime!
Then just cycle through all multiples of the recognized prime so that we can mark them as not prime.
$max= 120;
#primes= ();
$tested might be better named something like $nonprime. Although we put 1 into the array to start with, it doesn't actually do anything useful... it could equally be left empty.
Also, #tested isn't a list of non-primes, but a list of boolean values whose indices are non-primes. If, for some reason, you wanted to mark 2 as non-prime, you'd have to do something like this instead: #tested = (1,1);
#tested= (1);
$j= 1;
Sweep through all the integers from 1 to 120.
while ($j < $max) {
If we've already checked this number for primality and it failed, restart the loop to check the next number.
next if $tested[$j++];
We now know that j is a prime, because we haven't marked it as being non-prime, so we can add it to the end of our list. The final list will be in ascending order because of this.
push #primes, $j;
Sweep through every remaining number between this one and the end of the array. We increment by our new prime number each time, so we're basically striding over all the multiples of $j
for ($k= $j; $k <= $max; $k+=$j) {
Mark each multiple as tested. We know it cannot be prime, as it has $j as a factor.
$tested[$k-1]= 1;
}
}
The rest of the script is left as an exercise for the reader.
print "#primes\n";

Progress line in perl

I would like to create a very simple progressbar for my script. So far I've got this, and it works. However, I cannot get it to be a percentage out of 100. My code is the following and it produces basically a dot for every 5 entries in #entries.
my $total_entries = #entries;
my $count = 0;
my $count_tens = $total_entries/0.2;
$count_tens = sprintf ('%d',$count_tens);
foreach (#entries){
# do some stuff #
for (1 .. $total_entries){
if ($count == $count_tens){
print ".";
$count = 0;
}
$count++;
}
}
I would like to have something that produces always a fixed amount of dots, regardless of the total number of entries in #entries.
Let's say we want 80 dots. Then:
my $number_of_dots = 80;
my #items = 0 .. 20; # or something
my $items_per_dot = #items / $number_of_dots;
STDOUT->autoflush(1); # print everything out immediately
for my $i (0 .. $#items) {
my $dots = $i / $items_per_dot;
print "\r", "." x $dots;
sleep 1; # do something
}
print "\n";
Note that we avoid rounding errors by calculating the number of dots per item anew on each iteration. The \r will move the cursor to the start of the line, so the existing dots will be overwritten each time. You can easily skip the printing if the $dots value doesn't change between iterations.
Rather than rewriting the wheel, you may want to use existing code that has already been written, tested and debugged.
http://metacpan.org/pod/Term::ProgressBar

Perl - Returning the maximum value in a data set

I have never delved into the world of Perl before and I find it pretty confusing and could use some help. In the code below the calc() section returns a running average of an'input' over 'count' samples. I would like to modify that so the calc() returns the maximum value within the sample set. Thanks in advance for the help!
sub calc
{
my ($this, $dim, $input, $count) = #_;
if ($count < 1)
{
warn "count=$count is less than 1.";
return undef;
}
my $inputsum_in = $this->{inputsum};
my ($inputcumsum, $inputsum_out) = PDL::CumulativeSumOver2($input, $inputsum_in);
my $inputdelay = $this->delay('inputhistory', $input);
my $inputdelaysum_in = $this->{inputdelaysum};
my ($inputdelaycumsum, $inputdelaysum_out) = PDL::CumulativeSumOver2($inputdelay, $inputdelaysum_in);
$this->{inputsum} = $inputsum_out;
$this->{inputdelaysum} = $inputdelaysum_out;
my $sampleno = $this->{sampleno};
my $divider = $count;
if($sampleno < $count)
{
my $last = $dim - 1;
$divider = sequence($dim) + ($sampleno + 1);
my $start = $count - $sampleno;
$divider->slice("$start:$last") .= $count if $start <= $last;
$this->{sampleno} = $sampleno + $dim;
}
return ($inputcumsum - $inputdelaycumsum) / $divider;
}
How about
$max = max($input);
PDL Primitives
If you want to find the maximum of a certain list of values, you do not need to write your own subroutine. There is already a function that comes shipped with perl v5.7.3 or higher:
use List::Util qw(max); # core module since v5.7.3
use strict;
use warnings;
print max(1 .. 10); # prints 10
EDIT: Here is the loop I take it you need.
Read input data from sensor
append new data to stored data
Throw away excess data
Evaluate
Here's how I'd do it.
my $storedData = pdl;
# $storedData is now a vector containing one element, 0
while (! stopCondition()) {
my $input = readSensorData(); # step 1
$storedData = $storedData->append($input); # step 2
if ($storedData->nelem > $count) { # step 3
$storedData = $storedData->slice("-$count:-1");
# note that -1 points to the last element in a piddle and -X refers to
# the element X-1 away from the end (true for piddles and native arrays)
}
my ($max, $min) = evaluate($storedData); # step 4
}
I'm not sure if this answers your question, but your comment below seems pretty different from the question you have above. Consider editing the above to better reflect what you're having trouble with or asking a new question.
An easy way to get a running average is with a finite impulse response filter, aka convolution. Convolve any signal with a (normalized) rectangular impulse and you get running average.
my $filter = ones($count) / $count;
my $runningAve = convolveND($input, $filter);
my $max = $runningAve->max`;
Or in one line
my $max = convolveND($input, ones($count) / $count)->max;
convolveND is documented here.
There is one thing to be careful of with this method, which is that the values at the beginning and end of the $runningAve piddle aren't really running averages. To ensure that the output is the same size as the input convolveND (by default) effectively concatenates zeroes to the beginning and end of the input, the result being that the first and last few elements of $runningAve are lower than actual running averages. (Note that a running average should have N - (window - 1) elements in principle, N being the size of $input.) Since these "bad" values will necessarily be lower than the actual running average values, they won't disturb the maximum that you want. (Re "by default": convolveND has other ways of handling edges, as you will see in the documentation linked to above.)
(NB: I am not a PDL expert. There may be a cheaper way to get the running average that's cheaper than convolveND, something like $ra = $input->range(...)->sumover(0) / $count, but I don't know what you'd put in the ... and the above is readable. See also http://search.cpan.org/~jlapeyre/PDL-DSP-Iir-0.002/README.pod#moving_average)

Mysterious "uninitialized value in an array" in algorithm for Perl challenge

Currently learning Perl, and trying to solve a little challenge to find the sum of even terms from the first 4,000,000 Fibonacci terms. I have created a Fibonacci array that seems to work, and then tried different methods to throw out the odd-valued terms, and continually run into an error when trying to sum my resulting array, getting reports of:
Use of uninitialized value in addition (+) at prob2_3.plx line 23
Here is what I have:
#!/usr/bin/perl -w
# prob2_2.plx
use warnings;
use strict;
my #fib; my $i; my $t; my $n;
#fib = (1, 2);
for ($i=2; $i<4000000; $i++) {
my $new= ( $fib[$i-1] + $fib[$i-2] );
push #fib, $new;}
for ($t=3; $t<4000000; $t++) {
if (($fib[$t] % 2) != 0 ) {
delete $fib[$t]; } }
my $total = 0;
for ($n=1; $n<$#fib; $n++) {
$total += $fib[($n+1)];}
print $total;
The warning means you are adding undef to something. delete $fib[$t]; is a bad way of doing $fib[$t] = undef;, which you later add to $total.
You have at least one other error:
The first two Fibonacci numbers are 0 and 1, not 1 and 2.
You have a major problem:
The 4,000,000th Fib number is going to be extremely large, much too large to fit in a double.
For reference purposes,
10,000th has 2090 digits: 20793608237133498072112648988642836825087036094015903119682945866528501423455686648927456034305226515591757343297190158010624794267250973176133810179902738038231789748346235556483191431591924532394420028067810320408724414693462849062668387083308048250920654493340878733226377580847446324873797603734794648258113858631550404081017260381202919943892370942852601647398213554479081823593715429566945149312993664846779090437799284773675379284270660175134664833266377698642012106891355791141872776934080803504956794094648292880566056364718187662668970758537383352677420835574155945658542003634765324541006121012446785689171494803262408602693091211601973938229446636049901531963286159699077880427720289235539329671877182915643419079186525118678856821600897520171070499437657067342400871083908811800976259727431820539554256869460815355918458253398234382360435762759823179896116748424269545924633204614137992850814352018738480923581553988990897151469406131695614497783720743461373756218685106856826090696339815490921253714537241866911604250597353747823733268178182198509240226955826416016690084749816072843582488613184829905383150180047844353751554201573833105521980998123833253261228689824051777846588461079790807828367132384798451794011076569057522158680378961532160858387223882974380483931929541222100800313580688585002598879566463221427820448492565073106595808837401648996423563386109782045634122467872921845606409174360635618216883812562321664442822952537577492715365321134204530686742435454505103269768144370118494906390254934942358904031509877369722437053383165360388595116980245927935225901537634925654872380877183008301074569444002426436414756905094535072804764684492105680024739914490555904391369218696387092918189246157103450387050229300603241611410707453960080170928277951834763216705242485820801423866526633816082921442883095463259080471819329201710147828025221385656340207489796317663278872207607791034431700112753558813478888727503825389066823098683355695718137867882982111710796422706778536913192342733364556727928018953989153106047379741280794091639429908796650294603536651238230626
20,000th has 4180 digits: 1564344347109763849734765364072743458162050946855915883181245417404580803852433819127477934504143316103671237797087184052487157589846395314335101792632666883301188491698850377253383735812017943059782268835280360618754466932406192674904182868594738499500415166599602737300793712012046275485369495600019495004126039595217556097603510836899682827827626851274417838565958464881549888154511565687715162081527027421167926710592169405764372872023265791851279526521097739802047796738013885512616267273220024096214780132567479711643567372517808245262560562426651659391013837988476506124649092538307827326285964637268328029765707984607120961599796336714632362497169952413163370558311283612961033588836334352432860332222878648950508154331165678617373097939647648015552782638392654938551724289386017566932982065441392025369213734676739845068956966278536757235977421127565055467060906533383001625925978595472181091151062798507286798754728450358266089744616465914255799764431508559485853637841082521780322710748029546001980460990695999087046617731317608498316428164179967150350939374702201821818895349621858954893061034598954341939850973673870946183079728029105624782161827626661367017673681922257604178810154438462080217794489109678386881153826838075832058191153133704042628156419344516917867369755345135618986917642004521509538436204298618130363401395547933177643760161135638357088649014469358006518300404036431113143777969391584246934245800739809135619744598808977628245309941537928439431608665523308894967310600529498446943933665468406306292762942409786097847875240014036353917928156220446650579514092031254308059314931618726692376640987446459276331196950780063664171751110087644649773058213117640640085100552927878404516279461437503857017398937097042607258059612257878307007002086913210922626760728342901272768408974906007921227446242552261362505471751722906558235533709070548109789519920405521647836164156675304784097782435865165640401897107828859121831521126567446611716077075769257072773697947064329836969249852382976202348037425889031090020976240691949742160088733357875561841760194799534815496104106903184713919847662253483806138312440578732122855388348848736018217032877013531004653902335692761900988709302797685265501972628217528866551995479526195626503247164073793787381643388365618488630255600890924552511767690989186316859159306438477097458585889829326938198129884953178437411315486719927412151054551726325421747462698125767761987300812744880048122138953746796038485281452086680809803469350470844184375258620810652745992631459076192613797545486775651410699327289089628593588395142531659083933746399666161863597357735290387376161440280731398703030590410957840047591721635117677190494658658256770952605314604687704388833897300447300322491720569722311756874534871145435101596346787454258165870310592717473670917638475152605474446188958081898150393481484970581519902582271877141251593259282483539345792009117894084860435326938689664322383123823631494470354941767039585133484331342468806167901166928052638999423311570618981137348891538818027216596300491989181231598151123614651043205656474490923109982595235880446420678700336717534914381729578113169753046083981752465156933790288020841880688083888166659362896648911608716373579944854235997384986302902608821566689026676371268703303207406827737925274781301986480762462594420398637607893961010824979395439225300832931626540179218558345947558472159906873998923767432504278838419479068093778976997276416592421223235719653905071392295735398272851826350645605643470417155719500185143594804374322010189545136205568856276559806316789533450612097900180399440915139647060459321993254566103255011590902408116018722996267956826555434955409390951728022815209412027248353062982911544674007147249326697275010788100666958314965810320432736615962898175585320993128871046552842068867557341007383399180807449030159797672605530835244157256109268527578172314358255179589605335375414082046575557122636364391407861922824529441261003866098066404526541912783214030236752423547997110159548536582622929575859635210831021463323632502412193578592457118234067116894159316798758933206918936334540039454055299101076302263831614132510576874528929742319396129011617501
Even the 10,000th is too large for a double, and the 20,000th is double the size of the 10,000th, so imagine how large the 4,000,000th will be!
Stylistic issues:
my $i; for ($i=2; $i<4000000; $i++)
is much harder to read than
for my $i (2..$N-1)
with the following at the top to avoid having to repeat the number everywhere:
my $N = 4_000_000;
As if the fact that the 4 millionth Fibonacci number is more than 10^835950 isn't a big enough problem, this is not very good:
for ($t=3; $t<4000000; $t++) {
if (($fib[$t] % 2) != 0 ) {
delete $fib[$t]; } }
my $total = 0;
for ($n=1; $n<$#fib; $n++) {
$total += $fib[($n+1)];}
Why are you walking through the list twice here? Much better would be to combine the two loops into one. You want the sum of the odd terms, so sum the odd terms. Don't delete the odd terms (stylistically very bad) and then walk over the list again, relying on the fact that undef has a numerical value of 0 (but only with a warning).
And mn, the formatting of that code is very, very ugly. Eventually you will write code that someone else needs to read or maintain. My motto: Imagine that the person who will maintain your code is a psychopath who knows where you live.
As ikegami points out, your uninitialized problem is assuming delete removes elements from an array, when in fact it just sets them to undef (unless they are at the end of the array).
Given the storage requirements of the larger Fibonacci numbers, you don't want them in an array at all; fortunately, there's no need to keep them around for this problem.
I would do it like this (takes many minutes to run):
use strict;
use warnings;
use Math::BigInt 'lib' => 'GMP';
my $fib_A = Math::BigInt->new(0);
my $fib_B = Math::BigInt->new(1);
my $sum = Math::BigInt->new(0);
# get the next 3999998
for (1..(4000000-2)) {
my $next = $fib_A + $fib_B;
$sum += $next if $next % 2 == 0;
($fib_A, $fib_B) = ($fib_B, $next);
}
print "The sum is $sum\n";