Number functions I have lying around

[Lady_Aleena]

I was going through old scripts I had lying around and decided to clean them up a bit. I don't remember why I wrote them or what I am going to do with them. I think they are lukewarm uses for perl, and I probably reinvented the wheel on some of them. Instead of them just lying around my hard drive collecting dust, I share them with you, kind reader. Do with them what you will.

The first function lists primes, the second two functions list fractions, the last few are about Roman numerals. I lumped them together in a module called Numbers because I ran out of imagination.

Welcome to my sandbox.

package Fun::Numbers;
use strict;
use warnings;

use List::Util qw(sum);

## Primes function

# primes gets a list of primes between 1 and a specified number.
# If the user wants all primes from 1 to 100, the usage would be...
# primes(100);

sub primes {
  my $last_number = shift;
  my @primes;
  for my $number (1..$last_number) {
    # all numbers ending in 2, 4, 6, 8, or 0 are divisible by 2.
    # all numbers ending in 5 or 0 are divisible by 5.
    next if $number =~ /(2|4|5|6|8|0)$/;

    # numbers where the sum of the digits are evenly divisible by 3 ar
+e divisible by 3.
    next if sum(split(//,$number)) % 3 == 0;
    
    # numbers where the sum of the digits are evenly divisible by 9 ar
+e divisible by 9.
    next if sum(split(//,$number)) % 9 == 0;
    
    # There are other tests like the two above, however, they require 
+breaking the number
    # and doing other calculations based on the number. I decided to s
+kip those as they 
    # are computation heavy.

    my $match = 0;
    for my $divisor (2..$last_number) {
      $match++, last if ($number != $divisor && $number % $divisor == 
+0);
    }
    push @primes, $number if $match == 0;
    
    # adding 2, 3, and 5 back to the list since they were excluded abo
+ve.
    push @primes, (2,3,5) if $number == 1;
  }
  return @primes;
}

## Fraction functions

# fraction_value returns the fractional value of a number.
# If the user wants 78/99 of 28, the usage would be...
# fraction_value(78, 99, 28);

sub fraction_value {
  my ($numerator, $denominator, $number) = @_;
  return ($number / $denominator) * $numerator;
}

# fractions_values returns a hash of all the fractional values of a nu
+mber.
# If the user wants the values of 1/2 to 98/99 of 28, the usage would 
+be...
# fractions_values(99, 28);
# fractions_values function written with the help of mofino and go|dfi
+sh in #perlcafe on freenode.

sub fractions_values {
  my ($max_denom, $number) = @_;
  my $max_denominator = $max_denom ? $max_denom : 4;

  my %fractions;
  for my $numerator (1..$max_denominator) {
    for my $denominator (($numerator + 1)..$max_denominator) {
      my $fraction = "$numerator/$denominator";
      $fractions{$fraction} = fraction_value($numerator, $denominator,
+ $number);
    }
  }

  return %fractions;
}

## Roman numerals functions

# The use of lowercase letters to represent larger numbers is from Mat
+h::Roman.
# The use of underscore after to represent larger numbers is from Text
+::Roman.
# The use of underscore before to represent larger numbers is for comp
+leteness.

my %big_Roman_numerals = (
  'simple' => {
    'lowercase' => [qw(v x l c d m)],
    'underscore after'  => [qw(V_ X_ L_ C_ D_ M_)],
    'underscore before' => [qw(_V _X _L _C _D _M)]
  },
  'complex' => {
    'lowercase' => [qw(Mv Mx xl xc cd cm)],
    'underscore after'  => [qw(MV_ MX_ X_L_ X_C_ C_D_ C_M_)],
    'underscore before' => [qw(M_V M_X _X_L _X_C _C_D _C_M)]
  }
);


# list_Roman_numerals_values returns a hash with the values of the ind
+ividual Roman numerals.
# If the user wants the Roman numerals for 4,000 and higher notated by
+ an underscore after the letter, the usage would be..
# list_Roman_numerals_values('underscore after');
# The other two options are 'lowercase' and 'underscore before'.

sub list_Roman_numerals_values {
  my ($big_numeral) = @_;
  
  my @RSN = (qw(I V X L C D M),     @{$big_Roman_numerals{'simple'}{$b
+ig_numeral}});  # Roman simple numerals
  my @RCN = (qw(IV IX XL XC CD CM), @{$big_Roman_numerals{'complex'}{$
+big_numeral}}); # Roman complex numerals

  my %R2A; # Roman to Arabic
  @R2A{@RSN, @RCN} = qw(
      1 5 10 50 100 500 1000 5000 10000 50000 100000 500000 1000000
      4 9 40 90 400 900 4000 9000 40000 90000 400000 900000
  ); # numeric values
  
  return %R2A;
}

# list_values_Roman_numerals returns a hash with the individual Roman 
+numerals of the values.
# It is the reverse of list_Roman_numerals_values with the same usage.

sub list_values_Roman_numerals {
  my ($big_numeral) = @_;
  my %A2R = reverse list_Roman_numerals_values($big_numeral);
  return %A2R; # Arabic to Roman
}

# Roman_overline returns a string with the large Roman numerals in an 
+HTML span to achieve the overline.
# If the user wants the overline on 'mdxcMvXVIII', the usage would be.
+..
# Roman_overline('mdxcMvXVIII', 'lowercase');
# Thanks to ikegami and runrig for their assistance in the CB the the 
+regexen.

sub Roman_overline {
  my ($string, $notation) = @_;

  if ($notation eq 'lowercase') {
    $string =~ s/(\b|[VXLCDM]+)([vxlcdm]+)(\b|[IVXLCDM]+)/$1<span clas
+s="overline">\U$2\E<\/span>$3/g;
  }
  if ($notation =~ /underscore/) {
    if ($notation =~ /after/) {
      $string =~ s/((\w_)+)/<span class="overline">$1<\/span>/g;
    }
    if ($notation =~ /before/) {
      $string =~ s/((_\w)+)/<span class="overline">$1<\/span>/g;
    }
    $string =~ s/_//g;
  }

  return $string;
}

1;

If you want to see a Roman numeral (MDCCCMVCXXVII) with the overline, go to your display settings and set up the overline class in your style sheet as follows...

.overline { text-decoration: overline; }

[choroba]

Note that the primes subroutine is quite inefficient and returns 1 as well, which is usually not considered prime.

Here's a faster one:

#! /usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

sub primes {
    my $n = shift;
    return if $n < 2;

    my @primes = (2);
    for my $i (3 .. $n) {
        my $sqrt = sqrt $i;
        my $notprime;
        for my $p (@primes) {
            last if $p > $sqrt;

            $notprime = 1, last if 0 == $i % $p;
        }
        push @primes, $i unless $notprime;
    }
    return @primes
}


use List::Util qw{ sum };
sub primes_la {
    # Copy your code here.
}

use Test::More tests => 1;
is_deeply([1, primes(10000)], [primes_la(10000)], 'same');

use Benchmark qw{ cmpthese };

cmpthese(-10,
        { ch => 'primes(10000)',
          la => 'primes_la(10000)',
        });
__END__
1..1
ok 1 - same
     s/iter     la     ch
la     1.35     --   -99%
ch 1.06e-02 12662%     --

[Discipulus]

ack! ouch! choroba now i need to replace the code for primality check taken from this node used in my Tk-Tartaglia. I think your code is worth to put in the previously mentioned thread.


      Rate     la     di     ch
la 0.325/s     --   -99%   -99%
di  25.0/s  7572%     --   -49%
ch  48.6/s 14822%    95%     --



L*

[johngg]

Eratosthenes was a clever chap!

use strict;
use warnings;

use Benchmark qw{ cmpthese };

use Test::More tests => 1;
is_deeply(
   [ primes( 10000 ) ],
   [ primes_jg( 10000 ) ],
   'same'
   );

cmpthese(
   -10,
   {
       ch => 'primes( 10000 )',
       jg => 'primes_jg( 10000 )',
   }
   );

sub primes_jg
{
    my $limit     = shift;
    my $sqrtLimit = sqrt $limit;
    
    my $sieve                = q{};
    vec( $sieve, 0, 1 )      = 1;
    vec( $sieve, 1, 1 )      = 1;
    vec( $sieve, $limit, 1 ) = 0;

    my @primes;
    my $reached = 1;
    while( $reached < $sqrtLimit )
    {
        my $prime = $reached + 1;
        ++ $prime while vec( $sieve, $prime, 1 );
    
        push @primes, $prime;
        my $fill = 2 * $prime;
        while( $fill <= $limit )
        {
            vec( $sieve, $fill, 1 ) = 1;
            $fill += $prime;
        }
        $reached = $prime;
    }
    
    foreach my $value ( $reached + 1 .. $limit )
    {
        push @primes, $value unless vec( $sieve, $value, 1 );
    }

    return @primes;
}

sub primes {
    my $n = shift;
    return if $n < 2;

    my @primes = (2);
    for my $i (3 .. $n) {
        my $sqrt = sqrt $i;
        my $notprime;
        for my $p (@primes) {
            last if $p > $sqrt;

            $notprime = 1, last if 0 == $i % $p;
        }
        push @primes, $i unless $notprime;
    }
    return @primes
}

1..1
ok 1 - same
     Rate   ch   jg
ch 71.0/s   -- -25%
jg 94.7/s  33%   --

I hope this is of interest.

[Discipulus]

And you can profit of an enhencemt if you too add if($i%2==0){next} before eleborating the square root, as you can see in the ch_opt row.


          Rate     la     di     ch ch_opt
la     0.329/s     --   -99%   -99%   -99%
di      25.3/s  7600%     --   -50%   -56%
ch      50.4/s 15230%    99%     --   -12%
ch_opt  57.6/s 17417%   127%    14%     --


L*

[Anonymous Monk]

A modest improvement in speed may be obtained if one implements the wheel.

For example (the modulus is relatively cheap in perl):

sub primes {
    my $n = shift;
    return if $n < 2;

    my @primes = (2);

I:  for my $i (3 .. $n) {
        next unless 0x208a28aa & (1 << $i % 30);

        my $sqrt = int sqrt $i;
        for my $p (@primes) {
            next I unless $i % $p;
            last if $p > $sqrt;
        }
        push @primes, $i;
    }
    return @primes
}

[Lady_Aleena]

A few questions for you choroba...

• Why aren't you eliminating numbers which end with 2, 4, 5, 6, 8, and 0 right off the bat?
• If sqrt($number) == int(sqrt($number), then you wouldn't have to go through the @primes loop, right?
• What is the @primes loop doing?
• I think $n stands for "number", but what do $i and $p represent??

Thank you for stopping by.

[choroba]

Here's the algorithm in plain words: Let's create the list of primes up to $n. We start with just 2 as the known prime. Then, for each number $i between 3 and $n, we do the following: we try to divide the number $i by all the known primes up to sqrt $i. If any of them divides the number, then it can't be prime. If none of them divides it, it is a prime, though: because a) if a non-prime $d divides $i, then $d = $p1 * $d1, where $p1 is prime, and $p1 divides $i; b) if a number $p2 greater than sqrt $i divides $i, then $i / $p2 must be less than sqrt $i, and it must divide $i. If we find a new prime, we push it to the list.
• I don't eliminate numbers ending with 2, 4, 5, 6, 8, and 0, because they get eliminated in the 0 == $i % $p test.
• testing every number for sqrt $i == int sqrt $i wouldn't help us much, as it happens rarely.
• the @primes loop, as described above, tries to divide the candidate $i by all the known primes up to sqrt $i, to check its primality.
• $n represents the highest number, we are interested in primes less or equal $n. $i is the candidate, i.e. the number we might include in the @primes list if it passes the primality test. $p is a known prime less or equal sqrt $i.

[aaron_baugher]

One small note on the tests for non-primes: any number divisible by 9 is also divisible by 3, so your test for divisibility by 9 will never be true.