Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Number functions I have lying around

by Lady_Aleena (Curate)
on Mar 31, 2015 at 00:30 UTC ( #1121927=CUFP: print w/replies, xml ) Need Help??

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; }
No matter how hysterical I get, my problems are not time sensitive. So, relax, have a cookie, and a very nice day!
Lady Aleena

Replies are listed 'Best First'.
Re: Number functions I have lying around
by choroba (Archbishop) on Mar 31, 2015 at 08:55 UTC
    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% --
    لսႽ ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
      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*
      There are no rules, there are no thumbs..
      Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

        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.

        Cheers,

        JohnGG

      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*
      There are no rules, there are no thumbs..
      Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

        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 }

      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.

      No matter how hysterical I get, my problems are not time sensitive. So, relax, have a cookie, and a very nice day!
      Lady Aleena
        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.
        لսႽ ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
Re: Number functions I have lying around
by aaron_baugher (Curate) on Mar 31, 2015 at 22:11 UTC

    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.

    Aaron B.
    Available for small or large Perl jobs and *nix system administration; see my home node.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://1121927]
Approved by atcroft
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (4)
As of 2022-05-18 06:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you prefer to work remotely?



    Results (68 votes). Check out past polls.

    Notices?