From 74550468c9d1f4905cc41d187b999840116b4816 Mon Sep 17 00:00:00 2001 From: Matthias Muth Date: Sun, 16 Apr 2023 10:56:25 +0200 Subject: Challenge 212 solutions in Perl by Matthias Muth --- challenge-212/matthias-muth/README.md | 2 +- challenge-212/matthias-muth/perl/ch-1.pl | 37 ++++++++++++++++++ challenge-212/matthias-muth/perl/ch-2.pl | 64 ++++++++++++++++++++++++++++++++ 3 files changed, 102 insertions(+), 1 deletion(-) create mode 100755 challenge-212/matthias-muth/perl/ch-1.pl create mode 100755 challenge-212/matthias-muth/perl/ch-2.pl diff --git a/challenge-212/matthias-muth/README.md b/challenge-212/matthias-muth/README.md index fe15f8d3d3..92c38a2191 100644 --- a/challenge-212/matthias-muth/README.md +++ b/challenge-212/matthias-muth/README.md @@ -1,4 +1,4 @@ -**Challenge 211 solutions in Perl by Matthias Muth** +**Challenge 212 solutions in Perl by Matthias Muth**
(no blog post this time...) diff --git a/challenge-212/matthias-muth/perl/ch-1.pl b/challenge-212/matthias-muth/perl/ch-1.pl new file mode 100755 index 0000000000..c4585b7002 --- /dev/null +++ b/challenge-212/matthias-muth/perl/ch-1.pl @@ -0,0 +1,37 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 212 Task 1: Jumping Letters +# +# Perl solution by Matthias Muth. +# + +use strict; +use warnings; + +sub jumping_letters { + my ( $word, $jump ) = @_; + + my $i = 0; + $word =~ s{([A-Z])|[a-z]}{ + my $base = ord( $1 ? 'A' : 'a' ); + chr( $base + ( ( ord( $& ) - $base ) + $jump->[$i++] ) % 26 ); + }eg; + return $word; +} + + +use Test::More; +use Data::Dump qw( pp ); + +do { + is jumping_letters( @{$_->{INPUT}} ), $_->{EXPECTED}, + "jumping_letters( " . pp( $_->{INPUT} ) . " ) == " . pp( $_->{EXPECTED} ); +} for ( + { INPUT => [ "Perl", [ 2,22,19,9 ] ], EXPECTED => "Raku" }, + { INPUT => [ "Raku", [ 24,4,7,17 ] ], EXPECTED => "Perl" }, +); + +done_testing; diff --git a/challenge-212/matthias-muth/perl/ch-2.pl b/challenge-212/matthias-muth/perl/ch-2.pl new file mode 100755 index 0000000000..9b5b26f2d0 --- /dev/null +++ b/challenge-212/matthias-muth/perl/ch-2.pl @@ -0,0 +1,64 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 212 Task 2: Rearrange Groups +# +# Perl solution by Matthias Muth. +# + +use strict; +use warnings; +use feature 'say'; + +use Data::Dump qw( pp ); +use List::Util qw( min ); + +sub rearrange_groups { + my ( $list, $size ) = @_; + my %available; + + return -1 + if @$list % $size != 0; + + $available{$_}++ + for @$list; + + my @groups; + while ( %available ) { + push @groups, []; + my $first_element = min( keys %available ); + for ( $first_element .. $first_element + $size - 1 ) { + return -1 + unless $available{$_}; + push @{$groups[-1]}, $_; + delete $available{$_} + if --$available{$_} == 0; + } + } + return \@groups; +} + +use Test::More; + +do { + is_deeply rearrange_groups( @{$_->{INPUT}} ), $_->{EXPECTED}, + "rearrange_groups(" . pp( @{$_->{INPUT}} ) + . ") == " . pp( $_->{EXPECTED} ); +} for ( + { TEST => "Example 1", + INPUT => [ [ 1,2,3,5,1,2,7,6,3 ], 3 ], + EXPECTED => [ [ 1,2,3 ], [ 1,2,3 ], [ 5,6,7 ] ] }, + { TEST => "Example 2", + INPUT => [ [ 1,2,3 ], 2 ], + EXPECTED => -1 }, + { TEST => "Example 3", + INPUT => [ [ 1,2,4,3,5,3 ], 3 ], + EXPECTED => [ [ 1,2,3 ], [ 3,4,5 ] ] }, + { TEST => "Example 4", + INPUT => [ [ 1,5,2,6,4,7 ], 3 ], + EXPECTED => -1 }, +); + +done_testing; -- cgit