diff options
| -rw-r--r-- | challenge-161/ryan-thompson/README.md | 28 | ||||
| -rw-r--r-- | challenge-161/ryan-thompson/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-161/ryan-thompson/blog1.txt | 1 | ||||
| -rwxr-xr-x | challenge-161/ryan-thompson/perl/ch-1.pl | 115 | ||||
| -rwxr-xr-x | challenge-161/ryan-thompson/perl/ch-2.pl | 58 |
5 files changed, 195 insertions, 8 deletions
diff --git a/challenge-161/ryan-thompson/README.md b/challenge-161/ryan-thompson/README.md index 3dd1e955d3..499e779053 100644 --- a/challenge-161/ryan-thompson/README.md +++ b/challenge-161/ryan-thompson/README.md @@ -1,19 +1,31 @@ # Ryan Thompson -## Week 110 Solutions +## Week 161 Solutions -### Task 1 › Phone Number Validation +### Task 1 › Abecedarian Words * [Perl](perl/ch-1.pl) - * [Raku](raku/ch-1.raku) -### Task 2 › Transpose CSV File + #### Synopsis + + ./ch-1.pl [--dict=path/to/dict.txt --benchmark --test] + + * `--benchmark` - Runs benchmarking on every different solution + * `--test` - Unit tests showing all solutions produce equal results + * `--dict=file` - Alternate dictionary file to use (uses `../../../data/dictionary.txt` by default) + +### Task 2 › Pangrams * [Perl](perl/ch-2.pl) - * [Raku](raku/ch-2.raku) -## Blogs +#### Usage - * [Phone Number Validation](https://ry.ca/2021/04/phone-number-validation) - * [Transpose CSV File](https://ry.ca/2021/04/transpose-csv-file) + ./ch-2.pl [--dict=path/to/dict.txt --min=length] + + * `--dict=file` - Alternate dictionary file to use (default: `../../../data/dictionary.txt`) + * `--min=length` - Minimum word length (default: 4) + +## Blogs + * [Abecedarian Words](https://ry.ca/2022/04/abecedarian-words) + * [Pangrams](https://ry.ca/2022/04/pangrams) diff --git a/challenge-161/ryan-thompson/blog.txt b/challenge-161/ryan-thompson/blog.txt new file mode 100644 index 0000000000..eedbe00a2a --- /dev/null +++ b/challenge-161/ryan-thompson/blog.txt @@ -0,0 +1 @@ +https://ry.ca/2022/04/abecedarian-words/ diff --git a/challenge-161/ryan-thompson/blog1.txt b/challenge-161/ryan-thompson/blog1.txt new file mode 100644 index 0000000000..105731ec5a --- /dev/null +++ b/challenge-161/ryan-thompson/blog1.txt @@ -0,0 +1 @@ +https://ry.ca/2022/04/pangrams/ diff --git a/challenge-161/ryan-thompson/perl/ch-1.pl b/challenge-161/ryan-thompson/perl/ch-1.pl new file mode 100755 index 0000000000..88fdc6a85f --- /dev/null +++ b/challenge-161/ryan-thompson/perl/ch-1.pl @@ -0,0 +1,115 @@ +#!/usr/bin/env perl +# +# ch-1.pl - Abecedarian words +# +# 2022 Ryan Thompson <rjt@cpan.org> + +use 5.010; +use warnings; +use strict; +use autodie; +no warnings 'uninitialized'; + +use Getopt::Long; +use File::Slurper qw< read_lines >; +use Benchmark qw<cmpthese :hireswallclock>; +use List::Util qw< any all reduce >; + +my %o = (dict => '../../../data/dictionary.txt'); +GetOptions(\%o, qw< dict=s test benchmark >) + or die "Usage: $0 [--dict=path/to/dict.txt] [--test] [--benchmark]\n"; + +# +# Optional part! This one's for you, Colin. :-) +# +# Most DOS floppy bit errs abort boot. +# Best bet for a fix now is to beg for a copy of my floppy! +# Or, go for almost any beer or gin. Any buzz, not choosy. +# + + +# Challenge output requirement + +our @words = read_lines($o{dict}); # "our" helps Benchmark. Use my normally. +say for sort { length $a <=> length $b } abcd_words(@words); + + +# Here are the abecedarian filters themselves + +sub is_abcd_sort { $_ eq join '', sort split // } + +sub is_abcd_reduce { '~' ne reduce { $a gt $b ? '~' : $b } split // } + +sub is_abcd_regex { /^a*b*c*d*e*f*g*h*i*j*k*l*m*n* + o*p*q*r*s*t*u*v*w*x*y*z*$/x } + +sub is_abcd_loop { + my $last; + for my $ch (split //) { + return if $last gt $ch; + $last = $ch; + } + $_; +} + +# Two different C versions, for fun + +use Inline 'C' => <<'END' +/* This does the actual checking, used by the next two functions */ +int __is_abcd(unsigned char *s) { + unsigned char last = 0; + for (unsigned char *p = s; *p; last = *p, p++ ) + if (last > *p) + return 0; + + return 1; +} + +/* Boolean, works on $_ */ +int is_abcd_inline() { + SV *var = get_sv("_", GV_ADD); + unsigned char *s = SvPVutf8_nolen(var); + + return __is_abcd(s); +} + +/* Process the entire list */ +void abcd_words(SV *word, ...) { + Inline_Stack_Vars; + + Inline_Stack_Reset; + for (int i = 0; i < Inline_Stack_Items; i++) { + if (__is_abcd(SvPV(Inline_Stack_Item(i), PL_na))) + Inline_Stack_Push(Inline_Stack_Item(i)); + } + Inline_Stack_Done; +} +END +; + + +# +# Tests +# + +my %filters = map { $_ => "grep \&is_abcd_$_, \@words" } + qw< sort regex loop reduce inline >; + +$filters{inlAll} = "abcd_words(\@words)"; + +if ($o{test}) { + use Test::More; + # Loop version will be our reference version, but it doesn't matter, + # as any discrepancy will throw an error + my $abcd= [ grep &is_abcd_loop, @words ]; + + is_deeply [ eval $filters{$_} ], $abcd, $_ for sort keys %filters; + + done_testing; +} + +# +# Benchmarking +# + +cmpthese(-5 => \%filters) if $o{benchmark}; diff --git a/challenge-161/ryan-thompson/perl/ch-2.pl b/challenge-161/ryan-thompson/perl/ch-2.pl new file mode 100755 index 0000000000..88fef18bf3 --- /dev/null +++ b/challenge-161/ryan-thompson/perl/ch-2.pl @@ -0,0 +1,58 @@ +#!/usr/bin/env perl +# +# ch-2.pl - Pangram generator +# +# 2022 Ryan Thompson <rjt@cpan.org> + +use 5.010; +use warnings; +use strict; + +use List::Util qw< uniq >; +use File::Slurper qw< read_lines >; +use Getopt::Long; + +no warnings 'uninitialized'; + +my %o = (dict => '../../../data/dictionary.txt', min => 4); +GetOptions(\%o, qw< dict=s min=i >) + or die "Usage: $0 [--dict=path/to/dict.txt]\n"; + +my @words = grep { $o{min} < length } read_lines($o{dict}); + +my @pangram = pangram(@words); + +printf "Pangram is %d words / %d letters long \n\n%s\n", + scalar(@pangram), length("@pangram"), "@pangram"; + +# Greedy pangram generator. At every step, looks for the word that +# maximizes new_letters * 2 - word_length. +sub pangram { + my @pangram; # Pangram gets built here + my %has; + + # Trade some space for time + my %words = map { $_ => [ uniq split // ] } @_; + + while (keys %has < 26) { + my %best = (word => undef, score => -26); + + for my $word (keys %words) { + my $new = grep { !$has{$_} } @{$words{$word}}; + if ($new == 0) { + delete $words{$word}; + next; + } + + my $score = $new * 2 - length; + %best = (word => $word, score => $score) + if $score > $best{score}; + } + + # Put the best word in the @pangram + push @pangram, $best{word}; + $has{$_} = 1 for @{$words{$best{word}}}; + } + + @pangram; +} |