aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--challenge-146/james-smith/README.md87
-rw-r--r--challenge-146/james-smith/blog.txt1
-rw-r--r--challenge-146/james-smith/perl/ch-1.pl12
-rw-r--r--challenge-146/james-smith/perl/ch-2.pl30
4 files changed, 75 insertions, 55 deletions
diff --git a/challenge-146/james-smith/README.md b/challenge-146/james-smith/README.md
index affd6c3cd4..b1509962ae 100644
--- a/challenge-146/james-smith/README.md
+++ b/challenge-146/james-smith/README.md
@@ -1,6 +1,6 @@
-[< Previous 144](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-144/james-smith) |
-[Next 146 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-146/james-smith)
-# Perl Weekly Challenge #145
+[< Previous 145](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-145/james-smith) |
+[Next 147 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-147/james-smith)
+# Perl Weekly Challenge #146
You can find more information about this weeks, and previous weeks challenges at:
@@ -12,79 +12,56 @@ 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-145/james-smith
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-146/james-smith
-# Challenge 1 - Dot product
+# Challenge 1 - 10001st Prime Number
-***You are given 2 arrays of same size, `@a` and `@b`. Write a script to implement Dot Product.***
+***Write a script to generate the 10001st prime number.***
## The solution
-This challenge is simple - Relatively simple one to start with this week. We keep a running total of the product of corresponding entries in each of the arrays.
-
-In this case we use one array as the basis of the loop, and shift off elements of the other array.
+We could use a Prime module, but finding primes is not that difficult so we will roll our own generator:
```perl
-sub dot_product {
- my ($t,@y) = (0,@{$_[1]});
- $t += $_ * shift @y foreach @{$_[0]};
- $t;
+my($c,@p)=(5,3);
+for(;@p<10000;$c+=2){
+ ($_*$_>$c)?((push@p,$c),last):$c%$_||last for@p;
}
+say$p[-1];
```
-# Challenge 2 - Palindromic Tree
+The crux of the code is in the `for @` line. This sees if a given odd number is prime.
-***You are given a string `$s`. Write a script to create a Palindromic Tree for the given string.***
+We loop through all the primes up to and including the square root of the value we are checking.
+If we don't find a prime factor by then we push the new value to the primes list, and go on to
+try the next number. If we find a
+factor we skip the rest of the loop and go on to try the next number.
-## The solution
+We stop when we have 10,000 records in the array (as we don't include the prime number 2 in the list),
+so the last element is the 10,001st prime.
-This was one of the hardest challenges over recent weeks - not the implementation but understanding how/what this does.
+# Challenge 2 - Curious Fraction Tree
-Creating the tree is relatively straight forward. We start with the two "empty" nodes, and for each letter or pair of
-adjacent letters which are the same we add the node as children (connected by edges), and also a back link to the
-first/last letter.
+*** Can't really describe this - best to look at the image on the website at https://theweeklychallenge.org/blog/perl-weekly-challenge-146/.***
-```perl
-sub eertree {
- my $str = [ split //, $_[0] ];
- my $tree = {
- -1 => { 'start' => undef, 'edges' => {}, 'suff' => -1 },
- q() => { 'start' => undef, 'edges' => {}, 'suff' => -1 },
- };
- add_str( $tree, $str, -1, $_, $_ ),
- add_str( $tree, $str, q(), $_, $_+1 ) for 0.. @{$str}-1;
- $tree;
-}
-```
+## The solution
-In `add_str` we:
+We notice that:
+ * if you have a top-heavy fraction then the parent has the same denominator, and the new demoninator is the difference between the numerator and denominator.
+ * otherwise the numerator stays the same and the denominator becomes the difference between the numerator and denominator.
+We repeat this until we get to the top of the tree where both the denominator and numerator are less than 2. (In the tree is always 1/1) as all tree members have co-prime numerators and denominators. Other values end when the numerator is 0.
- * check that we are still in bounds and that the first and last letters are the same;
- * we create a link from the current node to the new node;
- * we create the new node if it didn't already exist;
- * we then expand the palindrome by a character at the front/end and repeat until we
- are out of bounds or we don't have a palindrome.
+The `stringify` function just converts the tree into a single string (list of fractions) so we can test the tree code.
```perl
-sub add_str {
- my( $tr, $c, $node, $st, $en ) = @_;
- while( $st >=0 && $en < @{$c} && $c->[$st] eq $c->[$en] ) {
- $tr->{$node}{'edges'}{my $s = join q(), @{$c}[$st..$en] } ||= keys %{$tr->{$node}{'edges'}};
- $tr->{$node=$s} ||= { 'start' => $st, 'edges' => {}, 'suff' => $st==$en ? -1 : $en==$st+1 ? q() : $c->[$st] };
- $st--;
- $en++;
- }
+sub tree {
+ my@tr=[my($n,$d)=@_];
+ push@tr,$d>$n?[$n,$d-=$n]:[$n-=$d,$d]while$n*$d>1;
+ \@tr;
}
-```
-To generate the output required in the tests we flatten the string by sorting the nodes into the order of their first appearance (and length)
-```perl
sub stringify {
- my $tree = shift;
- return join q( ),
- sort { $tree->{$a}{'start'} <=> $tree->{$b}{'start'} ||
- length $a <=> length $b }
- grep { defined $tree->{$_}{'start'} }
- keys %{$tree};
+ "@{[map{join'/',@{$_}}@{$_[0]}]}";
}
```
+
diff --git a/challenge-146/james-smith/blog.txt b/challenge-146/james-smith/blog.txt
new file mode 100644
index 0000000000..358813fa75
--- /dev/null
+++ b/challenge-146/james-smith/blog.txt
@@ -0,0 +1 @@
+https://github.com/manwar/perlweeklychallenge-club/tree/master/challenge-146/james-smith
diff --git a/challenge-146/james-smith/perl/ch-1.pl b/challenge-146/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..62e572997b
--- /dev/null
+++ b/challenge-146/james-smith/perl/ch-1.pl
@@ -0,0 +1,12 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+
+my($c,@p)=(5,3);
+for(;@p<10000;$c+=2){
+ ($_*$_>$c)?((push@p,$c),last):$c%$_||last for@p;
+}
+say$p[-1];
diff --git a/challenge-146/james-smith/perl/ch-2.pl b/challenge-146/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..9c30a15515
--- /dev/null
+++ b/challenge-146/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 Data::Dumper qw(Dumper);;
+
+my @TESTS = (
+ [ 3, 5, '3/5 3/2 1/2 1/1' ],
+ [ 4, 3, '4/3 1/3 1/2 1/1' ],
+ [ 101, 45, '101/45 56/45 11/45 11/34 11/23 11/12 11/1 10/1 9/1 8/1 7/1 6/1 5/1 4/1 3/1 2/1 1/1' ],
+ [ 6, 4, '6/4 2/4 2/2 0/2' ], ## Not part of tree - but need to see what it does!
+);
+
+is( stringify( tree($_->[0],$_->[1]) ), $_->[2] ) foreach @TESTS;
+
+done_testing();
+
+sub tree {
+ my @tr=[my($n,$d)=@_];
+ push@tr,$d>$n?[$n,$d-=$n]:[$n-=$d,$d]while$n*$d>1;
+ \@tr;
+}
+
+sub stringify {
+ "@{[map{join'/',@{$_}}@{$_[0]}]}";
+}
+