Need help to understand Perl code implementing Sieve of Eratosthenes - perl

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

Related

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

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

Perl for-loop not working as expected

I've been teaching myself Perl for the past couple weeks. For practice, I've been going through problems over at projecteuler.net. I've got a pair of nested for-loops that aren't working as expected. For context, the problem is to find the largest palindromic number that is the product of two 3-digit numbers. Here's my code:
sub isPalindrome($)
{
return 0 if length($_[0]) <= 1;
$reverse = reverse $_[0];
$_[0] == $reverse ? return 1 : return 0;
}
sub findPalindrome{
for($i = 999; $i >= 100; $i--)
{
for($j = 999; $j >= 100; $j--)
{
print "$i\t$j\n";
return ($i, $j, $j * $i) if(isPalindrome($j * $i)); #return the two factors followed by their product#
}
}
}
($factor1, $factor2, $product) = findPalindrome();
print "$factor1 * $factor2 = $product\n";
My problem is that sub findPalindrome is not working as expected. I'm find a palindromic number, but not the highest; it's like it's skipping something in the loop. To try and track down the problem, I inserted the line of code above to make it print out each pair of numbers it iterates through, and it looks like it's iterating properly. My guess is that for-loops in Perl work differently than I'm used to in C++; either way, I'm lost. What am I missing?
Edit: The answer I'm getting is "995 * 583 = 580085", which is indeed a palindromic number, and the multiplication is correct, but it's the wrong answer according to Project Euler. On a whim, I changed the for loops in sub findPalindrome to iterate through 999 to 900, and that gave me the correct answer ("993 * 913 = 906609"). For some reason, when the bottom of the range is 100, it fails to find the answer; when the bottom of the range is 900, it does find it.
I finally read the problem description on top of your question ;) Your loop is not iterating in the desired order. For example 998*998 is encountered after 999*100.

Perl: increment 2d array cell?

I have a set of numerical data for which is important to me to know what pairs of numbers occurred together, and how many times. Each set of data contain 7 numbers betwen 1 and 20. There are several hundred sets of data.
Essentially, by parsing each set of my data, I want to create a 20 x 20 array that I can use to keep a count of when pairs of numbers occurred together.
I have done a lot of searching, but maybe I've used the wrong key words. I've seen loads of examples how to create a "2D array" - I know perl doesn't actually do that, and that it's really an array of references - and to print the values contained therein, but nothing really on how to work with one particular cell by number and alter it.
Below is my conceptual code. The commented lines don't work, but illustrate what I want to achieve. I'm reasonably new to coding perl, and this just seems to advanced for me to understand the examples I've seen and translate it into something I can actually use.
my #datapairs;
while (<DATAFILE>)
{
chomp;
my #data = split(",",$_);
for ($prcount=0; $prcount <=5; $prcount++)
{
for ($othcount=($prcount+1); $othcount<=6; $othcount++)
{
#data[$prcount]=#data[$prcount]+1;
#data[$othcount]=#data[$othcount]+1;
#data[$prcount]=#data[$prcount]-1;
#data[$othcount]=#data[$othcount]-1;
print #data[$prcount]." ".#data[$othcount]."; ";
##datapairs[#data[$prcount]][#data[$othcount]]++;
##datapairs[#data[$othcount]][#data[$prcount]]++;
}
}
}
Any input or suggestions would be much appreciated.
To access a "cell" in a "2-d array" in Perl (as you alredy figured out, it's an array of arrayrefs), is simple:
my #datapairs;
# Add 1 for a pair with indexes $i and $j
$datapairs[$i]->[$j]++;
print that value
print "$datapairs[$i]->[$j]\n";
It's not clear what you mean by "occur together" - if you mean "in the same length-7 array", it's easy:
my #datapairs;
while (<DATAFILE>) {
chomp;
my #data = split(",", $_);
for (my $prcount = 0; $prcount <= 5; $prcount++) {
for (my $othcount = $prcount + 1; $othcount <=6 ; $othcount++) {
$datapairs[ $data[$prcount] ]->[ $data[$othcount] ]++;
}
}
}
# Print
for (my $i = 0; $i < 20; $i++) {
for (my $j = 0; $j < 20; $j++) {
print "$datapairs[$i]->[$j], ";
}
print "\n";
}
As a side note, personally, just for stylistic reasons, I strongly prefer to reference EVERYTHING, e.g. use arrayref of arrayrefs instead of array of arrays. E.g.
my $datapairs;
# Add 1 for a pair with indexes $i and $j
$datapairs->[$i]->[$j]++;
print that value
print "$datapairs->[$i]->[$j]\n";
The second (and third...) arrow dereference operator is optional in Perl but I personally find it significantly more readable to enforce its usage - it spaces out the index expressions.

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

How is this Perl code selecting two different elements from an array?

I have inherited some code from a guy whose favorite past time was to shorten every line to its absolute minimum (and sometimes only to make it look cool). His code is hard to understand but I managed to understand (and rewrite) most of it.
Now I have stumbled on a piece of code which, no matter how hard I try, I cannot understand.
my #heads = grep {s/\.txt$//} OSA::Fast::IO::Ls->ls($SysKey,'fo','osr/tiparlo',qr{^\d+\.txt$}) || ();
my #selected_heads = ();
for my $i (0..1) {
$selected_heads[$i] = int rand scalar #heads;
for my $j (0..#heads-1) {
last if (!grep $j eq $_, #selected_heads[0..$i-1]);
$selected_heads[$i] = ($selected_heads[$i] + 1) % #heads; #WTF?
}
my $head_nr = sprintf "%04d", $i;
OSA::Fast::IO::Cp->cp($SysKey,'',"osr/tiparlo/$heads[$selected_heads[$i]].txt","$recdir/heads/$head_nr.txt");
OSA::Fast::IO::Cp->cp($SysKey,'',"osr/tiparlo/$heads[$selected_heads[$i]].cache","$recdir/heads/$head_nr.cache");
}
From what I can understand, this is supposed to be some kind of randomizer, but I never saw a more complex way to achieve randomness. Or are my assumptions wrong? At least, that's what this code is supposed to do. Select 2 random files and copy them.
=== NOTES ===
The OSA Framework is a Framework of our own. They are named after their UNIX counterparts and do some basic testing so that the application does not need to bother with that.
This looks like some C code with Perl syntax. Sometimes knowing the language the person is thinking in helps you figure out what's going on. In this case, the person's brain is infected with the inner workings of memory management, pointer arithmetic, and other low level concerns, so he wants to minutely control everything:
my #selected_heads = ();
# a tricky way to make a two element array
for my $i (0..1) {
# choose a random file
$selected_heads[$i] = int rand #heads;
# for all the files (could use $#heads instead)
for my $j (0..#heads-1) {
# stop if the chosen file is not already in #selected_heads
# it's that damned ! in front of the grep that's mind-warping
last if (!grep $j eq $_, #selected_heads[0..$i-1]);
# if we are this far, the two files we selected are the same
# choose a different file if we're this far
$selected_heads[$i] = ($selected_heads[$i] + 1) % #heads; #WTF?
}
...
}
This is a lot of work because the original programmer either doesn't understand hashes or doesn't like them.
my %selected_heads;
until( keys %selected_heads == 2 )
{
my $try = int rand #heads;
redo if exists $selected_heads{$try};
$selected_heads{$try}++;
}
my #selected_heads = keys %selected_heads;
If you still hate hashes and have Perl 5.10 or later, you can use smart-matching to check if a value is in an array:
my #selected_heads;
until( #selected_heads == 2 )
{
my $try = int rand #heads;
redo if $try ~~ #selected_heads;
push #selected_heads, $try;
}
However, you have a special constraint on this problem. Since you know there are only two elements, you just have to check if the element you want to add is the prior element. In the first case it won't be undef, so the first addition always works. In the second case, it just can't be the last element in the array:
my #selected_heads;
until( #selected_heads == 2 )
{
my $try = int rand #heads;
redo if $try eq $selected_heads[-1];
push #selected_heads, $try;
}
Huh. I can't remember the last time I used until when it actually fit the problem. :)
Note that all of these solutions have the problem that they can cause an infinite loop if the number of original files is less than 2. I'd add a guard condition higher up so the no and single file cases through an error and perhaps the two file case doesn't bother to order them.
Another way you might do this is to shuffle (say, with List::Util) the entire list of original files and just take off the first two files:
use List::Util qw(shuffle);
my #input = 'a' .. 'z';
my #two = ( shuffle( #input ) )[0,1];
print "selected: #two\n";
It selects a random element from #heads.
Then it adds on another random but different element from #heads (if it is the element previously selected, it scrolls through #heads till it find an element not previously selected).
In summary, it selects N (in your case N=2) different random indexes in #heads array and then copies files corresponding to those indexes.
Personally I would write it a bit differently:
# ...
%selected_previously = ();
foreach my $i (0..$N) { # Generalize for N random files instead of 2
my $random_head_index = int rand scalar #heads;
while ($selected_previously[$random_head_index]++) {
$random_head_index = $random_head_index + 1) % #heads; # Cache me!!!
}
# NOTE: "++" in the while() might be considered a bit of a hack
# More readable version: $selected_previously[$random_head_index]=1; here.
The part you labeled "WTF" isn't so troubling, it's just simply making sure that $selected_heads[$i] remains as a valid subscript of #head. The really troubling part is that it is a pretty inefficient way of making sure he's not selecting the same file.
Then again, if the size of #heads is small, stepping from 0..$#heads is probably more efficient than just generating int rand( 2 ) and testing if they are the same.
But basically it copies two files at random (why?) as a '.txt' file and a '.cache' file.
How about just
for my $i (0..1) {
my $selected = splice( #heads, rand #heads, 1 );
my $head_nr = sprintf "%04d", $i;
OSA::Fast::IO::Cp->cp($SysKey,'',"osr/tiparlo/$selected.txt","$recdir/heads/$head_nr.txt");
OSA::Fast::IO::Cp->cp($SysKey,'',"osr/tiparlo/$selected.cache","$recdir/heads/$head_nr.cache");
}
unless #heads or #selected_heads are used later.
Here's yet another way to select 2 unique random indices:
my #selected_heads = ();
my #indices = 0..$#heads;
for my $i (0..1) {
my $j = int rand (#heads - $i);
push #selected_heads, $indices[$j];
$indices[$j] = $indices[#heads - $i - 1];
}