Solve 081 (Common Base String & Frequency Sort) by E. Choroba

2 files changed, 57 insertions, 0 deletions

diff --git a/challenge-081/e-choroba/perl/ch-1.pl b/challenge-081/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..4ee58de55c
--- /dev/null
+++ b/challenge-081/e-choroba/perl/ch-1.pl
@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+sub common_base_string {
+    my ($s1, $s2) = @_;
+    ($s1, $s2) = ($s2, $s1) if length $s2 < length $s1;
+    my @r;
+    for my $d (1 .. length $s2) {
+        next unless 0 == length($s2) % $d;
+        my $part = substr $s2, 0, length($s2) / $d;
+        unshift @r, $part
+            if $s2 eq $part x $d
+            && $s1 =~ /^(?:$part)+$/;
+    }
+    return \@r
+}
+
+
+use Test::More tests => 4;
+
+is_deeply common_base_string('abcdabcd',
+                             'abcdabcdabcdabcd'),
+    ['abcd', 'abcdabcd'],
+    'Example 1';
+
+is_deeply common_base_string('aaa',
+                             'aa'),
+    ['a'],
+    'Example 2';
+
+is_deeply common_base_string('XXXX',
+                             'XXXX'),
+    ['X', 'XX', 'XXXX'],
+    'Same strings';
+
+is_deeply common_base_string('ABCD',
+                             'EF'),
+    [],
+    'No common string';
diff --git a/challenge-081/e-choroba/perl/ch-2.pl b/challenge-081/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..5cd6393c56
--- /dev/null
+++ b/challenge-081/e-choroba/perl/ch-2.pl
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+my %freq;
+while (<>) {
+    ++$freq{$_} for split ' ', s/'s|--|[."(),]+/ /gr;
+}
+
+my $previous = 0;
+my $eol = "";
+for my $word (sort { $freq{$a} <=> $freq{$b} || $a cmp $b } keys %freq) {
+    print "$eol", $previous = $freq{$word} unless $freq{$word} == $previous;
+    $eol = "\n";
+    print " $word";
+}
+print "\n";