Merge pull request #12061 from wanderdoc/master

PWC 322 (wanderdoc)

2 files changed, 138 insertions, 0 deletions

diff --git a/challenge-322/wanderdoc/perl/ch-1.pl b/challenge-322/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..dbbc169ee6
--- /dev/null
+++ b/challenge-322/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,76 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given a string and a positive integer.
+
+Write a script to format the string, removing any dashes, in groups of size given by the integer. The first group can be smaller than the integer but should have at least one character. Groups should be separated by dashes.
+
+Example 1
+
+Input: $str = "ABC-D-E-F", $i = 3
+Output: "ABC-DEF"
+
+
+Example 2
+
+Input: $str = "A-BC-D-E", $i = 2
+Output: "A-BC-DE"
+
+
+Example 3
+
+Input: $str = "-A-B-CD-E", $i = 4
+Output: "A-BCDE"
+=cut
+
+
+use Test2::V0 -no_srand => 1;
+
+is(format_string("ABC-D-E-F", 3), "ABC-DEF", "Example 1");
+is(format_string("A-BC-D-E",  2), "A-BC-DE", "Example 2");
+is(format_string("-A-B-CD-E", 4), "A-BCDE",  "Example 3");
+done_testing();
+
+sub format_string
+{
+     my ($str, $i) = @_;
+     $str =~ s/^\-//;
+     $str = reverse $str;
+     $str =~ s/^\-//;
+     my (@output, @group);
+     my @source = split(//, $str);
+     for my $idx ( 0 .. $#source )
+     {
+          my $chr = $source[$idx];
+          if ( scalar @group < $i )
+          {
+               if ( $chr ne '-' )
+               {
+                    push @group, $chr;
+                    if ( $idx == $#source )
+                    {
+                         push @output, @group;
+                    }
+               }
+          }
+          elsif ( scalar @group == $i )
+          {
+               if ( $chr eq '-' )
+               {
+                    push @group, $chr;
+                    push @output, @group;
+                    @group = ();
+               }
+               else # not defined: what if the group length in source is bigger than $i?
+               {
+                    push @group, '-'; # however in this case one could simply
+                                      # strip all the dashes and add them as necessary.
+                    push @output, @group;
+                    @group = ($chr);
+               }
+          }
+     }
+     return reverse join('',@output)
+}
diff --git a/challenge-322/wanderdoc/perl/ch-2.pl b/challenge-322/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..8d1f961117
--- /dev/null
+++ b/challenge-322/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,62 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given an array of integers.
+Write a script to return an array of the ranks of each element: the lowest value has rank 1, next lowest rank 2, etc. If two elements are the same then they share the same rank.
+
+Example 1
+
+Input: @ints = (55, 22, 44, 33)
+Output: (4, 1, 3, 2)
+
+
+Example 2
+
+Input: @ints = (10, 10, 10)
+Output: (1, 1, 1)
+
+
+Example 3
+
+Input: @ints = (5, 1, 1, 4, 3)
+Output: (4, 1, 1, 3, 2)
+=cut
+
+use Test2::V0 -no_srand => 1;
+
+is(rank_array(55, 22, 44, 33), [4, 1, 3, 2], 'Example 1');
+is(rank_array(10, 10, 10), [1, 1, 1], 'Example 2');
+is(rank_array(5, 1, 1, 4, 3), [4, 1, 1, 3, 2], 'Example 3');
+done_testing();
+
+sub rank_array
+{
+     my @arr = @_;
+     my @ranks;
+     for my $idx ( 0 .. $#arr )
+     {
+          push @ranks, {val => $arr[$idx], idx => $idx};
+     }
+     @ranks = sort {$a->{val} <=> $b->{val}} @ranks;
+     my $rank_counter = 1;
+     for my $j (0 .. $#ranks) 
+     {
+          if ( $j == 0 )
+          {
+               $ranks[$j]->{rank} = $rank_counter;
+          }
+          elsif ( $ranks[$j]->{val} == $ranks[$j - 1]->{val} )
+          {
+               $ranks[$j]->{rank} = $rank_counter;
+          }
+          elsif ( $ranks[$j]->{val} != $ranks[$j - 1]->{val} )
+          {
+               $rank_counter++;
+               $ranks[$j]->{rank} = $rank_counter;
+          }
+     }
+     @ranks = sort {$a->{idx} <=> $b->{idx}} @ranks;
+     return [map { $_->{rank} } @ranks];
+}