diff options
| -rw-r--r-- | challenge-132/james-smith/README.md | 13 | ||||
| -rw-r--r-- | challenge-133/james-smith/README.md | 107 | ||||
| -rw-r--r-- | challenge-133/james-smith/perl/ch-1.pl | 27 | ||||
| -rw-r--r-- | challenge-133/james-smith/perl/ch-2.pl | 45 |
4 files changed, 129 insertions, 63 deletions
diff --git a/challenge-132/james-smith/README.md b/challenge-132/james-smith/README.md index 6754349a4c..d4ea80638b 100644 --- a/challenge-132/james-smith/README.md +++ b/challenge-132/james-smith/README.md @@ -44,6 +44,19 @@ sub mirror_days { * Reset the hash table, and continue scanning the build input R * Do a final scan of the probe input S and add the resulting join tuples to the output relation +## Aside + +You may think that this looks an overly convoluted way to join two data-structures together. But there are times when this method is the +best possible one - from an efficiency point of view. + +If the two tables to be joined are not simple perl data structures but files with hundreds of millions of lines. Then this method makes a lot +more sense. You open the first file, and pull out a number of rows and store them in a keyed hash. You then loop through the other file +when you find a match (the key exists in the hash) you output the resultant rows.... You can continue taking chunks from the first file, and looping through the second. + +This method uses least memory - and is therefore much more efficient than trying to do everything in memory. + +*Not this algorithm - but joining two tables genetic variation, alternate names for the variations. We needed to join them together - the MySQL join just wasn't coming back at all (blowing up memory), instead +we dumped out the contens of each table - fortunately ordered by the same key, and walked down the two files joining the rows together, only ever 1 line of each file in memory at once!.* ## Solution diff --git a/challenge-133/james-smith/README.md b/challenge-133/james-smith/README.md index 6754349a4c..e467044ffc 100644 --- a/challenge-133/james-smith/README.md +++ b/challenge-133/james-smith/README.md @@ -1,4 +1,4 @@ -# Perl Weekly Challenge #132 +# Perl Weekly Challenge #133 You can find more information about this weeks, and previous weeks challenges at: @@ -10,85 +10,66 @@ submit solutions in whichever language you feel comfortable with. You can find the solutions here on github at: -https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-132/james-smith/perl +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-133/james-smith/perl -# Task 1 - Mirror dates +# Task 1 - Integer Square Root -***You are given a date (yyyy/mm/dd). Assuming, the given date is your date of birth. Write a script to find the mirror dates of the given date.*** +***You are given a positive integer `$N`. Write a script to calculate the integer square root of the given number.*** ## The solution -Here we use Date::Calc module to handle the date time manipulations. +We implement Newton's formulae to compute the integer square root.. This is the compact version. -We compute the number of days between dob & today. We then work out which day is this distance before the dob & after today to give the two values. ```perl -my @TODAY = @ARGV ? split m{/}, $ARGV[0]: Today; - -sub mirror_days { - my $d = Delta_Days( @TODAY, split m{/}, $_->[0] ); - return [ - sprintf( '%04d/%02d/%02d', Add_Delta_Days( @bd, $d )), - sprintf( '%04d/%02d/%02d', Add_Delta_Days( @TODAY, -$d )), - ]; +sub find_root { + my( $x, $y ) = ( my $n = shift ) >> 1; ## $x is half $n rounded down... + return $n unless $x; ## Return $n if it is <2 (i.e. 0 or 1) + $x = $y while ( $y = ( $x + $n / $x ) >> 1 ) < $x; ## The crux - the next no is 1/2 of $x & $n/$x + return $x; ## Return value } ``` -# Task 2 - Hash join - -***Write a script to implement Hash Join algorithm as suggested by wikipedia.*** - - * For each tuple r in the build input R - * Add r to the in-memory hash table - * If the size of the hash table equals the maximum in-memory size: - * Scan the probe input S, and add matching join tuples to the output relation - * Reset the hash table, and continue scanning the build input R - * Do a final scan of the probe input S and add the resulting join tuples to the output relation +# Task 2 - Smith Numbers +***Write a script to generate first 10 Smith Numbers in base 10.*** ## Solution -The problem is "simple" seems simple to begin with - but there are two "gotchas".. - - * We have to chunk the first array up into chunks of no more than `$N`. - * The keys in the two tables are NOT unique, so we need to store multiple values based on a key; - -To solve the first problem we break the input array up into to chunks of size `$MAX`, and repeat foreach one. - -To resolve the issue of the multiple keys, instead of the value of the cache being the value itself, it is the key to an array of values. - -Although not needed - the code is written to match the description above - so works with multiple non key columns in both tables. +We break the logic up into chunks and implement those in separate function. As we look at each +prime in turn we can effectively create a sieve to get the prime factors. +Here is the main code. + * We check to see if the sum of digits is the same as the sum of primefactor digits {and that it is not prime} + * We add this to the list if it is the case + * Return when we have `$C` (`10`) in this case... ```perl +sub smith_numbers { + my ( $C, $n, @sn ) = (shift,3); + ( sum_digits( $n ) - sum map { sum_digits $_ } prime_factors( $n ) ) || + ( push @sn, $n ) && + ( @sn == $C ) && + ( return @sn ) while $n++; +} +``` -## index of key columns... -my $ages_key = 1; -my $names_key = 0; - -## Get non-key columns in the names table... -## { get all column ids and splice out the key column} -my @names_columns = 0..(@{$player_names[0]}-1); -splice @names_columns, $names_key,1; ## Remove key.... - -## Get chunk size (default to 4) -my $MAX = @ARGV ? $ARGV[0] : 4; - -my @res; - -while( my @pns = splice @player_names, 0, $MAX ) { - my %cache = (); - ## Foreach we key on the key column, and store the non-key columns - ## Because key columns not unique we have array of arrays for - ## the hash values - push @{$cache{$_->[$names_key]}},[ @{$_}[@names_columns] ] foreach @pns; - - ## Now loop through the array of ages. - ## When we find a key we dump all values. - ## We push all values in the ages table - and all values (except the key) of the names table - foreach my $p (@player_ages) { - push @res, [@{$p}, @{$_}] foreach @{$cache{$p->[$ages_key]}}; - } +And the support functions: + * `sum` - Just sum an array; + * `sum_digits` - Sum digits of number, + We cache the digit sum for each number in `%ds`; + * `prime_factors` - for a prime returns nothing, for a composite returns the factors, + We keep a list of primes `@primes`, and also the prime factors for each composite `%comp`. + +```perl +sub sum { my $t = 0; $t+=$_ foreach @_; $t; } +sub sum_digits { return $ds{$_[0]} ||= sum split //, $_[0]; } + +sub prime_factors { + my $N = shift; + ( $N % $_) or ( return @{ $comp{$N} = [ $_, @{$comp{ $N / $_ }||[$N/$_]}] } ) foreach @primes; + push @primes, $N; + return; } -## Just print values -say join "\t", map { sprintf '%-15s', $_ } @{$_} foreach @res; + + ``` diff --git a/challenge-133/james-smith/perl/ch-1.pl b/challenge-133/james-smith/perl/ch-1.pl new file mode 100644 index 0000000000..9422daa9e4 --- /dev/null +++ b/challenge-133/james-smith/perl/ch-1.pl @@ -0,0 +1,27 @@ +#!/usr/local/bin/perl + +use strict; + +use warnings; +use feature qw(say); +use Test::More; + +my @TESTS = ( + [ 10, 3 ], + [ 27, 5 ], + [ 85, 9 ], + [ 101, 10 ], + [ 418529770, 20458 ], +); + +is( find_root($_->[0]), $_->[1] ) foreach @TESTS; + +done_testing(); + +sub find_root { + my($x,$y) = (my $n = shift)>>1; + return $n unless $x; + $x = $y while ($y = ($x+$n/$x)>>1) < $x; + return $x; +} + diff --git a/challenge-133/james-smith/perl/ch-2.pl b/challenge-133/james-smith/perl/ch-2.pl new file mode 100644 index 0000000000..6163b97940 --- /dev/null +++ b/challenge-133/james-smith/perl/ch-2.pl @@ -0,0 +1,45 @@ +#!/usr/local/bin/perl + +use strict; + +use warnings; +use feature qw(say); + +my(@primes,%ds,%comp) = (2,3); +say $_ foreach smith_numbers(@ARGV?$ARGV[0]:100); +#say $_ foreach smith_numbers_readable(@ARGV?$ARGV[0]:100); + +sub sum { my $t = 0; $t+=$_ foreach @_; $t; } +sub sum_digits { return $ds{$_[0]} ||= sum split //, $_[0]; } + +sub prime_factors { + my $N = shift; + + ## If we are composite then store the factors for the composite and return... + ( $N % $_) or ( return @{ $comp{$N} = [ $_, @{$comp{ $N / $_ }||[$N/$_]}] } ) foreach @primes; + + ## Otherwise we are prime so add to primes and return nothing.... + push @primes, $N; + return; +} + +sub smith_numbers_readable { + my ( $C, $n, @sn ) = (shift,3); + while($n++) { ## $n starts at 4 ... lowest possible smith number is 4 ( composite or 2 x 2 ) + next unless my @q = prime_factors($n); ## Must be composite as prime_factors returns list... + next if sum_digits($n) - sum map { sum_digits $_ } @q; ## Digit sums are equal... + push @sn, $n; + return @sn if @sn==$C; + } +} + + +sub smith_numbers { ## This is the short form! using && + my ( $C, $n, @sn ) = (shift,3); + ( sum_digits( $n ) - sum map { sum_digits $_ } prime_factors( $n ) ) || + ( push @sn, $n ) && + ( @sn == $C ) && + ( return @sn ) while $n++; +} + + |