I started learning perl recently and I wrote this code to find the largest palindrome product that can be obtained by multiplying 2 3-digit numbers. (question here: https://projecteuler.net/problem=4 )
Here is the code:
#!/usr/bin/perl
use 5.010;
sub checkpal{
for ($k=0;$k<length($_[0]);$k++){$b = substr ($_[0], $k, 1).$b;}
if ($_[0] eq $b){1}else{0}
}
$pals = $numb1 = undef;
for ($i = 998001; $i>=10000; $i--){
if (&checkpal($i)){
for ($j = 100; $j <1000; $j++){
if ( !($i % $j) && (length $j == 3) ){$numb1 = $j; $pals = $i; last;}
}
}
if (defined $numb1){last}
}
say $numb1." ".($pals/$numb1);
My idea is quite simple. It simply goes through a loop starting from 998001 (the largest value that product of 2 3-digit number can have) and check if the value is palindrome. If it is a palindrome, it goes through another loop to check if it can be obtained by multiplying 2 three digit numbers. Now, this algorithm might not be the most efficient or the best in the world, it should at least give the result. Which it isn't.
The problem isn't in the subroutine checkpal as far as I know. But the if (&checkblock($i)) block doesn't get executed even when $i is a palindrome. And I don't know why. Sorry if it is obvious or something .. but please tell me why it isn't working?
if ( !($i % $j) and length($i/$j)==3) { .. }
instead of
if ( !($i % $j) && (length $j == 3) )
as you want to check whether $i/$j has three digits, not $j which goes anyway from 100 to 999.
As a side-note,
if (checkpal($i))
can be replaced with simple
if ($i eq reverse $i)
Related
I'd tried lots of ways to get rid of this problem but... I can't find what's the problem of this code.
I use Perl and I want to find the prime number between 1-100.
use strict;
my $i=0;
my $j=0;
my $count=0;
for ($i=0; $i<101; $i++)
{
for ($j=2; $j<$i; $j++)
{
if ($i%$j==0)
{
$count+=1;
}
}
if ($count==0)
{
print "$i\n";
}
}
There are a few things to think about as you use the Sieve of Eratosthenes. Armali already pointed out that you were reusing the value in $count because you had it in a higher scope, so it didn't reset for each number you wanted to check.
But, I reformatted your code a bit:
use v5.10;
NUM: for( my $i=1; $i < 101; $i++ ) {
DIVISOR: for( my $j=2; $j < $i; $j++ ) {
next NUM if $i%$j == 0;
}
say $i;
}
Instead of using a flag variable ($count) to figure out what to do, you can use loop controls. If you find any divisor, you know that you have found a non-prime and there's no need to continue. That is, you don't need to count divisors.
When you find one, stop and move on to the next number. To do that, I've labeled the looping constructs. That way, in the inner loop I can skip to the next iteration of the outer loop. And, usually, once I label one loop I label them all but you don't need to do that.
Once you figure that part out, you don't need to do so much work. Aside from 2, you know that all the even numbers are not prime. You don't need to check those. So, instead of being clever, I'll just break out 2 as a special case:
use v5.10;
say 2;
NUM: for( my $i = 3; $i < 101; $i += 2 ) {
DIVISOR: for( my $j=2; $j < $i; $j++ ) {
next NUM if $i%$j == 0;
}
say $i;
}
The inner loop is doing too much work too. None of the numbers that you are checking are even, so you don't need to check any even divisors (or those ending 5 once you choose 5). And, you only have to go half way, so you can stop when you get to the square root of the number.
#!perl
use v5.10;
say 2;
NUM: for( my $i = 3; $i < 101; $i += 2 ) {
my $stop_at = int sqrt $i;
DIVISOR: for( my $j=3; $j <= $stop_at; $j += 2 ) {
next NUM if $i % $j == 0;
}
say $i;
}
And, for a final flourish, I'll take the top number from the command-line arguments but default to 100. With that, the comparison in the outer loop changes to <=:
#!perl
use v5.10;
my $limit = $ARGV[0] // 100;
say 2;
NUM: for( my $i = 3; $i <= $limit; $i += 2 ) {
my $stop_at = int sqrt $i;
DIVISOR: for( my $j=3; $j <= $stop_at; $j += 2 ) {
next NUM if $i % $j == 0;
}
say $i;
}
But, ikegami notes in a comment that for my $x (0..$n-1) is more idiomatic. That doesn't easily handle step sizes larger than 1. You can do various things to multiply that number to get the candidate number, or ways to generate the list ahead of time (but that means you have the list all at once). I'll switch to a while instead, and assume that these other bits do their work properly.
The $get_number is some magic subroutine that always gives us back the next number, and the is_prime does what it does to make the determination:
while( my $n = $get_number->() ) {
say $n if is_prime($n);
}
Here's one way that might work. First, there's a nifty Perl regex trick to determine primes. It doesn't matter that I'm using that because you can change it to whatever you like because it's hidden behind is_prime. The biggest benefit here is that it's short (and a bit of a show off):
#!perl
use v5.10;
my $get_number = generate_sub( $ARGV[0] // 100 );
while( my $n = $get_number->() ) {
say $n if is_prime($n);
}
sub is_prime { ( '1' x $_[0] ) !~ /\A(11+?)\1+\z/ }
sub generate_sub {
my( $limit ) = #_;
sub {
state $queue = [ 2, 3 ];
return if $queue->[0] > $limit;
push $queue->#*, $queue->[-1] + 2;
shift $queue->#*;
}
}
The generate_sub is a bit more tricky. First, the 2 makes is a bit tricky. Second, Perl doesn't have a yield like Python or Ruby (would be nice). To get around that, I'll see a queue with the first two numbers then add the next number based on the last on (so, adding 2 to 3 gets 5, and so on). That gets around the unique interval from 2 to 3. This stops if the next number in the queue is above the one that you want.
But, that's a bit complicated and only there to handle the special case of 2. I've been playing with a different idiom lately although I'm not convinced its desirable.
The state is a way to declare a persistent lexical variable. It runs only on the first execution. We'll use a state to return the first 2 right away. Then, the next time we come around, that $rc statement doesn't run and $next has 3. From there, I get the current number (0+$next so it's not the same data), and increment $next in a list, but only return the first in that list. That's just a trick that condenses the if-else:
sub generate_sub {
my( $limit ) = #_;
sub {
state $rc = do { return 2 };
state $next = 3;
return $next <= $limit ? ( 0+$next, $next += 2 )[0] : ();
}
}
I don't recommend this for your problem, but you should consider a way to generate the list of numbers so it's not tightly coupled to the problem. That way, you can get rid of the looping constructs.
But, that's much more than you needed to know.
You initialized my $count=0; outside instead of inside the outer for loop.
Besides that, $i should start from 2 rather than 0.
I came across code:
sub insertDecimal
{
my $number = shift;
my $sigDigRight = shift;
if ($number =~ /\./) { return ($number); }
elsif (length $number < $sigDigRight) { return ($number); }
else
{
my $leftSide = substr($number, 0, (length $number)-$sigDigRight);
my $rightSide = substr($number, (length $number)-$sigDigRight, );
return ($leftSide . "." . $rightSide);
}
}
And I hoped to improve/re-write as:
sub insertDecimal
{
my ($number, $sigDigRight) = #_;
return $number if index ($number, '.') != -1 or length $number < $sigDigRight;
# YES! substr takes an LVALUE ... perldoc it for more :)
substr($number, -$sigDigRight, 0) = '.';
return $number;
}
I was very surprised that a run of some 74mm records had almost no improvement at all with 2nd version.
Questions:
Anyone to overflow with better way to make insertDecimal more efficient ?
How come I see no improvement, at all (just one minute better on 74MM records) ?
If Perl compiler is re-jiggering the code of the first version to be more efficient, is there anyway I can see the improved path to execution that Perl has chosen ?
Both routines would seem to do essentially the same amount of work:
scan $number for a single character (any compiler ought be able to reduce that regex match to an index)
compare the length of $number to a limit
possibly insert a single character somewhere within $number
Using lvalue substr (or, just taking advantage of the fourth argument to substr) may make the insertion a little more efficient, but, after all, things will have to be moved.
To my eye, the biggest opportunity for optimization comes from moving the length check ahead of the check for the decimal point.
I would be tempted to re-write your routine as
sub insertDecimal {
my ($number, $sigDigRight) = #_;
return $number if length($number) < $sigDigRight;
return $number if index($number, '.') >= 0;
substr($number, -$sigDigRight, 0, '.');
$number;
}
I find simple decisions and short lines to be easier to understand. I do not think this should change the correctness of the function.
An ugly alternative is:
sub gah {
my ($number, $sigDigRight) = #_;
my $n = length($number) - $sigDigRight;
return $number unless $n > 0;
$number =~ s{\A ([^.]{$n}) ([^.]+) \z}{$1.$2}x;
$number;
}
That combines the check for . with the replacement operation.
Again, I cannot be certain this is correct wrt your spec, but it is something for you to explore.
I probably would not opt for gah unless the improvement was more than 20% of something that took at least an hour or so. On my system, it slows down a simple example by 1,000%.
I have the following vector:
19.01
20.2572347267
16.4893617021
19.0981432361
36.3636363636
20.41
It's actually much longer, but that doesn't matter. I need an algorithm to bin these values into a hash. The hash keys must be floating point values that start from the minimum value + 1 (in this case 17.48...) and increase by 1. The values of the hash must be the number of elements that fall into the corresponding bin, i.e. the end result should be:
$hash{17.49}=1
$hash{18.49}=0
$hash{19.49}=2
$hash{20.49}=2
$hash{21.49}=0
$hash{22.49}=0
.
.
.
$hash{35.49}=0
$hash{37.49}=1
Please help guys.
This seems to work:
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
use List::Util qw{ min };
my #vector = qw( 19.01
20.2572347267
16.4893617021
19.0981432361
36.3636363636
20.41
);
my %hash;
my $min = min(#vector);
for my $n (#vector) {
my $diff = $n - $min;
++$hash{ 1 + $min + int $diff };
}
print Dumper \%hash;
If you need the zeroes as well, just add the follwoing before the loop:
my $max = max(#vector);
my $i = $min;
while ($i <= $max) {
$hash{$i++} = 0;
}
(And include max in the use clause, too.)
Came up with a sweet solution, hopefully somebody else will also find it helpful.
use POSIX;
sub frac { $_[0]-floor($_[0]) } #saw this little function posted somewhere, quddos to the guy who came up with it
for (my $x = ${min_value} + 1; $x <= ${max_value} + 1; $x += 1) # if you don't need the zeroes, remove this loop
{
$bins{$x} = 0;
}
foreach my $n (#array)
{
$bins{floor($n+1)+frac($min_value)}++;
}
floor() or ceil() (and use POSIX;) should be used instead of int(), because int() can produce erenous results - 278 may be internally stored as 277.99999999997899999 (for example), so int(278) turns out equal to 277, which may mess up your computation. Read this somewhere, but can't find the link...
I've got an array in perl which contains sorted non-contiguous values. For example: 1 2 3 5 7 11 13 15.
I want to remove all values that are outside lower and upper, keeping lower and upper in the returned selection. My method of doing that looks like this (could probably be improved by using slice):
my #culledArray;
for ( my $i = 0; $i < scalar(#array); $i++ ) {
if ( ( $array[$i] <= $_[1] ) and ( $array[$i] >= $_[0] ) ) {
push(#culledArray, $array[$i]);
}
}
where the lower and upper are contained in $_[0] and $_[1], respectively. Is there a perl builtin that does this?
Don't know anything built-in that would do that (that is quite a specific requirement), but you can save yourself some typing by using grep:
my #culledArray = grep {( $_ <= $_[1] ) and ( $_ >= $_[0] )} #array;
If the list is long and you don't want to copy it, finding the start and end indices and using a slice might be interesting.
This is messy, but my unit tests pass, so it seems to work. Take the lower and upper indexes, based on the fact that #array is a sorted list and $_[0] >= $_[1], then create the #culledArray from #array[$lower..$upper]:
my #culledArray;
my $index = 0;
++$index until $array[$index] >= $_[0];
my $lowerIndex = $index;
while (($array[$index] <= $_[1]) and ($index < $#array)) { ++$index; }
my $upperIndex = $index;
#culledArray = #array[$lowerIndex .. $upperIndex];
return \#culledArray;
I'd love to know the efficiency of this vs the answer Mat gave. I'm almost sure that I don't necessarily traverse the entire #array (because I traverse from index of 0 until I find the $upperIndex. I'm not sure how the grep method in the linked answer works, or how perl implements the slicing of #array to #culledArray in the above code, though.
It looks like you may be using percentiles or quantiles? If so then Statistics::Descriptive may help.
The percentile method returns the value and index at that percentile, so you can use code as below
use strict;
use warnings;
use Statistics::Descriptive;
my #data = qw/ 1 2 3 5 7 11 13 15 /;
my $stat = Statistics::Descriptive::Full->new;
$stat->add_data(#data);
my ($d25, $i25) = $stat->percentile(25);
my ($d75, $i75) = $stat->percentile(75);
my #subset = ($stat->get_data)[$i25 .. $i75];
print "#subset\n";
output
2 3 5 7 11
I want to parse a file line by line, each of which containing two integers, then sum these values in two distinct variables. My naive approach was like this:
my $i = 0;
my $j = 0;
foreach my $line (<INFILE>)
{
($i, $j) += ($line =~ /(\d+)\t(\d+)/);
}
But it yields the following warning:
Useless use of private variable in void context
hinting that resorting to the += operator triggers evaluation of the left-hand side in scalar instead of list context (please correct me if I'm wrong on this point).
Is it possible to achieve this elegantly (possibly in one line) without resorting to arrays or intermediate variables?
Related question: How can I sum arrays element-wise in Perl?
No, it's because the expression ($i, $j) += (something, 1) parses as adding 1 to $j only, leaving $i hanging in void context. Perl 5 has no hyper-operators or automatic zipping for the assignment operators such as +=. This works:
my ($i, $j) = (0, 0);
foreach my $line (<INFILE>) {
my ($this_i, $this_j) = split /\t/, $line;
$i += $this_i;
$j += $this_j;
}
You can avoid the repetion by using a compound data structure instead of named variables for the columns.
First of all, your way of adding arrays pairwise does not work (the related question you posted yourself gives some hints there).
And for the parsing part: How about just splitting the lines? If your lines are formatted accordingly (whitespaces should not be a problem).
split(/\t/, $line, 2)
If you really, really want to do it in one line, you could do something like this (though I don't think you would call it elegant):
my #a = (0, 0);
foreach my $line (<INFILE>)
{
#a = map { shift(#a)+$_ } split(/\t/, $line, 2);
}
For an input of #lines = ("11\t1\n", " 22 \t 2 \n", "33\t3"); it gave me the #a = (6, 66)
I would advise you to use the split part of my answer, but not the adding up part. There is nothing wrong in using more than one line! If it makes your intention clearer, more lines are better than one. But than again I'm hardly using perl nowadays but python instead, so my perl coding style might have a "bad" influence there...
It is quite possible to swap the pair over for each addition, meaning you're always adding to the same element in each pair. (This generalises to rotating multi-element arrays if required.)
use strict;
use warnings;
my #pair = (0, 0);
while (<DATA>) {
#pair = ($pair[1], $pair[0] + $_) for /\d+/g;
}
print "#pair\n";
__DATA__
99 42
12 15
18 14
output
129 71
Here's another option:
use Modern::Perl;
my $i = my $j = 0;
map{$i += $_->[0]; $j += $_->[1]} [split] for <DATA>;
say "$i - $j";
__DATA__
1 2
3 4
5 6
7 8
Output:
16 - 20