diff options
| -rw-r--r-- | challenge-140/abigail/perl/ch-1.pl | 49 | ||||
| -rw-r--r-- | challenge-140/abigail/perl/ch-2.pl | 106 |
2 files changed, 155 insertions, 0 deletions
diff --git a/challenge-140/abigail/perl/ch-1.pl b/challenge-140/abigail/perl/ch-1.pl new file mode 100644 index 0000000000..94726166cd --- /dev/null +++ b/challenge-140/abigail/perl/ch-1.pl @@ -0,0 +1,49 @@ +#!/opt/perl/bin/perl + +use 5.032; + +use strict; +use warnings; +no warnings 'syntax'; + +use experimental 'signatures'; +use experimental 'lexical_subs'; + +# +# See https://theweeklychallenge.org/blog/perl-weekly-challenge-140/#TASK1 +# + +# +# Run as: perl ch-1.pl < input-file +# + +# +# This challenge is riddle with confusing directives. WTF is a +# "decimal-coded binary number"? Searching for that term on +# Google just returns results for Binary-coded decimals, which +# are well known. +# +# Second point: "simulate the addition of the given binary numbers". +# Uhm, virtually every general purpose computer made in the past +# 70 years does arithmetic using binary. Are we asked to simulate +# something which is already done? How? The examples just give answers, +# the answers are as closely related to spinach as they are to simulations. +# +# Third, it mentions operator overloading. Why? What? Without overloading +# binary "+" adds two numbers. We're asked to add two numbers. Why on earth +# would you want to overload an operator? +# + +# +# As the description of the challenge is pretty pointless, we have to +# resort to extract the purpose: +# - Give two binary numbers, add them, and print the result in binary +# +# Which means, this challenge is about translating to and from binary +# string representation. We use 'oct' for the latter, and sprintf for the +# former. +# +# This leaves us a one-liner: +# + +say sprintf "%b" => eval join " + " => map {oct "0b$_"} split while <>; diff --git a/challenge-140/abigail/perl/ch-2.pl b/challenge-140/abigail/perl/ch-2.pl new file mode 100644 index 0000000000..b391a00101 --- /dev/null +++ b/challenge-140/abigail/perl/ch-2.pl @@ -0,0 +1,106 @@ +#!/opt/perl/bin/perl + +use 5.032; + +use strict; +use warnings; +no warnings 'syntax'; + +use experimental 'signatures'; +use experimental 'lexical_subs'; + +# +# See https://theweeklychallenge.org/blog/perl-weekly-challenge-140/#TASK2 +# + +# +# Run as: perl ch-2.pl < input-file +# + +# +# A trivial way to solve this is to calculate all numbers +# m = p * q, 1 <= p <= i, 1 <= q <= j, sort them, and select +# the kth number from the sorted list. +# +# This takes O (i * j * log (i * j)) time, using O (i * j) memory. +# Which, for the trivial examples of the challenge is peanuts. +# But if i and j are large, say 1,000,000, this becomes a problem. +# +# An alternative way would be scan the table in order, only generating +# as many numbers are needed: +# +# * Assume i <= j (else, just swap i and j) +# +# * Create i pairs. Initialize each pair P_n as [n, 1], 1 <= n <= i. +# Each pair corresponds to the column in the multiplication table. +# Since the values in a column are sorted, we only need to keep +# track of the highest element we haven't descarded yet. +# * Store each pair in a heap, ordered on P_n [0] * P_n [1], such +# that the pair with the smallest product is on top. +# * Let c = 0; while c < k: +# + Let Q be the pair on top of the heap. +# + Q [1] = Q [1] >= j ? Q [i * j + 1] : Q [1] + 1 [*] +# + Restore the heap +# * If c == k, then the wanted number is product of the pair at +# the top of the heap. +# +# [*] If Q [1] >= j, we have reached the bottom of the column, so the +# answer we're seeking cannot be in this column. By setting Q [1] +# to i * j + 1, it will be larger than the answer we're looking for, +# and we'll never consult this column again. +# +# Building the heap is O (i) (trivial in this case, as we can generate +# the elements in a sorted way). Restoring the heap takes O (log (i)). +# Hence, the total running time is O (i + k * log (i)), using O (i) +# memory. +# + + +sub prod ($pair) {$$pair [0] * $$pair [1]} +sub left ($index) {2 * $index + 1} +sub right ($index) {2 * $index + 2} + +sub make_heap ($i) {[map {[$_, 1]} 1 .. $i]} +sub rebalance ($heap, $index = 0) { + my $index1 = left $index; # Left child + my $index2 = right $index; # Right child + return if $index1 > $#$heap; # No children, so we're done. + my $p = prod $$heap [$index]; + # + # Find the smallest of the children + # + my $p1 = prod $$heap [$index1]; + if ($index2 <= $#$heap) { + my $p2 = prod $$heap [$index2]; + # + # Right child is smaller than left child, so right child wins + # + if ($p2 < $p1) { + $p1 = $p2; + $index1 = $index2; + } + } + # + # Now, $p1 is the smallest child, and on index $index1. + # If the smallest child is smaller than the current element, + # swap, and recurse. Else, we're done. + # + if ($p1 < $p) { + @$heap [$index, $index1] = @$heap [$index1, $index]; + rebalance ($heap, $index1); + } +} + + +while (<>) { + my ($i, $j, $k) = split; + ($j, $i) = ($i, $j) if $j < $i; + my $heap = make_heap ($i); + while ($k -- > 1) { + $$heap [0] [1] = $$heap [0] [1] >= $j ? $i * $j + 1 + : $$heap [0] [1] + 1; + rebalance ($heap); + } + say prod $$heap [0]; +} + |