From db6df2a5ea0ad435c2d5952632494c4b1894ef81 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Mon, 22 Nov 2021 17:53:20 +0000 Subject: added solution for #140 --- challenge-140/james-smith/perl/ch-1.pl | 32 ++++++++++++++++++++++++++++++++ challenge-140/james-smith/perl/ch-2.pl | 30 ++++++++++++++++++++++++++++++ 2 files changed, 62 insertions(+) create mode 100644 challenge-140/james-smith/perl/ch-1.pl create mode 100644 challenge-140/james-smith/perl/ch-2.pl diff --git a/challenge-140/james-smith/perl/ch-1.pl b/challenge-140/james-smith/perl/ch-1.pl new file mode 100644 index 0000000000..c4d6576644 --- /dev/null +++ b/challenge-140/james-smith/perl/ch-1.pl @@ -0,0 +1,32 @@ +#!/usr/local/bin/perl + +use strict; + +use warnings; +use feature qw(say); +use Test::More; +use Benchmark qw(cmpthese timethis); +use Data::Dumper qw(Dumper); + +my @TESTS = ( + [ [ 11, 1 ] , 100 ], + [ [ 101, 1 ] , 110 ], + [ [ 100, 11 ] , 111 ], +); + +say DecBin->new($_->[0][0]) + DecBin->new($_->[0][1]) == DecBin->new($_->[1]) ? 'OK' : 'FAIL' foreach @TESTS; + +package DecBin; + +use overload ('+','bin_add','==','comp'); + +sub new { return bless \$_[1], $_[0]; } + +sub comp { ${$_[0]} == ${$_[1]}; } + +sub bin_add { + my($t,$c,$m,$a,$b) = (0,0,1,${$_[0]},${$_[1]}); + $c+=$a%10+$b%10,$t+=$m*($c&1),$m*=10,$c>>=1,$a=int$a/10,$b=int$b/10 while$a||$b||$c; + DecBin->new($t); +} + diff --git a/challenge-140/james-smith/perl/ch-2.pl b/challenge-140/james-smith/perl/ch-2.pl new file mode 100644 index 0000000000..8f8e2545bc --- /dev/null +++ b/challenge-140/james-smith/perl/ch-2.pl @@ -0,0 +1,30 @@ +#!/usr/local/bin/perl + +use strict; + +use warnings; +use feature qw(say); +use Test::More; +use Benchmark qw(cmpthese timethis); +use Data::Dumper qw(Dumper); + +my @TESTS = ( + [ [2,3,1], 1 ], + [ [2,3,2], 2 ], + [ [2,3,3], 2 ], + [ [2,3,4], 3 ], + [ [2,3,5], 4 ], + [ [2,3,6], 6 ], + [ [3,3,6], 4 ], +); + +is( get_num(@{$_->[0]}), $_->[1] ) foreach @TESTS; + +done_testing(); + +sub get_num { + my($i,$j,$k,%h) = @_; + $a=$_, map { $h{$a*$_}++ } 1..$j for 1..$i; + $k-=$h{$_}, ($k<1) && (return $_) for sort { $a<=>$b } keys %h; +} + -- cgit From da7f72157db87a1f448db7f426aeb30b4acbd10f Mon Sep 17 00:00:00 2001 From: drbaggy Date: Tue, 23 Nov 2021 07:24:37 +0000 Subject: added more readable versions --- challenge-140/james-smith/perl/ch-1.pl | 23 +++++++++++++++++++++++ challenge-140/james-smith/perl/ch-2.pl | 15 +++++++++++++-- 2 files changed, 36 insertions(+), 2 deletions(-) diff --git a/challenge-140/james-smith/perl/ch-1.pl b/challenge-140/james-smith/perl/ch-1.pl index c4d6576644..2129293473 100644 --- a/challenge-140/james-smith/perl/ch-1.pl +++ b/challenge-140/james-smith/perl/ch-1.pl @@ -16,6 +16,8 @@ my @TESTS = ( say DecBin->new($_->[0][0]) + DecBin->new($_->[0][1]) == DecBin->new($_->[1]) ? 'OK' : 'FAIL' foreach @TESTS; +say DecBinExp->new($_->[0][0]) + DecBinExp->new($_->[0][1]) == DecBinExp->new($_->[1]) ? 'OK' : 'FAIL' foreach @TESTS; + package DecBin; use overload ('+','bin_add','==','comp'); @@ -30,3 +32,24 @@ sub bin_add { DecBin->new($t); } +package DecBinExp; + +use overload ('+','bin_add','==','comp'); + +sub new { return bless \$_[1], $_[0]; } + +sub comp { ${$_[0]} == ${$_[1]}; } + +sub bin_add { + my($t,$c,$m,$a,$b) = (0,0,1,${$_[0]},${$_[1]}); + while ($a||$b||$c) { + $c += $a%10 + $b%10; + $t += $m * ($c&1); + $m *= 10; + $c >>= 1; + $a = int $a/10; + $b = int $b/10; + } + DecBin->new($t); +} + diff --git a/challenge-140/james-smith/perl/ch-2.pl b/challenge-140/james-smith/perl/ch-2.pl index 8f8e2545bc..849f946bb3 100644 --- a/challenge-140/james-smith/perl/ch-2.pl +++ b/challenge-140/james-smith/perl/ch-2.pl @@ -19,12 +19,23 @@ my @TESTS = ( ); is( get_num(@{$_->[0]}), $_->[1] ) foreach @TESTS; +is( get_num_exp(@{$_->[0]}), $_->[1] ) foreach @TESTS; done_testing(); sub get_num { - my($i,$j,$k,%h) = @_; - $a=$_, map { $h{$a*$_}++ } 1..$j for 1..$i; + my($i,$j,$k,$t,%h) = @_; + $t=$_, map { $h{$t*$_}++ } 1..$j for 1..$i; $k-=$h{$_}, ($k<1) && (return $_) for sort { $a<=>$b } keys %h; } +sub get_num_exp { + my($i,$j,$k,$t,%h) = @_; + foreach $t (1..$i) { + $h{$t*$_}++ foreach 1..$j; + } + for (sort {$a<=>$b} keys %h) { + $k -= $h{$_}; + return $_ if $k<1; + } +} -- cgit From b7f6ccb5d687617d8ef2a91a6ad3a46a1139d9b3 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Tue, 23 Nov 2021 10:28:02 +0000 Subject: fixing somebits --- challenge-140/james-smith/perl/ch-1.pl | 30 ++++++++++++++++++++---------- challenge-140/james-smith/perl/ch-2.pl | 8 ++++---- 2 files changed, 24 insertions(+), 14 deletions(-) diff --git a/challenge-140/james-smith/perl/ch-1.pl b/challenge-140/james-smith/perl/ch-1.pl index 2129293473..9483b8e9bb 100644 --- a/challenge-140/james-smith/perl/ch-1.pl +++ b/challenge-140/james-smith/perl/ch-1.pl @@ -14,17 +14,27 @@ my @TESTS = ( [ [ 100, 11 ] , 111 ], ); -say DecBin->new($_->[0][0]) + DecBin->new($_->[0][1]) == DecBin->new($_->[1]) ? 'OK' : 'FAIL' foreach @TESTS; +foreach(@TESTS) { + my $x = DecBin->new($_->[0][0]); + my $y = DecBin->new($_->[0][1]); + my $z = DecBin->new($_->[1]); + say join "\t", $x, $y, $x+$y, $z, $x+$y==$z ? 'OK' : 'FAIL'; +} -say DecBinExp->new($_->[0][0]) + DecBinExp->new($_->[0][1]) == DecBinExp->new($_->[1]) ? 'OK' : 'FAIL' foreach @TESTS; +foreach(@TESTS) { + my $x = DecBinExp->new($_->[0][0]); + my $y = DecBinExp->new($_->[0][1]); + my $z = DecBinExp->new($_->[1]); + say join "\t", $x, $y, $x+$y, $z, $x+$y==$z ? 'OK' : 'FAIL'; +} package DecBin; -use overload ('+','bin_add','==','comp'); +use overload ('+'=>'bin_add','=='=>'comp','""'=>'show'); -sub new { return bless \$_[1], $_[0]; } - -sub comp { ${$_[0]} == ${$_[1]}; } +sub new { bless \$_[1], $_[0] } +sub show { ${$_[0]} } +sub comp { ${$_[0]} == ${$_[1]} } sub bin_add { my($t,$c,$m,$a,$b) = (0,0,1,${$_[0]},${$_[1]}); @@ -34,11 +44,11 @@ sub bin_add { package DecBinExp; -use overload ('+','bin_add','==','comp'); - -sub new { return bless \$_[1], $_[0]; } +use overload ('+'=>'bin_add','=='=>'comp','""'=>'show'); -sub comp { ${$_[0]} == ${$_[1]}; } +sub new { bless \$_[1], $_[0] } +sub show { ${$_[0]} } +sub comp { ${$_[0]} == ${$_[1]} } sub bin_add { my($t,$c,$m,$a,$b) = (0,0,1,${$_[0]},${$_[1]}); diff --git a/challenge-140/james-smith/perl/ch-2.pl b/challenge-140/james-smith/perl/ch-2.pl index 849f946bb3..dc99f6ad04 100644 --- a/challenge-140/james-smith/perl/ch-2.pl +++ b/challenge-140/james-smith/perl/ch-2.pl @@ -18,8 +18,8 @@ my @TESTS = ( [ [3,3,6], 4 ], ); -is( get_num(@{$_->[0]}), $_->[1] ) foreach @TESTS; -is( get_num_exp(@{$_->[0]}), $_->[1] ) foreach @TESTS; +is( get_num(@{$_->[0]}), $_->[1] ) for @TESTS; +is( get_num_exp(@{$_->[0]}), $_->[1] ) for @TESTS; done_testing(); @@ -31,8 +31,8 @@ sub get_num { sub get_num_exp { my($i,$j,$k,$t,%h) = @_; - foreach $t (1..$i) { - $h{$t*$_}++ foreach 1..$j; + for $t (1..$i) { + $h{$t*$_}++ for 1..$j; } for (sort {$a<=>$b} keys %h) { $k -= $h{$_}; -- cgit From 23dbfeefc7e961ea5f94ebbcc5f03155e309d0f6 Mon Sep 17 00:00:00 2001 From: James Smith Date: Tue, 23 Nov 2021 10:30:17 +0000 Subject: Update README.md --- challenge-140/james-smith/README.md | 151 +++++++++++++++++++++--------------- 1 file changed, 89 insertions(+), 62 deletions(-) diff --git a/challenge-140/james-smith/README.md b/challenge-140/james-smith/README.md index 12cbf5c99d..a8e52f8440 100644 --- a/challenge-140/james-smith/README.md +++ b/challenge-140/james-smith/README.md @@ -1,4 +1,4 @@ -# Perl Weekly Challenge #139 - "Whats recurring" +# Perl Weekly Challenge #140 You can find more information about this weeks, and previous weeks challenges at: @@ -10,102 +10,129 @@ 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-139/james-smith/perl +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-140/james-smith/perl -# Task 1 - JortSort +# Challenge 1 - Add binary -***You are given a list of numbers. Write a script to implement JortSort. It should return true/false depending if the given list of numbers are already sorted.*** +***Write a script to simulate the addition of the given binary numbers. The script should simulate something like `$a + $b`. (operator overloading)*** ## The solution -This challenge is relatively easy - to see if the list of numbers if monotonically increasing we just have to check that each entry is bigger than the one before. +To allow for operator overloading we need to create a class. `DecBin` will be that class. We have to override to functions: -* We start by shifting the first number of the list passed (this is the *previous number*); -* The loop through the rest comparing the current number against the previous number. - * If the number is less than the previous number we return `0`; - * Otherwise we set previous number `$p` to the current number and continue -* If we get to the end of the list then the list is sorted and we return `1`. +* `+` - addition +* `==` - comparison -```perl -sub in_order { - my $p = shift; - ($p>$_) ? (return 0) : ($p=$_) for @_; - return 1; -} -``` +We also override `""` - stringify so we can print the numbers if we want. + +Our object is simple a scalar reference. So in `new` we just bless the reference to the number than is passed, and show and comparison just return the scalar pointed to by the reference or compares two of these. -**Notes:** +The add function is the more complex function. Working backwards digit by digit -* We can rewrite the `if( $x ) { y } else { z }` and `($x) ? (y) : (z)`. Why is this useful - well we can then use the brace less postfix `for` for the loop rather than having to use braces. This means the loop becomes 1 line, rather than the longer 7 line version using K&R braces. If you don't cuddle your braces it is even longer! +* we add the *carry bit* and the last digit of the remaining string; +* we then use the last digit of this to update the total, but multiplying this by the position multiplier; +* we then move the multiplier one digit to the left by multiplying by 10; +* we then divide the *carry bit* by 2, to see if we need to carry to the next number; +* remove the last digit of the two numbers + +We repeat this until we no longer have a carry AND we have processed all digits of the two numbers. + +* Note - the *carry bit* will always be 0,1,2,3 after the first addition, as the digits of the two numbers can only be 1 or 0 and the *carry bit* will only ever be 0 and 1 as well. ```perl - for (@_) { - if( $p>$_ ) { - return 0; - } else { - $p = $_; - } - } -``` +package DecBin; + +use overload ('+'=>bin_add','=='=>'comp','""'=>'show'); + +sub new { bless \$_[1], $_[0] } +sub show { ${$_[0]} } +sub comp { ${$_[0]} == ${$_[1]} } -Admittedly there is an intermediate version... That uses the exit early approach.. +sub bin_add { + my($t,$c,$m,$a,$b) = (0,0,1,${$_[0]},${$_[1]}); + $c+=$a%10+$b%10,$t+=$m*($c&1),$m*=10,$c>>=1,$a=int$a/10,$b=int$b/10 while $a||$b||$c; + DecBin->new($t); +} +``` +The long line may be unreadable - so I also include a multi-line version ```perl - for (@_) { - return 0 if $p>$_; - $p = $_; +sub bin_add { + my($t,$c,$m,$a,$b) = (0,0,1,${$_[0]},${$_[1]}); + while ($a||$b||$c) { + $c += $a%10 + $b%10; + $t += $m * ($c&1); + $m *= 10; + $c >>= 1; + $a = int $a/10; + $b = int $b/10; } + DecBin->new($t); +} ``` -that has only 4-lines. -# Task 2 - Long Primes +To show that the overloading works - we use the following test script: -***Write a script to generate first 5 Long Primes. A prime number `p` is called Long Prime if `1/p` has an infinite decimal expansion repeating every `p-1` digits.*** +```perl +my @TESTS = ( + [ [ 11, 1 ] , 100 ], + [ [ 101, 1 ] , 110 ], + [ [ 100, 11 ] , 111 ], +); +foreach(@TESTS) { + my $x = DecBin->new($_->[0][0]); + my $y = DecBin->new($_->[0][1]); + my $z = DecBin->new($_->[1]); + say join "\t", $x, $y, $x+$y, $z, $x+$y==$z ? 'OK' : 'FAIL'; +} +``` -## The solution +with output: -Now this challenge is not so easy - but those of us who have been working on the challenges for more than 6 months would have already worked out parts of fractions which are recursive. There were many solutions for this - if you didn't do the challenge. +``` +11 1 100 100 OK +101 1 110 110 OK +100 11 111 111 OK +``` -You can see mine at: +# Challenge 2 - Multiplication Table -https://github.com/drbaggy/perlweeklychallenge-club/blob/master/challenge-106/james-smith/perl/ch-2.pl +***You are given 3 positive integers, `$i`, `$j` and `$k`. Write a script to print the `$k`th element in the sorted multiplication table of `$i` and `$j`.*** -Now we don't require the actual part of the number repeats which makes the function simpler, and we know explicitly that the numerator is going to be 1. +## The solution -This gives us the function below to get the length of the recurring sequence. +Obviously there are two parts to this - a first pass which finds all the numbers and a second pass which counts to find the `$k`th element. ```perl -sub rec_len { - my( $D, $N, $s ) = ( shift, 1, '' ); - ( $s, $N ) = ( $s.int($N/$D), ($N%$D).0 ) for 0 .. 2*$D; - $s =~ /(\d+?)\1+$/ ? length $1 : 0; +sub get_num { + my($i,$j,$k,$t,%h) = @_; + $t=$_, map { $h{$t*$_}++ } 1..$j for 1..$i; + $k-=$h{$_}, ($k<1) && (return $_) for sort { $a<=>$b } keys %h; } ``` -* We compute twice the number of digits than the denominator, we generate this as a string but using long-division to compute each digit. -* We then see if there is any repeating sequence (tied to the end of the sting we generate). We then get the length of this recurrent string. (If you don't include the `\1+` you could end up with a shorter match as "3333" would be picked up as "33" recurring rather than "3" recurring. - -So now we have this function we can look at computing the long primes. We know that `1/2` doesn't recur so we can rule this out - that means we are only considering odd primes. +Here we do some *naughty* code, using `,` to perform multiple commands in one line; using `map` to perform a for loop (altering values & ignoring the result) and using `&&` to simulate an `if` statement. -Therefore we loop through all the odd numbers checking to see if the number is a prime, if it is we then check for the property that the recurring sequence has `$p-1` digits. +In this function each of these is written as a single line. We can expand each of these functions out to see how the algorithm works: ```perl -my( $N, @primes, @long_primes ) = ( $ARGV[0]||5 ); - -O: for( my $p=3; @long_primes<$N; $p+=2 ) { - ($p % $_) || (next O) for @primes; - push @primes, $p; - push @long_primes, $p if $p - rec_len($p) == 1; +sub get_num { + my($i,$j,$k,$t,%h) = @_; + for $t (1..$i) { + $h{$t*$_}++ for 1..$j; + } + for (sort {$a<=>$b} keys %h) { + $k -= $h{$_}; + return $_ if $k<1; + } } ``` -We will now break this down. -* The `for` line is obvious - repeat increasing `$p` by two until we have sufficient long primes. -* The next line loops through all current known primes to see if they are factor of `$p` - if yes skips to the next outer loop. - * We use `next O` to jump out of the inner `for` loop, and to the start of the next outer `for` loop - labelled `O`. - * We again use a trick to flatten the loop with a conditional: `($p % $_) || (next O)` if the first part is true the "or" `||` is true, so we don't evaluate the second part. But it `$_` is a factor of `$p` the left hand side is `0` (false) and so we need to evaluate it to see if the right hand side is true - and in the evaluation - skips to the start of the loop by executing `next O`. -* We know it has no known prime factors in line 3 so we add it to the list of primes. -* Then we use our `rec_len` function to see if the number is in fact a long prime. +The first `for loop` simply stores the numbers as keys to a hash, whose values are the "frequency" of the number occuring. + +The second one finds the answer. We first thing we do is sort the numbers into order as the keys of the hash are un-ordered. +Rather than working up to `$k` we can work down from it to 0. So we subtract the frequency of the current number and if the value is less than `1` then we know this is the number we are looking for and return it's value. +Note we always return in the `for` loop - so don't need a return at the end. -- cgit From b94a88986db3637c63e8efc0bcf51b4814d86b9b Mon Sep 17 00:00:00 2001 From: James Smith Date: Tue, 23 Nov 2021 10:30:45 +0000 Subject: Create blog.txt --- challenge-140/james-smith/blog.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 challenge-140/james-smith/blog.txt diff --git a/challenge-140/james-smith/blog.txt b/challenge-140/james-smith/blog.txt new file mode 100644 index 0000000000..ee17e8d912 --- /dev/null +++ b/challenge-140/james-smith/blog.txt @@ -0,0 +1 @@ +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-140/james-smith/perl -- cgit From 8310af380eb746797d08a528f4593f9eaff87ff0 Mon Sep 17 00:00:00 2001 From: James Smith Date: Tue, 23 Nov 2021 10:30:56 +0000 Subject: Update blog.txt --- challenge-140/james-smith/blog.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-140/james-smith/blog.txt b/challenge-140/james-smith/blog.txt index ee17e8d912..63515f8d8e 100644 --- a/challenge-140/james-smith/blog.txt +++ b/challenge-140/james-smith/blog.txt @@ -1 +1 @@ -https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-140/james-smith/perl +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-140/james-smith -- cgit From 14a75baed4826c986ec6cbeaf4b84f803b678f2e Mon Sep 17 00:00:00 2001 From: James Smith Date: Tue, 23 Nov 2021 10:31:55 +0000 Subject: Update README.md --- challenge-140/james-smith/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-140/james-smith/README.md b/challenge-140/james-smith/README.md index a8e52f8440..40dc6bd1b5 100644 --- a/challenge-140/james-smith/README.md +++ b/challenge-140/james-smith/README.md @@ -42,7 +42,7 @@ We repeat this until we no longer have a carry AND we have processed all digits ```perl package DecBin; -use overload ('+'=>bin_add','=='=>'comp','""'=>'show'); +use overload ('+'=>'bin_add','=='=>'comp','""'=>'show'); sub new { bless \$_[1], $_[0] } sub show { ${$_[0]} } -- cgit From fb5a6a0057cc4bbadec9e1319aae7932a18e9b23 Mon Sep 17 00:00:00 2001 From: James Smith Date: Wed, 24 Nov 2021 00:20:29 +0000 Subject: Update README.md --- challenge-136/james-smith/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-136/james-smith/README.md b/challenge-136/james-smith/README.md index b0b3dc8889..3fa420f2e3 100644 --- a/challenge-136/james-smith/README.md +++ b/challenge-136/james-smith/README.md @@ -39,7 +39,7 @@ sub friendly { # Task 2 - Fibonacci Sequence -***You are given a positive number `$n`. Write a script to find how many different sequences you can create using Fibonacci numbers where the sum of unique numbers in each sequence are the same as the given number. *** +***You are given a positive number `$n`. Write a script to find how many different sequences you can create using Fibonacci numbers where the sum of unique numbers in each sequence are the same as the given number.*** ## Solution -- cgit