diff options
Diffstat (limited to 'challenge-146')
65 files changed, 3148 insertions, 165 deletions
diff --git a/challenge-146/adam-russell/blog.txt b/challenge-146/adam-russell/blog.txt new file mode 100644 index 0000000000..ae905ef9ac --- /dev/null +++ b/challenge-146/adam-russell/blog.txt @@ -0,0 +1 @@ +http://www.rabbitfarm.com/cgi-bin/blosxom/2022/01/09/perl diff --git a/challenge-146/adam-russell/perl/ch-1.pl b/challenge-146/adam-russell/perl/ch-1.pl new file mode 100644 index 0000000000..e99f28c749 --- /dev/null +++ b/challenge-146/adam-russell/perl/ch-1.pl @@ -0,0 +1,98 @@ +use strict; +use warnings; +## +# Write a script to generate the 10001st prime number. +## +use boolean; +use Getopt::Long; +use LWP::UserAgent; + +use constant N => 10_001; +use constant PRIME_URL => "http://primes.utm.edu/lists/small/100000.txt"; + +sub get_primes{ + my @primes; + my $ua = new LWP::UserAgent( + ssl_opts => {verify_hostname => 0} + ); + my $response = $ua->get(PRIME_URL); + my @lines = split(/\n/,$response->decoded_content); + foreach my $line (@lines){ + my @p = split(/\s+/, $line); + unless(@p < 10){ + push @primes, @p[1..(@p - 1)]; + } + } + return @primes; +} + +sub sieve_atkin{ + my($n) = @_; + my @primes = (2, 3, 5); + my $upper_bound = int($n * log($n) + $n * log(log($n))); + my @atkin = (false) x $upper_bound; + my @sieve = (1, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 49, 53, 59); + for my $x (1 .. sqrt($upper_bound)){ + for(my $y = 1; $y <= sqrt($upper_bound); $y+=2){ + my $m = (4 * $x ** 2) + ($y ** 2); + my @remainders; + @remainders = grep {$m % 60 == $_} (1, 13, 17, 29, 37, 41, 49, 53) if $m <= $upper_bound; + $atkin[$m] = !$atkin[$m] if @remainders; + } + } + for(my $x = 1; $x <= sqrt($upper_bound); $x += 2){ + for(my $y = 2; $y <= sqrt($upper_bound); $y += 2){ + my $m = (3 * $x ** 2) + ($y ** 2); + my @remainders; + @remainders = grep {$m % 60 == $_} (7, 19, 31, 43) if $m <= $upper_bound; + $atkin[$m] = !$atkin[$m] if @remainders; + } + } + for(my $x = 2; $x <= sqrt($upper_bound); $x++){ + for(my $y = $x - 1; $y >= 1; $y -= 2){ + my $m = (3 * $x ** 2) - ($y ** 2); + my @remainders; + @remainders = grep {$m % 60 == $_} (11, 23, 47, 59) if $m <= $upper_bound; + $atkin[$m] = !$atkin[$m] if @remainders; + } + } + my @m; + for my $w (0 .. ($upper_bound / 60)){ + for my $s (@sieve){ + push @m, 60 * $w + $s; + } + } + for my $m (@m){ + last if $upper_bound < ($m ** 2); + my $mm = $m ** 2; + if($atkin[$m]){ + for my $m2 (@m){ + my $c = $mm * $m2; + last if $c > $upper_bound; + $atkin[$c] = false; + } + } + } + map{ push @primes, $_ if $atkin[$_] } 0 .. @atkin - 1; + return @primes; +} + +sub get_nth_prime{ + my($n, $generate) = @_; + my @primes; + unless($generate){ + @primes = get_primes; + } + else{ + @primes = sieve_atkin($n); + } + return $primes[$n - 1]; +} + + +MAIN:{ + my $n = N; + my $generate = false; + GetOptions("n=i" => \$n, generate => \$generate); + print get_nth_prime($n, $generate) . "\n"; +} diff --git a/challenge-146/adam-russell/perl/ch-2.pl b/challenge-146/adam-russell/perl/ch-2.pl new file mode 100644 index 0000000000..d17e09363a --- /dev/null +++ b/challenge-146/adam-russell/perl/ch-2.pl @@ -0,0 +1,63 @@ +use strict; +use warnings; +## +# Given a fraction return the parent and grandparent of +# the fraction from the Curious Fraction Tree. +## +use Graph; + +use constant ROOT => "1/1"; +use constant SEPARATOR => "/"; + +sub initialize{ + my($member) = @_; + my $graph = new Graph(); + $graph->add_vertex(ROOT); + my @next = (ROOT); + my @changes = ([0, 1], [1, 0]); + my $level = 0; + { + my @temp_next; + my @temp_changes; + do{ + $level++; + my $next = shift @next; + my($top, $bottom) = split(/\//, $next); + my $change_left = shift @changes; + my $change_right = shift @changes; + my $v_left = ($top + $change_left->[0]) . SEPARATOR . ($bottom + $change_left->[1]); + my $v_right = ($top + $change_right->[0]) . SEPARATOR . ($bottom + $change_right->[1]); + $graph->add_edge($next, $v_left); + $graph->add_edge($next, $v_right); + push @temp_next, $v_left, $v_right; + push @temp_changes, $change_left; + push @temp_changes, [$level + 1, 0], [0, $level + 1]; + push @temp_changes, $change_right; + }while(@next && !$graph->has_vertex($member)); + @next = @temp_next; + @changes = @temp_changes; + redo if !$graph->has_vertex($member); + } + return $graph; +} + +sub curious_fraction_tree{ + my($member) = @_; + my $graph = initialize($member); + my($parent) = $graph->predecessors($member); + my($grandparent) = $graph->predecessors($parent); + return ($parent, $grandparent); +} + +MAIN:{ + my($member, $parent, $grandparent); + $member = "3/5"; + ($parent, $grandparent) = curious_fraction_tree($member); + print "member = '$member'\n"; + print "parent = '$parent' and grandparent = '$grandparent'\n"; + print "\n"; + $member = "4/3"; + ($parent, $grandparent) = curious_fraction_tree($member); + print "member = '$member'\n"; + print "parent = '$parent' and grandparent = '$grandparent'\n"; +}
\ No newline at end of file diff --git a/challenge-146/bruce-gray/README b/challenge-146/bruce-gray/README index 5d0deab51b..6511220e4d 100644 --- a/challenge-146/bruce-gray/README +++ b/challenge-146/bruce-gray/README @@ -1 +1,33 @@ Solutions by Bruce Gray. + +For ch-2, the Perl and Raku programs can take rationals on the command-line for experimentation, +or will run their test suites if invoked without arguments. + +Sample runs: +$ perl perl/ch-1.pl + 104743 + +$ raku raku/ch-1.raku + 104743 + +$ perl perl/ch-2.pl 4817/5410 + 4817/5410 has CW parent,grandparent of: 4817/593,4224/593 + +$ raku raku/ch-2.raku 4817/5410 + (4817/593 4224/593) + +$ prove perl/ch-2.pl + perl/ch-2.pl .. ok + All tests successful. + Files=1, Tests=202, 0 wallclock secs ( 0.04 usr 0.01 sys + 0.09 cusr 0.01 csys = 0.15 CPU) + Result: PASS + +$ prove -e raku raku/ch-2.raku + raku/ch-2.raku .. ok + All tests successful. + Files=1, Tests=202, 3 wallclock secs ( 0.05 usr 0.00 sys + 2.72 cusr 0.13 csys = 2.90 CPU) + Result: PASS + +$ perl -MMath::PlanePath::RationalsTree -wE 'my $CW = Math::PlanePath::RationalsTree->new( tree_type => "CW" ); say join "/", $CW->n_to_xy( $CW->tree_n_parent( $CW->xy_to_n(@ARGV) ) );' 4817 5410 + 4817/593 + (Fleshed out in ch-2_via_module.pl) diff --git a/challenge-146/bruce-gray/Test_data/ch-2_test_generator.raku b/challenge-146/bruce-gray/Test_data/ch-2_test_generator.raku new file mode 100644 index 0000000000..89b5b526e5 --- /dev/null +++ b/challenge-146/bruce-gray/Test_data/ch-2_test_generator.raku @@ -0,0 +1,129 @@ +# Lots of utility subs and support for generating, navigating, and exploring the Calkin-Wilf tree. +# Also, code to generate (the beginnings of) ch-2_tests.txt + +# Generate each row by calculating both branches of each elements of the prior row. +sub next-Calkin-Wilf-row ( $prior_row ) { + return cache gather for $prior_row.list -> Rat $r { + my $sum = [+] $r.nude; + take $r.numerator / $sum; + take $sum / $r.denominator; + } +} +constant @CW-rows = (1/1,), &next-Calkin-Wilf-row ... *; + + +# Linear navigation to next neighbor on same row (or jumping row if at end). +sub next-Calkin-Wilf-neighbor ( Rat \x --> Rat ) { + my \n = x.floor; + my \y = x - n; + return 1/( n + 1 − y ); +} +constant @CW-linear = 1/1, &next-Calkin-Wilf-neighbor ... *; + + +subset LR-Str of Str where / ^ <[LR]>* $ /; +sub Calkin-Wilf-to-LR ( Rat $r --> LR-Str ) { + my @lineage = $r, &Calkin-Wilf-tree-parent …^ 1/1; + return @lineage.reverse.map({ <L R>[$_ > 1] }).join; +} + +sub LR-to-Calkin-Wilf ( LR-Str $LRs --> Rat ) { + my $r = 1/1; + for $LRs.comb -> $lr { + my $sum = $r.nude.sum; + + $r = ($lr eq 'L') ?? $r.numerator / $sum + !! ($lr eq 'R') ?? $sum / $r.denominator + !! die "Cannot happen" + ; + } + return $r; +} + +sub Calkin-Wilf-tree-parent ( Rat $r --> Rat ) { # Copied from ch-2.raku + my ( Int \n, Int \d ) = $r.nude; + my Int \diff = [-] $r.nude; + + return diff > 0 + ?? diff / d + !! n / -diff; +} + +# Formatter +sub f ( Rat $r ) { + my ($n, $d) = $r.nude; + return $n.fmt( '%20d') + ~ '/' ~ $d.fmt('%-20d'); +} + +sub make-test ( LR-Str $s1 ) { + my @a = $s1, + $s1.substr(0, *-1), + $s1.substr(0, *-2), + ; + + return @a.map({ f LR-to-Calkin-Wilf($_) }).join(" ") ~ ' # ' ~ $s1; +} + +sub make-single-bit-tests ( $size ) { + for <L R>, <R L> -> ($a, $b) { + for ^$size -> $X { + my $Y = $size - $X - 1; # One is for the single $b. + say make-test( ( $a x $X ) ~ $b ~ ( $a x $Y ) ); + } + } + say ''; +} + +sub make-tests-from-counts ( @counts ) { + for @counts -> ( $A, $B, $C ) { + for <L R>, <R L> -> ($a, $b) { + for <L R> -> $final { + say make-test( ( ( ( $a x $A ) ~ ( $b x $B ) ) ) x $C ~ $final ); + } + } + } + say ''; +} + +# For power=6, returns <64 0 1>, <32 32 1>, <16 16 2>, <8 8 4>, <4 4 8>, <2 2 16>, <1 1 32>; +sub make-counts-from-power ( Int $power ) { + my $size = 2 ** $power; + return gather { + take ($size, 0, 1); # Solid line of $size Ls or Rs. + for $power ^... 0 -> $p { + my $s = 2 ** $p; + take ( $s, $s, $size/$s/2 ); + } + } +} + +say @CW-linear.head(33)».nude».join('/'); + +say $_».nude».join("/") for @CW-rows.head(10); + + +if 1==1 { + for @CW-rows.skip(10).head.list { + say f($_), ' => ', Calkin-Wilf-to-LR($_); + } +} + +# say Calkin-Wilf-to-LR(273/290); +# say Calkin-Wilf-to-LR(21/10); # LLLLLLLLLRR +# say LR-from(21/10); # LLLLLLLLLRR +# say f LR-to-Calkin-Wilf('LLLLLLLLLRR'); # 21/10 + +if 1==0 { # Demonstrate the first N Left/Right navigations down the tree, as translations from Integer to LR then to CW. + for ^127 -> $n { + my LR-Str $LRs = ($n+1).base(2).trans( '0' => 'L', '1' => 'R' ).substr(1); + say "$LRs => ", f LR-to-Calkin-Wilf($LRs); + } +} + +make-tests-from-counts( make-counts-from-power(5) ); +make-tests-from-counts( map { ( $_, 0, 1 ) }, (63 .. 68) ); +make-tests-from-counts( map { ( $_, 0, 1 ) }, (1, {$_ * 10} … 10_000) ); +make-tests-from-counts( map { ( 1, 1, $_ ) }, (1, {$_ + 4} … 45) ); + +make-single-bit-tests(16); diff --git a/challenge-146/bruce-gray/Test_data/ch-2_tests.txt b/challenge-146/bruce-gray/Test_data/ch-2_tests.txt new file mode 100644 index 0000000000..961d9e5df6 --- /dev/null +++ b/challenge-146/bruce-gray/Test_data/ch-2_tests.txt @@ -0,0 +1,247 @@ +# Test data for Perl and Raku, "Curious Fraction Tree", https://theweeklychallenge.org/blog/perl-weekly-challenge-146/#TASK2 +# Format: \d+/\d+ \s+ \d+/\d+ \s+ \d+/\d+ +# where the first rational number is the input, and 2nd and 3rd are expected result of parent and grandparent +# (Comments allowed) +# Many lines also have an end-of-line comment describing the LR navigation and/or position within the row. + +# From task examples: +3/5 3/2 1/2 +4/3 1/3 1/2 + +# From task diagram, 3rd level: +1/3 1/2 1/1 +3/2 1/2 1/1 +2/3 2/1 1/1 +3/1 2/1 1/1 + +# From task diagram, 4th level: +1/4 1/3 1/2 +4/3 1/3 1/2 +3/5 3/2 1/2 +5/2 3/2 1/2 +2/5 2/3 2/1 +5/3 2/3 2/1 +3/4 3/1 2/1 +4/1 3/1 2/1 + +# From https://www.jasondavies.com/calkin-wilf-tree/ , left side: + 7/1 6/1 5/1 + 6/7 6/1 5/1 +11/6 5/6 5/1 + 5/11 5/6 5/1 +14/5 9/5 4/5 + 9/14 9/5 4/5 +13/9 4/9 4/5 + 4/13 4/9 4/5 +15/4 11/4 7/4 +11/15 11/4 7/4 +18/11 7/11 7/4 + 7/18 7/11 7/4 +17/7 10/7 3/7 +10/17 10/7 3/7 +13/10 3/10 3/7 + 3/13 3/10 3/7 +14/3 11/3 8/3 +11/14 11/3 8/3 +19/11 8/11 8/3 + 8/19 8/11 8/3 +21/8 13/8 5/8 +13/21 13/8 5/8 +18/13 5/13 5/8 + 5/18 5/13 5/8 +17/5 12/5 7/5 +12/17 12/5 7/5 +19/12 7/12 7/5 + 7/19 7/12 7/5 +16/7 9/7 2/7 + 9/16 9/7 2/7 +11/9 2/9 2/7 + 2/11 2/9 2/7 + +# From https://www.jasondavies.com/calkin-wilf-tree/ , right side: +11/2 9/2 7/2 + 9/11 9/2 7/2 +16/9 7/9 7/2 + 7/16 7/9 7/2 +19/7 12/7 5/7 +12/19 12/7 5/7 +17/12 5/12 5/7 + 5/17 5/12 5/7 +18/5 13/5 8/5 +13/18 13/5 8/5 +21/13 8/13 8/5 + 8/21 8/13 8/5 +19/8 11/8 3/8 +11/19 11/8 3/8 +14/11 3/11 3/8 + 3/14 3/11 3/8 +13/3 10/3 7/3 +10/13 10/3 7/3 +17/10 7/10 7/3 + 7/17 7/10 7/3 +18/7 11/7 4/7 +11/18 11/7 4/7 +15/11 4/11 4/7 + 4/15 4/11 4/7 +13/4 9/4 5/4 + 9/13 9/4 5/4 +14/9 5/9 5/4 + 5/14 5/9 5/4 +11/5 6/5 1/5 + 6/11 6/5 1/5 + 7/6 1/6 1/5 + 1/7 1/6 1/5 + +# +# Below here is all my own test data, generated via LR in Test_data/ch-2_test_generator.raku +# + +# Alternating long groups of L|R, with the length of the group shortening until group-size is 1. + 1/34 1/33 1/32 # LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL + 34/33 1/33 1/32 # LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLR + 33/34 33/1 32/1 # RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRL + 34/1 33/1 32/1 # RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR + + 273/290 273/17 256/17 # LLLLLLLLLLLLLLLLRRRRRRRRRRRRRRRRL + 290/17 273/17 256/17 # LLLLLLLLLLLLLLLLRRRRRRRRRRRRRRRRR + 17/290 17/273 17/256 # RRRRRRRRRRRRRRRRLLLLLLLLLLLLLLLLL + 290/273 17/273 17/256 # RRRRRRRRRRRRRRRRLLLLLLLLLLLLLLLLR + + 4817/5410 4817/593 4224/593 # LLLLLLLLRRRRRRRRLLLLLLLLRRRRRRRRL + 5410/593 4817/593 4224/593 # LLLLLLLLRRRRRRRRLLLLLLLLRRRRRRRRR + 593/5410 593/4817 593/4224 # RRRRRRRRLLLLLLLLRRRRRRRRLLLLLLLLL + 5410/4817 593/4817 593/4224 # RRRRRRRRLLLLLLLLRRRRRRRRLLLLLLLLR + + 121393/150050 121393/28657 92736/28657 # LLLLRRRRLLLLRRRRLLLLRRRRLLLLRRRRL + 150050/28657 121393/28657 92736/28657 # LLLLRRRRLLLLRRRRLLLLRRRRLLLLRRRRR + 28657/150050 28657/121393 28657/92736 # RRRRLLLLRRRRLLLLRRRRLLLLRRRRLLLLL + 150050/121393 28657/121393 28657/92736 # RRRRLLLLRRRRLLLLRRRRLLLLRRRRLLLLR + +1607521/2273378 1607521/665857 941664/665857 # LLRRLLRRLLRRLLRRLLRRLLRRLLRRLLRRL +2273378/665857 1607521/665857 941664/665857 # LLRRLLRRLLRRLLRRLLRRLLRRLLRRLLRRR + 665857/2273378 665857/1607521 665857/941664 # RRLLRRLLRRLLRRLLRRLLRRLLRRLLRRLLL +2273378/1607521 665857/1607521 665857/941664 # RRLLRRLLRRLLRRLLRRLLRRLLRRLLRRLLR + +5702887/9227465 5702887/3524578 2178309/3524578 # LRLRLRLRLRLRLRLRLRLRLRLRLRLRLRLRL +9227465/3524578 5702887/3524578 2178309/3524578 # LRLRLRLRLRLRLRLRLRLRLRLRLRLRLRLRR +3524578/9227465 3524578/5702887 3524578/2178309 # RLRLRLRLRLRLRLRLRLRLRLRLRLRLRLRLL +9227465/5702887 3524578/5702887 3524578/2178309 # RLRLRLRLRLRLRLRLRLRLRLRLRLRLRLRLR + + +# Left and Right edges of the tree, focused around the 64th level. +# This is the point that `ch-2_via_module.pl` (based on Math::PlanePath::RationalsTree) fails. +# Math::PlanePath::RationalsTree fails 18 of these 24 tests. +# My own CW algorithms in my Perl and Raku code pass all of these tests. + 1/65 1/64 1/63 # 'L' x 63, then L +65/64 1/64 1/63 # 'L' x 63, then R +64/65 64/1 63/1 # 'R' x 63, then L +65/1 64/1 63/1 # 'R' x 63, then R + 1/66 1/65 1/64 # 'L' x 64, then L +66/65 1/65 1/64 # 'L' x 64, then R +65/66 65/1 64/1 # 'R' x 64, then L +66/1 65/1 64/1 # 'R' x 64, then R + 1/67 1/66 1/65 # 'L' x 65, then L +67/66 1/66 1/65 # 'L' x 65, then R +66/67 66/1 65/1 # 'R' x 65, then L +67/1 66/1 65/1 # 'R' x 65, then R + 1/68 1/67 1/66 # 'L' x 66, then L +68/67 1/67 1/66 # 'L' x 66, then R +67/68 67/1 66/1 # 'R' x 66, then L +68/1 67/1 66/1 # 'R' x 66, then R + 1/69 1/68 1/67 # 'L' x 67, then L +69/68 1/68 1/67 # 'L' x 67, then R +68/69 68/1 67/1 # 'R' x 67, then L +69/1 68/1 67/1 # 'R' x 67, then R + 1/70 1/69 1/68 # 'L' x 68, then L +70/69 1/69 1/68 # 'L' x 68, then R +69/70 69/1 68/1 # 'R' x 68, then L +70/1 69/1 68/1 # 'R' x 68, then R + +# Left and Right edges of the tree, at exponential depths. + 1/3 1/2 1/1 # 'L' x 1, then L + 3/2 1/2 1/1 # 'L' x 1, then R + 2/3 2/1 1/1 # 'R' x 1, then L + 3/1 2/1 1/1 # 'R' x 1, then R + 1/12 1/11 1/10 # 'L' x 10, then L + 12/11 1/11 1/10 # 'L' x 10, then R + 11/12 11/1 10/1 # 'R' x 10, then L |