From 2e12c850a19098123c635ccacfa30b69f6ba66dc Mon Sep 17 00:00:00 2001 From: Dave Jacoby Date: Mon, 7 Nov 2022 10:50:08 -0500 Subject: Challenge 190 --- challenge-190/dave-jacoby/perl/ch-1.pl | 22 +++++++++++++++++ challenge-190/dave-jacoby/perl/ch-2.pl | 43 ++++++++++++++++++++++++++++++++++ 2 files changed, 65 insertions(+) create mode 100644 challenge-190/dave-jacoby/perl/ch-1.pl create mode 100644 challenge-190/dave-jacoby/perl/ch-2.pl diff --git a/challenge-190/dave-jacoby/perl/ch-1.pl b/challenge-190/dave-jacoby/perl/ch-1.pl new file mode 100644 index 0000000000..9623b328ba --- /dev/null +++ b/challenge-190/dave-jacoby/perl/ch-1.pl @@ -0,0 +1,22 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use experimental qw{ fc say postderef signatures state }; + +my @input = qw( Perl TPF PyThon raku); + +for my $input (@input) { + my $output = capital_detect( $input ); + say <<"END"; + Input: \$s = '$input' + Output: $output +END +} + +sub capital_detect ( $input ) { + return 1 if $input eq uc $input; + return 1 if $input eq lc $input; + return 1 if $input eq ucfirst lc $input; + return 0; +} diff --git a/challenge-190/dave-jacoby/perl/ch-2.pl b/challenge-190/dave-jacoby/perl/ch-2.pl new file mode 100644 index 0000000000..f4a52f2e65 --- /dev/null +++ b/challenge-190/dave-jacoby/perl/ch-2.pl @@ -0,0 +1,43 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use experimental qw{ say postderef signatures state }; + +use List::Util qw{ uniq }; + +my @alphabet = ( '_', 'A' .. 'Z' ); +my %n2a = map { $_ => $alphabet[$_] } 1 .. 26; + +my @input = sort { $a <=> $b } qw( 1115 127 919 212 202 2112 ); +for my $i (@input) { + my @list = decoded_list($i); + my $list = join ', ', @list; + say <<"END"; + Input: \$s = $i + Output: $list +END +} + +sub decoded_list ( $input ) { + my @output; + my @list = _make_list($input); +OUTER: for my $x (@list) { + my @x = grep { /\d/ } split /\D+/, $x; + for my $y (@x) { next OUTER if !$n2a{$y} } + push @output, join '', map { $n2a{$_} } @x; + } + return uniq sort @output; +} + +sub _make_list ( $input, $string = '' ) { + if ( $input eq '' ) { + return ($string); + } + my $letter = substr( $input, 0, 1 ); + substr( $input, 0, 1 ) = ''; + my @output; + push @output, _make_list( $input, $string . $letter ); + push @output, _make_list( $input, $string . ' ' . $letter ); + return @output; +} -- cgit From d6d01468fd7a5647b9ba96ebf7a0157ff79f3352 Mon Sep 17 00:00:00 2001 From: Dave Jacoby Date: Sun, 20 Nov 2022 14:20:19 -0500 Subject: Challege 191 --- challenge-191/dave-jacoby/perl/ch-1.pl | 31 ++++++++++++ challenge-191/dave-jacoby/perl/ch-2.pl | 91 ++++++++++++++++++++++++++++++++++ 2 files changed, 122 insertions(+) create mode 100644 challenge-191/dave-jacoby/perl/ch-1.pl create mode 100644 challenge-191/dave-jacoby/perl/ch-2.pl diff --git a/challenge-191/dave-jacoby/perl/ch-1.pl b/challenge-191/dave-jacoby/perl/ch-1.pl new file mode 100644 index 0000000000..1b7728fd0d --- /dev/null +++ b/challenge-191/dave-jacoby/perl/ch-1.pl @@ -0,0 +1,31 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use experimental qw{ fc say postderef signatures state }; + +my @input = + ( [ 1, 2, 3, 4 ], [ 1, 2, 0, 5 ], [ 2, 6, 3, 1 ], [ 4, 5, 2, 3 ] ); + +for my $i (@input) { + my $input = join ', ', $i->@*; + my $output = twice_largest($i); + say <<"END"; + Input: \$s = ($input) + Output: $output +END +} + +sub twice_largest ( $input ) { + my @input = $input->@*; + for my $n ( @input ) { + my $c = 0; + my @array = grep { $_ != $n } @input; + for my $o (@array) { + next if $o == $n; + $c++ if $n >= 2 * $o; + } + return 1 if $c == 3; + } + return -1; +} diff --git a/challenge-191/dave-jacoby/perl/ch-2.pl b/challenge-191/dave-jacoby/perl/ch-2.pl new file mode 100644 index 0000000000..52989ce172 --- /dev/null +++ b/challenge-191/dave-jacoby/perl/ch-2.pl @@ -0,0 +1,91 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use experimental qw{ say postderef signatures state }; + +use Algorithm::Permute; +use List::Util qw{ uniq }; +# use Memoize; +# memoize('test'); + +# before Memoize: +# real 0m30.866s +# user 0m10.766s +# sys 0m1.016s + +# after Memoize: +# real 1m28.003s +# user 0m30.375s +# sys 0m1.672s + +# to check your work: https://oeis.org/A320843 + +my @input = 1 .. 15; +for my $i (@input) { + my @list = cute_list($i); + my $list = join ",\n\t", @list; + say <<"END"; + Input: \$s = $i + Output: $list +END +} + +sub cute_list ( $input ) { + my $n; + $n->@* = 1 .. $input; + my @output = permute($n); + return scalar grep { defined } @output; +} + +# this looks like a job for recursion! +sub permute ( $remaining, $numbers = [] ) { + state $hash; + my @output; + if ( !scalar $remaining->@* ) { + + # say join ' ', $numbers->@*; + return 1; + } + my $i = 1 + scalar $numbers->@*; + for my $r ( $remaining->@* ) { + next unless test( $i, $r ); + my $rremaining->@* = grep { $_ != $r } $remaining->@*; + my $nnumbers->@* = ( $numbers->@*, $r ); + push @output, permute( $rremaining, $nnumbers ); + } + return @output; +} + +sub test ( $i, $j ) { + ( $i, $j ) = sort $i, $j; + return 0 == $i % $j || 0 == $j % $i ? 1 : 0; +} + +# the call to pre-existing wheels is great. I hopped on the idea of +# having Algorithm::Permute take the wheel was powerful, but the problem +# is that it returns all the choices with no discernable order, so if you +# know, for example, that a value won't fit in the 2nd position, then you +# can eliminate every choice with that, turning this from an exponential +# problem into one that's much more solvable. + +# which is to say that this is correct but unneccessarily slow. +sub cute_list_slow ( $input ) { + my @output; + my @list = 1 .. $input; + my $p = Algorithm::Permute->new( \@list ); + while ( my @arr = $p->next ) { + my @copy = @arr; + unshift @arr, 0; + my $c = 0; + for my $i ( 1 .. -1 + scalar @arr ) { + my $j = $arr[$i]; + next unless 0 == $i % $j || 0 == $j % $i; + $c++; + } + push @output, join ', ', @copy if $c == $input; + } + return scalar @output; + return map { qq{[$_]} } sort @output; +} + -- cgit