diff options
| -rw-r--r-- | challenge-190/polettix/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-190/polettix/blog1.txt | 1 | ||||
| -rw-r--r-- | challenge-190/polettix/perl/ch-1.pl | 11 | ||||
| -rw-r--r-- | challenge-190/polettix/perl/ch-2.pl | 74 | ||||
| -rw-r--r-- | challenge-190/polettix/raku/ch-1.raku | 11 | ||||
| -rw-r--r-- | challenge-190/polettix/raku/ch-2.raku | 39 |
6 files changed, 137 insertions, 0 deletions
diff --git a/challenge-190/polettix/blog.txt b/challenge-190/polettix/blog.txt new file mode 100644 index 0000000000..8072af5931 --- /dev/null +++ b/challenge-190/polettix/blog.txt @@ -0,0 +1 @@ +https://etoobusy.polettix.it/2022/11/10/pwc190-capital-detection/ diff --git a/challenge-190/polettix/blog1.txt b/challenge-190/polettix/blog1.txt new file mode 100644 index 0000000000..671f6953b0 --- /dev/null +++ b/challenge-190/polettix/blog1.txt @@ -0,0 +1 @@ +https://etoobusy.polettix.it/2022/11/11/pwc190-decoded-list/ diff --git a/challenge-190/polettix/perl/ch-1.pl b/challenge-190/polettix/perl/ch-1.pl new file mode 100644 index 0000000000..417611dec7 --- /dev/null +++ b/challenge-190/polettix/perl/ch-1.pl @@ -0,0 +1,11 @@ +#!/usr/bin/env perl +use v5.24; +use warnings; +use experimental 'signatures'; +no warnings 'experimental::signatures'; + +say capital_detection(shift // 'whatever'); + +sub capital_detection ($string) { + 0 + $string =~ m{\A(?:[a-z]*|[a-zA-Z][a-z]*|[A-Z]*)\z}mxs; +} diff --git a/challenge-190/polettix/perl/ch-2.pl b/challenge-190/polettix/perl/ch-2.pl new file mode 100644 index 0000000000..8a4e72e28d --- /dev/null +++ b/challenge-190/polettix/perl/ch-2.pl @@ -0,0 +1,74 @@ +#!/usr/bin/env perl +use v5.24; +use warnings; +use experimental 'signatures'; +no warnings 'experimental::signatures'; + +# finds all ways of getting items close or separated. Each run of the +# iterator provides an array reference with a grouping. +my $groups_it = all_consecutive_groupings_iterator(shift // '1115'); + +# filters and transforms groupings into a target string. Each run of the +# iterator provides back a valid target decoded string. +my $dl_it = decoded_list_iterator($groups_it); + +# expands an iterator in an array reference with all items +my $decoded_list = iterator_to_arrayref($dl_it); + +# print it out +say join ', ', $decoded_list->@*; + +sub iterator_to_arrayref ($it) { + my @retval; + while (my @stuff = $it->()) { push @retval, @stuff } + return \@retval; +} + +sub decoded_list_iterator ($groups_it) { + state $letter_at = [undef, 'A' .. 'Z']; # starting at 1 + return sub { + ARRANGEMENT: + while (my $arrangement = $groups_it->()) { + my @candidate = map { + next ARRANGEMENT if m{\A 0 }mxs; # nothing starting with 0 + next ARRANGEMENT if $_ > $letter_at->$#*; + $letter_at->[$_]; + } $arrangement->@*; + return join '', @candidate; + } + return; + } +} + +sub all_consecutive_groupings_iterator ($string) { + my @items = split m{}mxs, $string; + my $n = 2 ** $#items; + return sub { + return if --$n < 0; + my $code = sprintf '%b', $n; # decide which gets tied and which not + + # turn into spaces or empty strings (ties) + my @code = map { $_ ? ' ' : '' } split m{}mxs, $code; + unshift @code, '' while @code < $#items; + + # well... this can be enhanced a bit!!! + return [ split m{\s+}mxs, join '', zip_loose(\@items, \@code)->@* ]; + }; +} + +# merge two lists together, until *both* have been used completely +sub zip_loose ($As, $Bs) { + my ($Ai, $Bi) = (0, 0); + my @retval; + while ('necessary') { + my $Aok = ($Ai <= $As->$#*) ? 1 : 0; + my $Bok = ($Bi <= $Bs->$#*) ? 1 : 0; + last unless $Aok || $Bok; + my @chunk = ( + ($Aok ? $As->[$Ai++] : ()), + ($Bok ? $Bs->[$Bi++] : ()), + ); + push @retval, @chunk; + } + return \@retval; +} diff --git a/challenge-190/polettix/raku/ch-1.raku b/challenge-190/polettix/raku/ch-1.raku new file mode 100644 index 0000000000..828088d45c --- /dev/null +++ b/challenge-190/polettix/raku/ch-1.raku @@ -0,0 +1,11 @@ +#!/usr/bin/env raku +use v6; +sub MAIN ($s) { put capital-detection($s) } + +sub capital-detection ($string) { + ($string ~~ / + ^<[a..z]>*$ # lc + | ^<[a..z A..Z]><[a..z]>*$ # ucfirst + | ^<[A..Z]>*$/ # uc + ) ?? 1 !! 0; +} diff --git a/challenge-190/polettix/raku/ch-2.raku b/challenge-190/polettix/raku/ch-2.raku new file mode 100644 index 0000000000..d71141b599 --- /dev/null +++ b/challenge-190/polettix/raku/ch-2.raku @@ -0,0 +1,39 @@ +#!/usr/bin/env raku +use v6; +sub MAIN ($input = '1115') { decoded-list($input).join(', ').put } + +sub decoded-list ($encoded) { + my @atoms = $encoded.comb; + my $first = @atoms.shift; + my $n = 2 ** @atoms; + return gather while --$n >= 0 { + my @code = '%b'.sprintf($n).comb; + @code.unshift(0) while @code < @atoms; + @code.push(1); # final separator to close stuff + my @sequence; + my $current = $first; + for ^@code -> $i { + if @code[$i].Int > 0 { # separate, close and reopen if applicable + my $decoded = decode-item($current) or last; + @sequence.push: $decoded; + if $i <= @atoms.end { + $current = @atoms[$i]; + } + else { + take @sequence.join(''); + last; + } + } + else { # merge with previous + $current ~= @atoms[$i]; + } + } + }; +} + +sub decode-item ($item) { + state @letter-at = (Nil, 'A' .. 'Z').flat; + return if $item ~~ /^ 0/; # we consider this invalid + return if $item.Int > @letter-at.end; + return @letter-at[$item.Int]; +} |