From fc922ab6b83e4082c1bf04132e91c685a22eb0d9 Mon Sep 17 00:00:00 2001 From: dcw Date: Sun, 7 Mar 2021 23:39:28 +0000 Subject: imported my solution's to this week's tasks. SEE ALSO OptimizingTask1 for an account of a series of profiling-driven optimizations that I made to speed up finding rare numbers. Overall, my fastest version ran approx 18 times faster than the original. --- challenge-102/duncan-c-white/OptimizingTask1 | 50 ++++++++ challenge-102/duncan-c-white/README | 118 ++++++------------ challenge-102/duncan-c-white/perl/ch-1.pl | 69 +++++++++++ challenge-102/duncan-c-white/perl/ch-1a.pl | 73 +++++++++++ challenge-102/duncan-c-white/perl/ch-1b.pl | 88 ++++++++++++++ challenge-102/duncan-c-white/perl/ch-1c.pl | 129 ++++++++++++++++++++ challenge-102/duncan-c-white/perl/ch-1d.pl | 144 ++++++++++++++++++++++ challenge-102/duncan-c-white/perl/ch-1e.pl | 148 ++++++++++++++++++++++ challenge-102/duncan-c-white/perl/ch-1f.pl | 159 ++++++++++++++++++++++++ challenge-102/duncan-c-white/perl/ch-1g.pl | 165 +++++++++++++++++++++++++ challenge-102/duncan-c-white/perl/ch-1h.pl | 175 +++++++++++++++++++++++++++ challenge-102/duncan-c-white/perl/ch-1i.pl | 148 ++++++++++++++++++++++ challenge-102/duncan-c-white/perl/ch-2.pl | 85 +++++++++++++ challenge-102/duncan-c-white/perl/run.sh | 5 + 14 files changed, 1472 insertions(+), 84 deletions(-) create mode 100644 challenge-102/duncan-c-white/OptimizingTask1 create mode 100755 challenge-102/duncan-c-white/perl/ch-1.pl create mode 100755 challenge-102/duncan-c-white/perl/ch-1a.pl create mode 100755 challenge-102/duncan-c-white/perl/ch-1b.pl create mode 100755 challenge-102/duncan-c-white/perl/ch-1c.pl create mode 100755 challenge-102/duncan-c-white/perl/ch-1d.pl create mode 100755 challenge-102/duncan-c-white/perl/ch-1e.pl create mode 100755 challenge-102/duncan-c-white/perl/ch-1f.pl create mode 100755 challenge-102/duncan-c-white/perl/ch-1g.pl create mode 100755 challenge-102/duncan-c-white/perl/ch-1h.pl create mode 100755 challenge-102/duncan-c-white/perl/ch-1i.pl create mode 100755 challenge-102/duncan-c-white/perl/ch-2.pl create mode 100755 challenge-102/duncan-c-white/perl/run.sh diff --git a/challenge-102/duncan-c-white/OptimizingTask1 b/challenge-102/duncan-c-white/OptimizingTask1 new file mode 100644 index 0000000000..f108fc1873 --- /dev/null +++ b/challenge-102/duncan-c-white/OptimizingTask1 @@ -0,0 +1,50 @@ +tried some optimizations of task 1 (rare numbers). All times are for n==8 or 9 +I used Devel::NYTProf to profile each version, then made small optimizations, +then reprofiled. See "run.sh" for how to run a particular version through +the profiler, generate the report, and copy it into a web-accessible directory +for viewing: + +ch-1.pl: the original, not optimized + time(8): 0:34.31 + time(9): 5:56:10 + +ch-1a.pl: observation from rare numbers webpage ("Properties of.." + section): rare numbers start with even top digit + time(8): 0:24.46 + time(9): 4:10.61 + +ch-1b.pl: only consider rare numbers starting with even top digit.. + time(8): 0:15.35 + time(9): 2:44.34 + +ch-1c.pl: lots of optimizations, especially 3 separate rare block + functions: rareblock(), rareblock05() and rareblock2378(). + time(8): 0:06.35 + time(9): 1:06.64 + +ch-1d.pl: lots more optimizations, especially: rather than generate x and + test x%10 == d, generate y (1/10th the range) and make + x = 10y + d: 1/10th the work, but same x's as before + time(8): 0:03.92 + time(9): 0:40.21 + +ch-1e.pl: inlined israre() into the slowest rareblock2378() func + time(8): 0:03.39 + time(9): 0:34.49 + +ch-1f.pl: inlined israre() into the next slowest rareblock05() func + time(8): 0:03.12 + time(9): 0:31.47 + +ch-1g.pl: inlined israre() into the last rareblock() func + time(8): 0:02.94 + time(9): 0:28.79 + +ch-1h.pl: inlined perfectsquare() everywhere + time(8): 0:02.15 + time(9): 0:21.20 + +ch-1i.pl: reintroduced israre() but with two inlined calls to perfectsquare() + sweet spot: clear, shows problem structure nicely, plus pretty fast + time(8): 0:03.23 + time(9): 0:32.34 diff --git a/challenge-102/duncan-c-white/README b/challenge-102/duncan-c-white/README index 32eaf793d3..77c6612c7d 100644 --- a/challenge-102/duncan-c-white/README +++ b/challenge-102/duncan-c-white/README @@ -1,104 +1,54 @@ -Task 1: "Pack a Spiral -Submitted by: Stuart Little +Task 1: "Rare Numbers -You are given an array @A of items (integers say, but they can be anything). +You are given a positive integer $N. -Your task is to pack that array into an MxN matrix spirally -counterclockwise, as tightly as possible. +Write a script to generate all Rare numbers of size $N if exists. Please +read http://www.shyamsundergupta.com/rare.htm for more information about it. -'Tightly' means the absolute value |M-N| of the difference has to be as -small as possible. +Examples -Example 1: - - Input: @A = (1,2,3,4) - - Output: - - 4 3 - 1 2 - -Since the given array is already a 1x4 matrix on its own, but that's -not as tight as possible. Instead, you'd spiral it counterclockwise into - - 4 3 - 1 2 - -Example 2: - - Input: @A = (1..6) - - Output: - - 6 5 4 - 1 2 3 - - or - - 5 4 - 6 3 - 1 2 - - Either will do as an answer, because they're equally tight. - -Example 3: - - Input: @A = (1..12) - - Output: - - 9 8 7 6 - 10 11 12 5 - 1 2 3 4 - - or - - 8 7 6 - 9 12 5 - 10 11 4 - 1 2 3 +(a) 2 digits: 65 +(b) 6 digits: 621770 +(c) 9 digits: 281089082 " -My notes: ok, interesting question. First, need to find "tightest" MxN -where abs(M-N) is minimum, easy. Second, need to build MxN array via -a "counterclockwise spiral starting at bottom corner". Not trivial, but -should be relatively easy. Hmmm.. actually, I can't see a particularly -quick and easy way, I'm sure I'm missing something. - +My notes: ok, interesting question. In summary: R (a +ve no) is a Rare No +iff R + reverse(R) and R - reverse(R) are both perfect squares. +So: generate and test time. -Task 2: "Origin-containing Triangle -Submitted by: Stuart Little +SEE ALSO OptimizingTask1 for an account of a series of profiling-driven +optimizations that I made to speed up finding rare numbers. Overall, my +fastest version ran approx 18 times faster than the original. -You are given three points in the plane, as a list of six co-ordinates: -A=(x1,y1), B=(x2,y2) and C=(x3,y3). -Write a script to find out if the triangle formed by the given three -co-ordinates contain origin (0,0). -Print 1 if found otherwise 0. +Task 2: "Hash-counting String -Example 1: +You are given a positive integer $N. - Input: A=(0,1), B=(1,0) and C=(2,2) +Write a script to produce Hash-counting string of that length. - Output: 0 because that triangle does not contain (0,0). +The definition of a hash-counting string is as follows: -Example 2: +- the string consists only of digits 0-9 and hashes, '#' - Input: A=(1,1), B=(-1,1) and C=(0,-3) +- there are no two consecutive hashes: '##' does not appear in your string +- the last character is a hash +- the number immediately preceding each hash (if it exists) is the position + of that hash in the string, with the position being counted up from 1 - Output: 1 because that triangle contains (0,0) in its interior. +It can be shown that for every positive integer N there is exactly one +such length-N string. -Example 3: +Examples: - Input: A=(0,1), B=(2,0) and C=(-6,0) - - Output: 1 because (0,0) is on the edge connecting B and C. + (a) "#" is the counting string of length 1 + (b) "2#" is the counting string of length 2 + (c) "#3#" is the string of length 3 + (d) "#3#5#7#10#" is the string of length 10 + (e) "2#4#6#8#11#14#" is the string of length 14 " -My notes: oh, God. Geometry. I hate geometry. Intuitively I've no -idea how to do this, so need to Google for solutions. Many different -ways, vectors, cross products, etc. Easiest to understand is from -www.geeksforgeeks.org/check-whether-a-given-point-lies-inside-a-triangle-or-not/ -and it seems to work (even it compares areas with "=="). Hmm, this seems -easier than Task 1! +My notes: ok, weird. Can we directly generate the single +hash-counting-string of length N? I think we can.. Turns out to be easy. + diff --git a/challenge-102/duncan-c-white/perl/ch-1.pl b/challenge-102/duncan-c-white/perl/ch-1.pl new file mode 100755 index 0000000000..2a7f9f177d --- /dev/null +++ b/challenge-102/duncan-c-white/perl/ch-1.pl @@ -0,0 +1,69 @@ +#!/usr/bin/perl +# +# Task 1: "Rare Numbers +# +# You are given a positive integer $N. +# +# Write a script to generate all Rare numbers of size $N if exists. Please +# read http://www.shyamsundergupta.com/rare.htm for more information about it. +# +# Examples +# +# (a) 2 digits: 65 +# (b) 6 digits: 621770 +# (c) 9 digits: 281089082 +# " +# +# My notes: ok, interesting question. In summary: R (a +ve no) is a Rare No +# iff R + reverse(R) and R - reverse(R) are both perfect squares. +# So: generate and test time. This is the simple version, almost no +# optimisations. +# + +use strict; +use warnings; +use feature 'say'; +use Getopt::Long; +use Function::Parameters; +use Data::Dumper; + +my $debug=0; +die "Usage: rare-numbers [--debug] N\n" + unless GetOptions( "debug" => \$debug ) + && @ARGV==1; + +my $n = shift; + + +# +# my $isperfect = perfectsquare( $n ); +# Return 1 iff $n is a perfect square, 0 otherwise. +# +fun perfectsquare( $n ) +{ + #return 0 if $n<0; + my $s = int(sqrt($n)); + return $n == $s * $s; +} + + +# +# my $israre = israre( $x ); +# Return 1 iff $x is rare, 0 otherwise. +# +fun israre( $x ) +{ + my $r = reverse $x; + return 0 if $r > $x; # cos x-r is negative, so not perfect square + return perfectsquare( $x + $r ) && perfectsquare( $x - $r ); +} + + +my $from = 10**($n-1); +my $to = 10**$n - 1; +say "$from..$to" if $debug; + +foreach my $x ($from..$to) +{ + say "rare $x" if israre($x); +} diff --git a/challenge-102/duncan-c-white/perl/ch-1a.pl b/challenge-102/duncan-c-white/perl/ch-1a.pl new file mode 100755 index 0000000000..f4cb160526 --- /dev/null +++ b/challenge-102/duncan-c-white/perl/ch-1a.pl @@ -0,0 +1,73 @@ +#!/usr/bin/perl +# +# Task 1: "Rare Numbers +# +# You are given a positive integer $N. +# +# Write a script to generate all Rare numbers of size $N if exists. Please +# read http://www.shyamsundergupta.com/rare.htm for more information about it. +# +# Examples +# +# (a) 2 digits: 65 +# (b) 6 digits: 621770 +# (c) 9 digits: 281089082 +# " +# +# My notes: ok, interesting question. In summary: R (a +ve no) is a Rare No +# iff R + reverse(R) and R - reverse(R) are both perfect squares. +# So: generate and test time. This is optimised version 1a: One optimization +# (from "Properties of rare numbers" section of the webpage): rare numbers +# start with an even top digit +# + +use strict; +use warnings; +use feature 'say'; +use Getopt::Long; +use Function::Parameters; +use Data::Dumper; + +my $debug=0; +die "Usage: rare-numbers [--debug] N\n" + unless GetOptions( "debug" => \$debug ) + && @ARGV==1; + +my $n = shift; + + +# +# my $isperfect = perfectsquare( $n ); +# Return 1 iff $n is a perfect square, 0 otherwise. +# +fun perfectsquare( $n ) +{ + return 0 if $n<0; + my $s = int(sqrt($n)); + return $n == $s * $s; +} + + +# +# my $israre = israre( $x ); +# Return 1 iff $x is rare, 0 otherwise. +# +fun israre( $x ) +{ + my $r = reverse $x; + return 0 if $r > $x; # cos x-r is negative, so not perfect square + return perfectsquare( $x + $r ) && perfectsquare( $x - $r ); +} + + +my $from = 10**($n-1); +my $to = 10**$n - 1; +say "$from..$to" if $debug; + +foreach my $x ($from..$to) +{ + say "rare $x" if + # for n==8, can save 10s (34s->24s) by adding the line: + substr("$x",0,1) % 2 == 0 && # even top digit + israre($x); +} diff --git a/challenge-102/duncan-c-white/perl/ch-1b.pl b/challenge-102/duncan-c-white/perl/ch-1b.pl new file mode 100755 index 0000000000..52c3a542a1 --- /dev/null +++ b/challenge-102/duncan-c-white/perl/ch-1b.pl @@ -0,0 +1,88 @@ +#!/usr/bin/perl +# +# Task 1: "Rare Numbers +# +# You are given a positive integer $N. +# +# Write a script to generate all Rare numbers of size $N if exists. Please +# read http://www.shyamsundergupta.com/rare.htm for more information about it. +# +# Examples +# +# (a) 2 digits: 65 +# (b) 6 digits: 621770 +# (c) 9 digits: 281089082 +# " +# +# My notes: ok, interesting question. In summary: R (a +ve no) is a Rare No +# iff R + reverse(R) and R - reverse(R) are both perfect squares. +# So: generate and test time. This is optimised version 1b: Different way of +# doing 1a's optimization (rare numbers start with even top digit). Skip +# numbers with odd top digit altogether (so don't even consider 1...., 3.... +# etc! rareblock( 2 ) tests all 2.... numbers etc.. +# + +use strict; +use warnings; +use feature 'say'; +use Getopt::Long; +use Function::Parameters; +use Data::Dumper; + +my $debug=0; +die "Usage: rare-numbers [--debug] N\n" + unless GetOptions( "debug" => \$debug ) + && @ARGV==1; + +my $n = shift; + + +# +# my $isperfect = perfectsquare( $n ); +# Return 1 iff $n is a perfect square, 0 otherwise. +# +fun perfectsquare( $n ) +{ + return 0 if $n<0; + my $s = int(sqrt($n)); + return $n == $s * $s; +} + + +# +# my $israre = israre( $x ); +# Return 1 iff $x is rare, 0 otherwise. +# +fun israre( $x ) +{ + my $r = reverse $x; + return 0 if $r > $x; # cos x-r is negative, so not perfect square + return perfectsquare( $x + $r ) && perfectsquare( $x - $r ); +} + + +# +# rareblock( $m, $f ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# for rare-ness. +# +fun rareblock( $m, $f ) +{ + my $from = $m * $f; + my $to = $m * ($f+1) - 1; + + say "$from..$to" if $debug; + + foreach my $x ($from..$to) + { + say "rare $x" if israre($x); + } +} + + +my $base = 10**($n-1); + +rareblock( $base, 2 ); +rareblock( $base, 4 ); +rareblock( $base, 6 ); +rareblock( $base, 8 ); diff --git a/challenge-102/duncan-c-white/perl/ch-1c.pl b/challenge-102/duncan-c-white/perl/ch-1c.pl new file mode 100755 index 0000000000..84f1a4364f --- /dev/null +++ b/challenge-102/duncan-c-white/perl/ch-1c.pl @@ -0,0 +1,129 @@ +#!/usr/bin/perl +# +# Task 1: "Rare Numbers +# +# You are given a positive integer $N. +# +# Write a script to generate all Rare numbers of size $N if exists. Please +# read http://www.shyamsundergupta.com/rare.htm for more information about it. +# +# Examples +# +# (a) 2 digits: 65 +# (b) 6 digits: 621770 +# (c) 9 digits: 281089082 +# " +# +# My notes: ok, interesting question. In summary: R (a +ve no) is a Rare No +# iff R + reverse(R) and R - reverse(R) are both perfect squares. +# So: generate and test time. This is optimized version 1c: loads more +# optimizations, most especially the last digit constraints leading to +# 3 separate rare block functions: rareblock(), rareblock05() and +# rareblock2378(). +# + +use strict; +use warnings; +use feature 'say'; +use Getopt::Long; +use Function::Parameters; +use Data::Dumper; + +my $debug=0; +die "Usage: rare-numbers [--debug] N\n" + unless GetOptions( "debug" => \$debug ) + && @ARGV==1; + +my $n = shift; + + +# +# my $isperfect = perfectsquare( $n ); +# Return 1 iff $n is a perfect square, 0 otherwise. +# +fun perfectsquare( $n ) +{ + my $s = int(sqrt($n)); + return $n == $s * $s; +} + + +# +# my $israre = israre( $x ); +# Return 1 iff $x is rare, 0 otherwise. +# +fun israre( $x ) +{ + my $r = reverse $x; + return + $x >= $r && # otherwise x-r is negative + perfectsquare( $x + $r ) && + perfectsquare( $x - $r ); +} + + +# +# rareblock( $m, $f, $lastdigit ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is $lastdigit for rare ness. +# +fun rareblock( $m, $f, $lastdigit ) +{ + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + foreach my $x ($from..$to) + { + my $x10 = $x%10; + next unless $x10 == $lastdigit; + next if $x10 > $f; + say "rare $x" if israre($x); + } +} + + +# +# rareblock05( $m, $f ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is 0 or 5 for rare ness. +# +fun rareblock05( $m, $f ) +{ + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + foreach my $x ($from..$to) + { + next unless $x % 5 == 0; + next if $x % 10 > $f; + say "rare $x" if israre($x); + } +} + + +# +# rareblock2378( $m, $f ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is 2, 3, 7 or 8 for rare ness. +# +fun rareblock2378( $m, $f ) +{ + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + foreach my $x ($from..$to) + { + my $y = $x % 10; + #next if $y > $f; + next unless $y==2 || $y==3 || $y==7 || $y==8; + say "rare $x" if israre($x); + } +} + + +my $base = 10**($n-1); + +rareblock( $base, 2, 2 ); +rareblock( $base, 4, 0 ); +rareblock05( $base, 6 ); +rareblock2378( $base, 8 ); diff --git a/challenge-102/duncan-c-white/perl/ch-1d.pl b/challenge-102/duncan-c-white/perl/ch-1d.pl new file mode 100755 index 0000000000..94db736c2d --- /dev/null +++ b/challenge-102/duncan-c-white/perl/ch-1d.pl @@ -0,0 +1,144 @@ +#!/usr/bin/perl +# +# Task 1: "Rare Numbers +# +# You are given a positive integer $N. +# +# Write a script to generate all Rare numbers of size $N if exists. Please +# read http://www.shyamsundergupta.com/rare.htm for more information about it. +# +# Examples +# +# (a) 2 digits: 65 +# (b) 6 digits: 621770 +# (c) 9 digits: 281089082 +# " +# +# My notes: ok, interesting question. In summary: R (a +ve no) is a Rare No +# iff R + reverse(R) and R - reverse(R) are both perfect squares. +# So: generate and test time. This is optimized version 1d: loads more +# optimizations, most especially each rareblock function generates each +# possible x and rejected all those where lastdigit(x) wasn't a particular +# value (or one of a set of values). Instead: loop 1/10th the size +# and APPEND the required digit.. +# + +use strict; +use warnings; +use feature 'say'; +use Getopt::Long; +use Function::Parameters; +use Data::Dumper; + +my $debug=0; +die "Usage: rare-numbers [--debug] N\n" + unless GetOptions( "debug" => \$debug ) + && @ARGV==1; + +my $n = shift; + + +# +# my $isperfect = perfectsquare( $n ); +# Return 1 iff $n is a perfect square, 0 otherwise. +# +fun perfectsquare( $n ) +{ + my $s = int(sqrt($n)); + return $n == $s * $s ? 1 : 0; +} + + +# +# my $israre = israre( $x ); +# Return 1 iff $x is rare, 0 otherwise. +# +fun israre( $x ) +{ + my $r = reverse $x; + return + $x>=$r && # otherwise x-r is negative, so not perfect square + perfectsquare( $x + $r ) && + perfectsquare( $x - $r ); +} + + +# +# rareblock( $m, $f, $lastdigit ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is $lastdigit for rare ness. +# +fun rareblock( $m, $f, $lastdigit ) +{ + return if $lastdigit > $f; # reverse(y) > y => y not rare + + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + my $x = $y*10 + $lastdigit; + say "rare $x" if israre($x); + } +} + + +# +# rareblock05( $m, $f ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is 0 or 5 for rare ness. +# +fun rareblock05( $m, $f ) +{ + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + my $x = $y*10; + say "rare $x" if israre($x); + $x += 5; + say "rare $x" if israre($x); + } +} + + +# +# rareblock2378( $m, $f ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is 2, 3, 7 or 8 for rare ness. +# +fun rareblock2378( $m, $f ) +{ + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + # try appending 2, 3, 7 and 8 and checking for rareness + foreach my $d (2,3,7,8) + { + my $x = $y * 10 + $d; + say "rare $x" if israre($x); + } + } +} + + +my $base = 10**($n-1); + +rareblock( $base, 2, 2 ); +rareblock( $base, 4, 0 ); +rareblock05( $base, 6 ); +rareblock2378( $base, 8 ); diff --git a/challenge-102/duncan-c-white/perl/ch-1e.pl b/challenge-102/duncan-c-white/perl/ch-1e.pl new file mode 100755 index 0000000000..cc38e0dcbc --- /dev/null +++ b/challenge-102/duncan-c-white/perl/ch-1e.pl @@ -0,0 +1,148 @@ +#!/usr/bin/perl +# +# Task 1: "Rare Numbers +# +# You are given a positive integer $N. +# +# Write a script to generate all Rare numbers of size $N if exists. Please +# read http://www.shyamsundergupta.com/rare.htm for more information about it. +# +# Examples +# +# (a) 2 digits: 65 +# (b) 6 digits: 621770 +# (c) 9 digits: 281089082 +# " +# +# My notes: ok, interesting question. In summary: R (a +ve no) is a Rare No +# iff R + reverse(R) and R - reverse(R) are both perfect squares. +# So: generate and test time. This is optimized version 1e: +# I inlined israre() into rareblock2378(), the slowest one. +# saves about 0.5 seconds. +# + +use strict; +use warnings; +use feature 'say'; +use Getopt::Long; +use Function::Parameters; +use Data::Dumper; + +my $debug=0; +die "Usage: rare-numbers [--debug] N\n" + unless GetOptions( "debug" => \$debug ) + && @ARGV==1; + +my $n = shift; + + +# +# my $isperfect = perfectsquare( $n ); +# Return 1 iff $n is a perfect square, 0 otherwise. +# +fun perfectsquare( $n ) +{ + my $s = int(sqrt($n)); + return $n == $s * $s ? 1 : 0; +} + + +# +# my $israre = israre( $x ); +# Return 1 iff $x is rare, 0 otherwise. +# +fun israre( $x ) +{ + my $r = reverse $x; + return + $x>=$r && # otherwise x-r is negative, so not perfect square + perfectsquare( $x + $r ) && + perfectsquare( $x - $r ); +} + + +# +# rareblock( $m, $f, $lastdigit ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is $lastdigit for rare ness. +# +fun rareblock( $m, $f, $lastdigit ) +{ + return if $lastdigit > $f; # reverse(y) > y => y not rare + + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + my $x = $y*10 + $lastdigit; + say "rare $x" if israre($x); + } +} + + +# +# rareblock05( $m, $f ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is 0 or 5 for rare ness. +# +fun rareblock05( $m, $f ) +{ + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + my $x = $y*10; + say "rare $x" if israre($x); + $x += 5; + say "rare $x" if israre($x); + } +} + + +# +# rareblock2378( $m, $f ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is 2, 3, 7 or 8 for rare ness. +# +fun rareblock2378( $m, $f ) +{ + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + # try appending 2, 3, 7 and 8 and checking for rareness + foreach my $d (2,3,7,8) + { + my $x = $y * 10 + $d; + + # inline israre() into: say "rare $x" if israre($x); + my $r = reverse $x; + say "rare $x" if + $x>=$r && # otherwise x-r is negative + perfectsquare( $x + $r ) && + perfectsquare( $x - $r ); + } + } +} + + +my $base = 10**($n-1); + +rareblock( $base, 2, 2 ); +rareblock( $base, 4, 0 ); +rareblock05( $base, 6 ); +rareblock2378( $base, 8 ); diff --git a/challenge-102/duncan-c-white/perl/ch-1f.pl b/challenge-102/duncan-c-white/perl/ch-1f.pl new file mode 100755 index 0000000000..0f6b959aff --- /dev/null +++ b/challenge-102/duncan-c-white/perl/ch-1f.pl @@ -0,0 +1,159 @@ +#!/usr/bin/perl +# +# Task 1: "Rare Numbers +# +# You are given a positive integer $N. +# +# Write a script to generate all Rare numbers of size $N if exists. Please +# read http://www.shyamsundergupta.com/rare.htm for more information about it. +# +# Examples +# +# (a) 2 digits: 65 +# (b) 6 digits: 621770 +# (c) 9 digits: 281089082 +# " +# +# My notes: ok, interesting question. In summary: R (a +ve no) is a Rare No +# iff R + reverse(R) and R - reverse(R) are both perfect squares. +# So: generate and test time. This is optimized version 1f: +# inlined israre() into rareblock05(). +# + +use strict; +use warnings; +use feature 'say'; +use Getopt::Long; +use Function::Parameters; +use Data::Dumper; + +my $debug=0; +die "Usage: rare-numbers [--debug] N\n" + unless GetOptions( "debug" => \$debug ) + && @ARGV==1; + +my $n = shift; + + +# +# my $isperfect = perfectsquare( $n ); +# Return 1 iff $n is a perfect square, 0 otherwise. +# +fun perfectsquare( $n ) +{ + my $s = int(sqrt($n)); + return $n == $s * $s ? 1 : 0; +} + + +# +# my $israre = israre( $x ); +# Return 1 iff $x is rare, 0 otherwise. +# +fun israre( $x ) +{ + my $r = reverse $x; + return + $x>=$r && # otherwise x-r is negative, so not perfect square + perfectsquare( $x + $r ) && + perfectsquare( $x - $r ); +} + + +# +# rareblock( $m, $f, $lastdigit ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is $lastdigit for rare ness. +# +fun rareblock( $m, $f, $lastdigit ) +{ + return if $lastdigit > $f; # reverse(y) > y => y not rare + + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + my $x = $y*10 + $lastdigit; + say "rare $x" if israre($x); + } +} + + +# +# rareblock05( $m, $f ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is 0 or 5 for rare ness. +# +fun rareblock05( $m, $f ) +{ + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + my $x = $y*10; + + # inline israre() into: say "rare $x" if israre($x); + my $r = reverse $x; + say "rare $x" if + $x>=$r && # otherwise x-r is negative + perfectsquare( $x + $r ) && + perfectsquare( $x - $r ); + $x += 5; + + # inline israre() into: say "rare $x" if israre($x); + $r = reverse $x; + say "rare $x" if + $x>=$r && # otherwise x-r is negative + perfectsquare( $x + $r ) && + perfectsquare( $x - $r ); + } +} + + +# +# rareblock2378( $m, $f ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is 2, 3, 7 or 8 for rare ness. +# +fun rareblock2378( $m, $f ) +{ + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + # try appending 2, 3, 7 and 8 and checking for rareness + foreach my $d (2,3,7,8) + { + my $x = $y * 10 + $d; + + # inline israre() into: say "rare $x" if israre($x); + my $r = reverse $x; + say "rare $x" if + $x>=$r && # otherwise x-r is negative + perfectsquare( $x + $r ) && + perfectsquare( $x - $r ); + } + } +} + + +my $base = 10**($n-1); + +rareblock( $base, 2, 2 ); +rareblock( $base, 4, 0 ); +rareblock05( $base, 6 ); +rareblock2378( $base, 8 ); diff --git a/challenge-102/duncan-c-white/perl/ch-1g.pl b/challenge-102/duncan-c-white/perl/ch-1g.pl new file mode 100755 index 0000000000..a1be0f5dac --- /dev/null +++ b/challenge-102/duncan-c-white/perl/ch-1g.pl @@ -0,0 +1,165 @@ +#!/usr/bin/perl +# +# Task 1: "Rare Numbers +# +# You are given a positive integer $N. +# +# Write a script to generate all Rare numbers of size $N if exists. Please +# read http://www.shyamsundergupta.com/rare.htm for more information about it. +# +# Examples +# +# (a) 2 digits: 65 +# (b) 6 digits: 621770 +# (c) 9 digits: 281089082 +# " +# +# My notes: ok, interesting question. In summary: R (a +ve no) is a Rare No +# iff R + reverse(R) and R - reverse(R) are both perfect squares. +# So: generate and test time. This is optimized version 1g: +# inlined israre() into rareblock(), and commented out israre(). +# + +use strict; +use warnings; +use feature 'say'; +use Getopt::Long; +use Function::Parameters; +use Data::Dumper; + +my $debug=0; +die "Usage: rare-numbers [--debug] N\n" + unless GetOptions( "debug" => \$debug ) + && @ARGV==1; + +my $n = shift; + + +# +# my $isperfect = perfectsquare( $n ); +# Return 1 iff $n is a perfect square, 0 otherwise. +# +fun perfectsquare( $n ) +{ + my $s = int(sqrt($n)); + return $n == $s * $s ? 1 : 0; +} + + +# +# my $israre = israre( $x ); +# Return 1 iff $x is rare, 0 otherwise. +# +#fun israre( $x ) +#{ +# my $r = reverse $x; +# return +# $x>=$r && # otherwise x-r is negative, so not perfect square +# perfectsquare( $x + $r ) && +# perfectsquare( $x - $r ); +#} + + +# +# rareblock( $m, $f, $lastdigit ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is $lastdigit for rare ness. +# +fun rareblock( $m, $f, $lastdigit ) +{ + return if $lastdigit > $f; # reverse(y) > y => y not rare + + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + my $x = $y*10 + $lastdigit; + + # inline israre() into: say "rare $x" if israre($x); + my $r = reverse $x; + say "rare $x" if + $x>=$r && # otherwise x-r is negative + perfectsquare( $x + $r ) && + perfectsquare( $x - $r ); + } +} + + +# +# rareblock05( $m, $f ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is 0 or 5 for rare ness. +# +fun rareblock05( $m, $f ) +{ + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + my $x = $y*10; + + # inline israre() into: say "rare $x" if israre($x); + my $r = reverse $x; + say "rare $x" if + $x>=$r && # otherwise x-r is negative + perfectsquare( $x + $r ) && + perfectsquare( $x - $r ); + $x += 5; + + # inline israre() into: say "rare $x" if israre($x); + $r = reverse $x; + say "rare $x" if + $x>=$r && # otherwise x-r is negative + perfectsquare( $x + $r ) && + perfectsquare( $x - $r ); + } +} + + +# +# rareblock2378( $m, $f ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is 2, 3, 7 or 8 for rare ness. +# +fun rareblock2378( $m, $f ) +{ + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + # try appending 2, 3, 7 and 8 and checking for rareness + foreach my $d (2,3,7,8) + { + my $x = $y * 10 + $d; + + # inline israre() into: say "rare $x" if israre($x); + my $r = reverse $x; + say "rare $x" if + $x>=$r && # otherwise x-r is negative + perfectsquare( $x + $r ) && + perfectsquare( $x - $r ); + } + } +} + + +my $base = 10**($n-1); + +rareblock( $base, 2, 2 ); +rareblock( $base, 4, 0 ); +rareblock05( $base, 6 ); +rareblock2378( $base, 8 ); diff --git a/challenge-102/duncan-c-white/perl/ch-1h.pl b/challenge-102/duncan-c-white/perl/ch-1h.pl new file mode 100755 index 0000000000..0a802f7912 --- /dev/null +++ b/challenge-102/duncan-c-white/perl/ch-1h.pl @@ -0,0 +1,175 @@ +#!/usr/bin/perl +# +# Task 1: "Rare Numbers +# +# You are given a positive integer $N. +# +# Write a script to generate all Rare numbers of size $N if exists. Please +# read http://www.shyamsundergupta.com/rare.htm for more information about it. +# +# Examples +# +# (a) 2 digits: 65 +# (b) 6 digits: 621770 +# (c) 9 digits: 281089082 +# " +# +# My notes: ok, interesting question. In summary: R (a +ve no) is a Rare No +# iff R + reverse(R) and R - reverse(R) are both perfect squares. +# So: generate and test time. This is optimized version 1h: +# inlined perfectsquare() everywhere. +# + +use strict; +use warnings; +use feature 'say'; +use Getopt::Long; +use Function::Parameters; +use Data::Dumper; + +my $debug=0; +die "Usage: rare-numbers [--debug] N\n" + unless GetOptions( "debug" => \$debug ) + && @ARGV==1; + +my $n = shift; + + +# +# my $isperfect = perfectsquare( $n ); +# Return 1 iff $n is a perfect square, 0 otherwise. +# +fun perfectsquare( $n ) +{ + my $s = int(sqrt($n)); + return $n == $s * $s ? 1 : 0; +} + + +# +# my $israre = israre( $x ); +# Return 1 iff $x is rare, 0 otherwise. +# +#fun israre( $x ) +#{ +# my $r = reverse $x; +# return +# $x>=$r && # otherwise x-r is negative, so not perfect square +# perfectsquare( $x + $r ) && +# perfectsquare( $x - $r ); +#} + + +# +# rareblock( $m, $f, $lastdigit ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is $lastdigit for rare ness. +# +fun rareblock( $m, $f, $lastdigit ) +{ + return if $lastdigit > $f; # reverse(y) > y => y not rare + + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + my $x = $y*10 + $lastdigit; + + # inline israre() and perfectsquare() into: + # say "rare $x" if israre($x); + my $r = reverse $x; + next if $x<$r; + my $n = $x+$r; + my $s = int(sqrt($n)); + next unless $n == $s * $s; + $n = $x-$r; + $s = int(sqrt($n)); + next unless $n == $s * $s; + say "rare $x"; + } +} + + +# +# rareblock05( $m, $f ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is 0 or 5 for rare ness. +# +fun rareblock05( $m, $f ) +{ + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + foreach my $d (0,5) + { + my $x = $y*10+$d; + + # inline israre() and perfectsquare() into: + # say "rare $x" if israre($x); + my $r = reverse $x; + next if $x<$r; + my $n = $x+$r; + my $s = int(sqrt($n)); + next unless $n == $s * $s; + $n = $x-$r; + $s = int(sqrt($n)); + next unless $n == $s * $s; + say "rare $x"; + } + } +} + + +# +# rareblock2378( $m, $f ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is 2, 3, 7 or 8 for rare ness. +# +fun rareblock2378( $m, $f ) +{ + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + # try appending 2, 3, 7 and 8 and checking for rareness + foreach my $d (2,3,7,8) + { + my $x = $y * 10 + $d; + + # inline israre() and perfectsquare() into: + # say "rare $x" if israre($x); + my $r = reverse $x; + next if $x<$r; + my $n = $x+$r; + my $s = int(sqrt($n)); + next unless $n == $s * $s; + $n = $x-$r; + $s = int(sqrt($n)); + next unless $n == $s * $s; + say "rare $x"; + } + } +} + + +my $base = 10**($n-1); + +rareblock( $base, 2, 2 ); +rareblock( $base, 4, 0 ); +rareblock05( $base, 6 ); +rareblock2378( $base, 8 ); diff --git a/challenge-102/duncan-c-white/perl/ch-1i.pl b/challenge-102/duncan-c-white/perl/ch-1i.pl new file mode 100755 index 0000000000..1c82e8cdb7 --- /dev/null +++ b/challenge-102/duncan-c-white/perl/ch-1i.pl @@ -0,0 +1,148 @@ +#!/usr/bin/perl +# +# Task 1: "Rare Numbers +# +# You are given a positive integer $N. +# +# Write a script to generate all Rare numbers of size $N if exists. Please +# read http://www.shyamsundergupta.com/rare.htm for more information about it. +# +# Examples +# +# (a) 2 digits: 65 +# (b) 6 digits: 621770 +# (c) 9 digits: 281089082 +# " +# +# My notes: ok, interesting question. In summary: R (a +ve no) is a Rare No +# iff R + reverse(R) and R - reverse(R) are both perfect squares. +# So: generate and test time. This is optimized version 1i: +# try reintroducing israre() but with the inlined perfectsquare() in it +# + +use strict; +use warnings; +use feature 'say'; +use Getopt::Long; +use Function::Parameters; +use Data::Dumper; + +my $debug=0; +die "Usage: rare-numbers [--debug] N\n" + unless GetOptions( "debug" => \$debug ) + && @ARGV==1; + +my $n = shift; + + +# +# my $isperfect = perfectsquare( $n ); +# Return 1 iff $n is a perfect square, 0 otherwise. +# +#fun perfectsquare( $n ) +#{ +# my $s = int(sqrt($n)); +# return $n == $s * $s ? 1 : 0; +#} + + +# +# my $israre = israre( $x ); +# Return 1 iff $x is rare, 0 otherwise. +# +fun israre( $x ) +{ + my $r = reverse $x; + return 0 if $x<$r; # if x-r is negative, not perfect square + # inlined perfectsquare() in: return 0 unless perfectsquare( $x + $r ); + my $n = $x+$r; + my $s = int(sqrt($n)); + return 0 unless $n == $s * $s; + + # inlined perfectsquare() in: return 0 unless perfectsquare( $x - $r ); + $n = $x-$r; + $s = int(sqrt($n)); + return 0 unless $n == $s * $s; +} + + +# +# rareblock( $m, $f, $lastdigit ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is $lastdigit for rare ness. +# +fun rareblock( $m, $f, $lastdigit ) +{ + return if $lastdigit > $f; # reverse(y) > y => y not rare + + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + my $x = $y*10 + $lastdigit; + say "rare $x" if israre($x); + } +} + + +# +# rareblock05( $m, $f ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is 0 or 5 for rare ness. +# +fun rareblock05( $m, $f ) +{ + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + foreach my $d (0,5) + { + my $x = $y*10+$d; + say "rare $x" if israre($x); + } + } +} + + +# +# rareblock2378( $m, $f ); +# Check all numbers in range $f * $m .. ($f+1) * $m - 1 +# whose last digit is 2, 3, 7 or 8 for rare ness. +# +fun rareblock2378( $m, $f ) +{ + my $from = $f * $m; + my $to = ($f+1) * $m - 1; + say "$from..$to" if $debug; + $from /= 10; + $to /= 10; + + foreach my $y ($from..$to) + { + # try appending 2, 3, 7 and 8 and checking for rareness + foreach my $d (2,3,7,8) + { + my $x = $y * 10 + $d; + say "rare $x" if israre($x); + } + } +} + + +my $base = 10**($n-1); + +rareblock( $base, 2, 2 ); +rareblock( $base, 4, 0 ); +rareblock05( $base, 6 ); +rareblock2378( $base, 8 ); diff --git a/challenge-102/duncan-c-white/perl/ch-2.pl b/challenge-102/duncan-c-white/perl/ch-2.pl new file mode 100755 index 0000000000..87107557ce --- /dev/null +++ b/challenge-102/duncan-c-white/perl/ch-2.pl @@ -0,0 +1,85 @@ +#!/usr/bin/perl +# +# Task 2: "Hash-counting String +# +# You are given a positive integer $N. +# +# Write a script to produce Hash-counting string of that length. +# +# The definition of a hash-counting string is as follows: +# +# - the string consists only of digits 0-9 and hashes, '#' +# - there are no two consecutive hashes: '##' does not appear in your string +# - the last character is a hash +# - the number immediately preceding each hash (if it exists) is the position +# # of that hash in the string, with the position being counted up from 1 +# +# It can be shown that for every positive integer N there is exactly one +# such length-N string. +# +# Examples: +# +# (a) "#" is the counting string of length 1 +# (b) "2#" is the counting string of length 2 +# (c) "#3#" is the string of length 3 +# (d) "#3#5#7#10#" is the string of length 10 +# (e) "2#4#6#8#11#14#" is the string of length 14 +# " +# +# My notes: ok, weird. Can we directly generate the single +# hash-counting-string of length N? I think we can.. +# Start from the end: last ch = '#'. is string long enough? if not, +# "N#" is how string ends. is string long enough now? if not, "#N#" +# is how string ends. is string long enough now? if not, N1 = N-2 +# prepend N1.. etc. Turns out to be very easy.. +# + +use strict; +use warnings; +use feature 'say'; +use Function::Parameters; +use Getopt::Long; +use Data::Dumper; + +my $test=0; +die "Usage: hash-counting-string N\n" unless + GetOptions( "test" => \$test ) && @ARGV==1; + +# +# my $hcs = hcs( $n ); +# Generate the hash-counting-string of length $n. +# +fun hcs( $n ) +{ + my $str = ''; + for(;;) + { + $str = "#$str" if $n>0; + return $str if $n==1; + $str = "$n$str" if $n>0; + return $str if $n==2; + my $l = length($n)+1; + $n -= $l; + } +} + + +if( $test ) +{ + eval "use Test::More"; die $@ if $@; + + foreach my $n (1..100) + { + my $hcs = hcs( $n ); + my $l = length($hcs); + #say "testing len(hcs($n))=$n"; + is( $l, $n, "len(hash-counting-string($n))==$n" ); + } + done_testing(); + exit 0; +} + +my $n = shift; +my $hcs = hcs( $n ); +say "hash-counting-string(length $n) = $hcs"; +say "len(hcs) = ".length($hcs); diff --git a/challenge-102/duncan-c-white/perl/run.sh b/challenge-102/duncan-c-white/perl/run.sh new file mode 100755 index 0000000000..b6726aa35a --- /dev/null +++ b/challenge-102/duncan-c-white/perl/run.sh @@ -0,0 +1,5 @@ +#!/bin/sh - +perl -d:NYTProf ./ch-$1.pl 7 +nytprofhtml +mkdir -p ~/public_html/rare +cp -pr nytprof/* ~/public_html/rare -- cgit