Solve 280: Twice Appearance & Count Asterisks by E. Choroba

"Twice Appearance" has two interpretations, show and test solutions
for both.

2 files changed, 76 insertions, 0 deletions

diff --git a/challenge-280/e-choroba/perl/ch-1.pl b/challenge-280/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..a05f90ec81
--- /dev/null
+++ b/challenge-280/e-choroba/perl/ch-1.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+=head1 Two Interpretations
+
+There are two interpretations that both fit to the examples given:
+
+=over 4
+
+=item 1.
+
+The first character that appears for the second time is the answer.
+
+
+=item 2.
+
+The first character that appears for the second time B<and> doesn't appear any
+more times is the answer.
+
+=back
+
+=cut
+
+sub twice_appearance_1($str) {
+    my %tally;
+    for my $char (split //, $str) {
+        return $char if 2 == ++$tally{$char};
+    }
+    return ""
+}
+
+sub twice_appearance_2($str) {
+    my %tally;
+    my @order;
+    for my $char (split //, $str) {
+        push @order, $char if 2 == ++$tally{$char};
+    }
+    for my $char (@order) {
+        return $char if 2 == $tally{$char};
+    }
+    return ""
+}
+
+use Test::More tests => 2 * (3 + 2);
+
+my @interpretation = qw( a d );
+
+my $i = 0;
+for my $twice_appearance(*twice_appearance_1{CODE}, *twice_appearance_2{CODE}) {
+    is $twice_appearance->('acbddbca'), 'd', 'Example 1';
+    is $twice_appearance->('abccd'), 'c', 'Example 2';
+    is $twice_appearance->('abcdabbb'), 'a', 'Example 3';
+
+    is $twice_appearance->('abcd'), "", 'Naught';
+    is $twice_appearance->('abcdabcdabce'), $interpretation[$i++],
+        "Interpretation $i";
+}
diff --git a/challenge-280/e-choroba/perl/ch-2.pl b/challenge-280/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..e01cf940b8
--- /dev/null
+++ b/challenge-280/e-choroba/perl/ch-2.pl
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+sub count_asterisks($str) {
+    $str =~ s/\|[^|]*\|//g;
+    return $str =~ tr/*//
+}
+
+use Test::More tests => 3 + 1;
+
+is count_asterisks('p|*e*rl|w**e|*ekly|'), 2, 'Example 1';
+is count_asterisks('perl'), 0, 'Example 2';
+is count_asterisks('th|ewe|e**|k|l***ych|alleng|e'), 5, 'Example 3';
+
+is count_asterisks('p*rl|*'), 2, 'Final bar missing';