aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorUtil <bruce.gray@acm.org>2023-12-10 18:05:25 -0600
committerUtil <bruce.gray@acm.org>2023-12-10 18:05:25 -0600
commite748ee63c77435d699eaaa1d0182ffd276c62558 (patch)
treea34a8125b320c029e5e07a5630bb109d8075bcdf
parent3c1ecc6b938552014db14317e655085ab507ae90 (diff)
downloadperlweeklychallenge-club-e748ee63c77435d699eaaa1d0182ffd276c62558.tar.gz
perlweeklychallenge-club-e748ee63c77435d699eaaa1d0182ffd276c62558.tar.bz2
perlweeklychallenge-club-e748ee63c77435d699eaaa1d0182ffd276c62558.zip
Add TWC 246 solutions by Bruce Gray (in Raku only).
-rw-r--r--challenge-246/bruce-gray/raku/ch-1.raku31
-rw-r--r--challenge-246/bruce-gray/raku/ch-2.raku113
2 files changed, 144 insertions, 0 deletions
diff --git a/challenge-246/bruce-gray/raku/ch-1.raku b/challenge-246/bruce-gray/raku/ch-1.raku
new file mode 100644
index 0000000000..455c90c9e9
--- /dev/null
+++ b/challenge-246/bruce-gray/raku/ch-1.raku
@@ -0,0 +1,31 @@
+# One-line solution:
+#
+# raku -e 'put (1..49).pick(6)'
+#
+# Example output: 42 18 15 6 49 47
+
+# Oh, you want tests as well? Here you go!
+constant $lottery_balls = 6;
+constant $lottery_range = 1..49;
+
+sub German_lottery ( --> Seq ) { $lottery_range.pick($lottery_balls) }
+
+use Test; plan 2;
+constant $test_draws = 1_000;
+my %faults;
+my SetHash $ball_seen;
+for ^$test_draws {
+ my Int @win = German_lottery();
+ $ball_seen{$_} = True for @win;
+
+ sub bad ($t) { ++%faults{$t}; diag "Failed $t: @win[]" }
+
+ bad 'bad_count' if @win != $lottery_balls;
+ bad 'not_unique' if @win.repeated;
+ bad 'exceeded_max' if @win.any > $lottery_range.max;
+ bad 'lower_than_min' if @win.any < $lottery_range.min;
+}
+is $ball_seen.elems, $lottery_range.elems,
+ "In $test_draws draws, all balls {$lottery_range.raku} were drawn at least once.";
+is-deeply %faults, {},
+ "In $test_draws draws, no faults were found.";
diff --git a/challenge-246/bruce-gray/raku/ch-2.raku b/challenge-246/bruce-gray/raku/ch-2.raku
new file mode 100644
index 0000000000..c90dcbe6b2
--- /dev/null
+++ b/challenge-246/bruce-gray/raku/ch-2.raku
@@ -0,0 +1,113 @@
+# Two ways to carve up the problem.
+# Both are extended to work with more than 5 elements.
+
+# This one is concise, but inflexible and fragile.
+# find_PQ_int finds the LR for the first 4 iff PQ are Int.
+# task2a uses find_PQ_int to check that the same PQ applies everywhere,
+# by calculating the PQ for every consecutive 4 elements.
+sub find_PQ_int ( (\a, \b, \c, \d) ) {
+ my ($D, @PQn) = b² - a*c, b*d - c², a*d - b*c;
+
+ return (@PQn.all %% $D) ?? [@PQn Xdiv $D] !! [];
+}
+sub task2a ( @ns --> Bool ) {
+ my @PQ = find_PQ_int(@ns.head(4))
+ or return False;
+
+ return so @PQ eqv @ns.skip.rotor(4 => -3).map(&find_PQ_int).all;
+}
+
+# This is longer, but much more versatile and resilient against corner cases.
+# find_PQ is a general-purpose, works-with-anything PQ finder. Can return Rats!
+# make_2LR generates an infinite Linear Recurrence from PQ and the first two elements.
+# find_PQ_constant makes sure the same PQ applies everywhere,
+# by feeding the info from `find_PQ` to `make_2LR`, and comparing the sequences. Works with Rats!
+# task2b is only True when find_PQ_constant returns Ints.
+
+# Linear Recurrence Relation, second-order with constant coefficients.
+sub make_2LR ( (\P, \Q), (\a0, \a1) --> Seq ) {
+ # return a0, a1, P * * + Q * * … *; # Bwaahaahaa!
+
+ my Code $next_lr = { P * $^x + Q * $^y };
+
+ return a0, a1, $next_lr … Inf;
+}
+
+sub find_PQ ( $a, $b, $c, $d ) {
+ my $PQ_denom = $b² - $a*$c;
+ my Rat ($P, $Q);
+
+ # Division by zero can ruin your day.
+ if $a == 0 and $b == 0 {
+ return 0,0 if $c == 0 and $d == 0; # *any* P or Q could be correct.
+
+ # If $c != 0 or $d != 0, no P or Q could achieve this; nothing you multiply by zero can ever move the sequence off of zero.
+ return Nil;
+ }
+ elsif $b == 0 {
+ # Similar to the above, if $b==0 and $c==0, then d==0 vs d!=0 yield any-answer or no-answer.
+ return Nil if $c == 0;
+
+ ($P, $Q) = ($c / $a, $d / $c);
+ }
+ elsif $a == 0 {
+ $Q = $c / $b;
+ $P = $d / $b - $Q²;
+ }
+ elsif $PQ_denom == 0 {
+ # A geometric series
+ # like 2,10,50,250 (factor=5)
+ # or 3, 3, 3, 3 (factor=1)
+ my Rat $factor = $b / $a;
+
+ if $c == 0 {
+ warn "Can't happen??? XXX $a, $b, $c, $d";
+ return Nil;
+ }
+ if $factor != $c/$b or $factor != $d/$c {
+ # Like: find_PQ(3, 6, 12, 23);
+ return Nil;
+ }
+ ($P, $Q) = 0/1, $factor;
+ }
+ else {
+ $P = ($b*$d - $c² ) / $PQ_denom;
+ $Q = ($b*$c - $a*$d) / $PQ_denom;
+ }
+
+ return ($P, $Q)».narrow;
+}
+
+sub find_PQ_constant ( @ns ) {
+ die "Minimum 4" if @ns < 4;
+
+ my ( $P, $Q ) = find_PQ( |@ns.head(4) )».narrow;
+
+ my @seq = make_2LR( ($P, $Q), @ns.head(2) );
+
+ return Nil if @ns !eqv @seq.head(+@ns).List;
+ return $P, $Q;
+}
+sub task2b ( @ns --> Bool ) {
+ my ( $P, $Q ) = find_PQ_constant(@ns)
+ orelse return False;
+
+ return ($P ~~ Int && $Q ~~ Int);
+}
+
+
+my @task_tests =
+ ( True , ( 1, 1, 2, 3, 5 ) ),
+ ( False, ( 4, 2, 4, 5, 7 ) ),
+ ( True , ( 4, 1, 2, -3, 8 ) ),
+
+ # Correct working 2nd-order LRs, but in Rat instead of Int:
+ ( False, ( 5, 7, 227/24, 2485/192, 81241/4608 ) ),
+ ( False, (24, 24, 37/1 , 387/8 , 12863/192 ) ),
+;
+use Test; plan @task_tests * 2;
+for ( :&task2a, :&task2b ) -> ( :key($sub_name), :value(&task2) ) {
+ for @task_tests -> (Bool $expected, @in) {
+ is task2(@in), $expected, "$sub_name - @in[0,1]...";
+ }
+}