diff options
| -rw-r--r-- | challenge-138/ryan-thompson/README.md | 12 | ||||
| -rwxr-xr-x | challenge-138/ryan-thompson/perl/ch-1.pl | 25 | ||||
| -rwxr-xr-x | challenge-138/ryan-thompson/perl/ch-2.pl | 56 | ||||
| -rw-r--r-- | challenge-167/ryan-thompson/README.md | 22 | ||||
| -rw-r--r-- | challenge-167/ryan-thompson/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-167/ryan-thompson/blog1.txt | 1 | ||||
| -rwxr-xr-x | challenge-167/ryan-thompson/perl/ch-1.pl | 49 | ||||
| -rwxr-xr-x | challenge-167/ryan-thompson/perl/ch-2.pl | 84 |
8 files changed, 225 insertions, 25 deletions
diff --git a/challenge-138/ryan-thompson/README.md b/challenge-138/ryan-thompson/README.md index 3dd1e955d3..c98d897bdf 100644 --- a/challenge-138/ryan-thompson/README.md +++ b/challenge-138/ryan-thompson/README.md @@ -1,19 +1,15 @@ # Ryan Thompson -## Week 110 Solutions +## Week 138 Solutions -### Task 1 › Phone Number Validation +### Task 1 › Workdays * [Perl](perl/ch-1.pl) - * [Raku](raku/ch-1.raku) -### Task 2 › Transpose CSV File +### Task 2 › Split Number * [Perl](perl/ch-2.pl) - * [Raku](raku/ch-2.raku) ## Blogs - * [Phone Number Validation](https://ry.ca/2021/04/phone-number-validation) - * [Transpose CSV File](https://ry.ca/2021/04/transpose-csv-file) - +None this week. diff --git a/challenge-138/ryan-thompson/perl/ch-1.pl b/challenge-138/ryan-thompson/perl/ch-1.pl new file mode 100755 index 0000000000..8aaaeb0c83 --- /dev/null +++ b/challenge-138/ryan-thompson/perl/ch-1.pl @@ -0,0 +1,25 @@ +#!/usr/bin/env perl +# +# ch-1.pl - Workdays +# +# 2022 Ryan Thompson <rjt@cpan.org> + +use 5.010; +use warnings; +use strict; +no warnings 'uninitialized'; + +use Time::Local; # Core + +my $year = $ARGV[0] // die "Usage: $0 year\n"; +my $time = timelocal(0,0,0,1,0,$year); # Jan 1 + +my $weekdays = 0; +while(1) { + my (undef, undef, undef, undef, undef, $yyyy, $wday) = localtime($time); + last if $yyyy != $year - 1900; + $time += 86403; # 1 day, and account for leap seconds + $weekdays++ if $wday > 0 and $wday < 6; +} + +say $weekdays; diff --git a/challenge-138/ryan-thompson/perl/ch-2.pl b/challenge-138/ryan-thompson/perl/ch-2.pl new file mode 100755 index 0000000000..be8f85278a --- /dev/null +++ b/challenge-138/ryan-thompson/perl/ch-2.pl @@ -0,0 +1,56 @@ +#!/usr/bin/env perl +# +# ch-2.pl - Split number +# +# 2022 Ryan Thompson <rjt@cpan.org> + +use 5.010; +use warnings; +use strict; +use Carp; +no warnings 'uninitialized'; + +die "Usage: $0 square_number\n" if @ARGV == 0; +split_num($ARGV[0]); + +# Takes a perfect square and outputs all possible partitionings of that +# number which sum to its square root. For example 99*99 = 9801 +# 98 + 0 + 1 = 99. +# The task description asked for only a boolean return if any partitions +# satisfied the requirement, but I've arbitrarily decided to spice things +# up by printing out all matching partitions. This adds a bit of housekeeping +# to the code, but it's not that bad. +sub split_num { + my $sq = shift; + my $n = sqrt($sq); + croak "$sq is not a perfect square" if $n != int $n; + + # The splits can be represented by a binary number of length($n)-1, + # where 0 = don't split, and 1 = split + my $bits = length($sq)-1; + my $max = 2**$bits; + + # Start at 1 because 0 would not give us "two or more" splits +BIN:for my $bin (1..$max) { + my $sum = 0; # Track partial sum for optimization + my $num = ''; + my @sum; + for my $bit (0..$bits) { + next if $num eq '0'; # No leading zeroes + $num .= substr $sq, $bit, 1; + + if ($bin & (1 << $bit)) { + push @sum, $num; + $sum += $num; + next BIN if $sum > $n; + $num = ''; + } + } + push @sum, $num; + $sum += $num; + next if $sum != $n; + + printf "%30s = %10d\n", join(' + ', @sum), $sum + if $sum = $n; + } +} diff --git a/challenge-167/ryan-thompson/README.md b/challenge-167/ryan-thompson/README.md index dafa7e82f7..5047df481c 100644 --- a/challenge-167/ryan-thompson/README.md +++ b/challenge-167/ryan-thompson/README.md @@ -1,28 +1,16 @@ # Ryan Thompson -## Week 166 Solutions +## Week 167 Solutions -### Task 1 › Hexadecimal Words +### Task 1 › Circular Primes * [Perl](perl/ch-1.pl) - $ ./ch-1.pl [options] - - --dict=/path/to/dict Dictionary location - --length=8 Target word or phrase length - --max-sub=0.2 Ratio of # substitutions / word length - --min-length=3 Minimum word length - --nopretty Print hex only, otherwise, pretty print - - * [Perl, simplified](perl/ch-1-short.pl) - -### Task 2 › K-Directory Diff +### Task 2 › Lanczos Approximation * [Perl](perl/ch-2.pl) - $ ./ch-2.pl dir1 dir2 ... - ## Blogs - * [Hexadecimal Words](https://ry.ca/2022/05/hexadecimal-words/) - * [K-Directory Diff](https://ry.ca/2022/05/k-directory-diff/) + * [Circular Primes](https://ry.ca/2022/05/circular-primes/) + * [Lanczos Approximation](https://ry.ca/2022/05/lanczos-approximation/) diff --git a/challenge-167/ryan-thompson/blog.txt b/challenge-167/ryan-thompson/blog.txt new file mode 100644 index 0000000000..04da2d0eed --- /dev/null +++ b/challenge-167/ryan-thompson/blog.txt @@ -0,0 +1 @@ +https://ry.ca/2022/05/circular-primes/ diff --git a/challenge-167/ryan-thompson/blog1.txt b/challenge-167/ryan-thompson/blog1.txt new file mode 100644 index 0000000000..3eff05d9dc --- /dev/null +++ b/challenge-167/ryan-thompson/blog1.txt @@ -0,0 +1 @@ +https://ry.ca/2022/05/lanczos-approximation/ diff --git a/challenge-167/ryan-thompson/perl/ch-1.pl b/challenge-167/ryan-thompson/perl/ch-1.pl new file mode 100755 index 0000000000..93054d8c75 --- /dev/null +++ b/challenge-167/ryan-thompson/perl/ch-1.pl @@ -0,0 +1,49 @@ +#!/usr/bin/env perl +# +# ch-1.pl - Circular primes (OEIS A016114) +# +# Specifically, the lowest circular prime in each group. So, for example, +# 113 is a circular prime, as are the rotations 131 and 311, but only 113 +# would be included in the output. +# +# 2022 Ryan Thompson <rjt@cpan.org> + +use 5.010; +use warnings; +use strict; +no warnings 'uninitialized'; + +# Just built a sieve a few weeks ago. +# I have a 3-month Eratosthenes cooldown. +use Math::Prime::Util qw< primes is_prime >; + +my $target = 13; # How many circular primes we want +my %circ; # $circ{n} = 1 if n is a circular prime + +for (my $digits = 3; ; $digits++) { + last if scalar keys %circ >= $target; + + my ($lo, $hi) = (10**($digits-1), 10**$digits-1); + + # All circular primes > 6 digits are repunits + if ($digits > 6) { + my $n = 1 x $digits; + say "R_$digits" if is_prime($n); + $circ{$n} = 1; + next; + } + + my @primes = @{ primes($lo, $hi) }; # All $digits length primes + my %prime = map { $_ => 1 } @primes; + + # Now check every $digits-digit prime for circularity +N: for my $n (@primes) { + my $rot = $n; + for (1..$digits-1) { + $rot = chop($rot) . $rot; + next N if $circ{$rot} or not $prime{$rot}; + } + say $n; + $circ{$n} = 1; + } +} diff --git a/challenge-167/ryan-thompson/perl/ch-2.pl b/challenge-167/ryan-thompson/perl/ch-2.pl new file mode 100755 index 0000000000..d0e6558cf9 --- /dev/null +++ b/challenge-167/ryan-thompson/perl/ch-2.pl @@ -0,0 +1,84 @@ +#!/usr/bin/env perl +# +# ch-2.pl - Gamma function, Lanczos approximation +# +# 2022 Ryan Thompson <rjt@cpan.org> + +use 5.026; +use warnings; +use strict; +use List::Util qw< sum >; +use Math::Complex; + +use experimental 'signatures'; +no warnings 'uninitialized'; + +use constant { + g => 7, # Arbitrary + tol => 1e-7, # Required precision in testing +}; + +# These coefficients are only valid for g = 7, @p = 9 +# Credit: https://mrob.com/pub/ries/lanczos-gamma.html +my @p = ( + 0.99999999999980993227684700473478, + 676.520368121885098567009190444019, + -1259.13921672240287047156078755283, + 771.3234287776530788486528258894, + -176.61502916214059906584551354, + 12.507343278686904814458936853, + -0.13857109526572011689554707, + 9.984369578019570859563e-6, + 1.50563273514931155834e-7, +); + +# Lanczos approximation of the gamma function +# Accepts a real or complex argument +sub gamma($z) { + return pi / (sin($z * pi) * gamma(1 - $z)) if Re($z) < 0.5; + + my $A = $p[0] + sum map { $p[$_] / ($z + $_ - 1) } 1..$#p; + my $t = $z + g - 0.5; + + sqrt(2*pi) * $A * $t**($z-0.5) * exp(-$t); +} + +say gamma($ARGV[0]) and exit if defined $ARGV[0]; + +# +# Tests +# + +use Test::More; + +# Real tests +my %tests = ( + # Real tests + 1 => 1, + 2 => 1, + 3 => 2, + 4 => 6, + 5 => 24, + 0.5 => sqrt(pi), + 1.5 => 0.5 * sqrt(pi), + -0.5 => -2 * sqrt(pi), + + # Complex tests + '1-1i' => 0.4980156681 + 0.1549498283*i, + '0.5+0.5i' => 0.8181639995 - 0.7633138287*i, + '5+3i' => 0.0160418827 - 9.4332932898*i, + '5-3i' => 0.0160418827 + 9.4332932898*i, +); +gamma_ok($_, $tests{$_}) for sort keys %tests; + +done_testing; + +# Test complex or real inputs +sub gamma_ok($z,$exp) { + my $gamma = gamma(cplx($z)); + + ok(( abs(Re($gamma) - Re($exp)) <= tol + and abs(Im($gamma) - Im($exp)) <= tol ), + "gamma($z) = $exp within " .tol) + or diag " got $gamma"; +} |