Merge pull request #11893 from kjetillll/challenge-317-kjetillll

https://theweeklychallenge.org/blog/perl-weekly-challenge-317/

2 files changed, 59 insertions, 0 deletions

diff --git a/challenge-317/kjetillll/perl/ch-1.pl b/challenge-317/kjetillll/perl/ch-1.pl
new file mode 100644
index 0000000000..155de6d12f
--- /dev/null
+++ b/challenge-317/kjetillll/perl/ch-1.pl
@@ -0,0 +1,5 @@
+sub f {  pop() eq join('', map substr($_,0,1), @_) }
+
+print f( "Perl", "Weekly", "Challenge",  "PWC" ) ? "ok\n" : "error\n";  #true
+print f( "Bob", "Charlie", "Joe",        "BCJ" ) ? "ok\n" : "error\n";  #true
+print f( "Morning", "Good",              "MM"  ) ? "error\n" : "ok\n";  #false
diff --git a/challenge-317/kjetillll/perl/ch-2.pl b/challenge-317/kjetillll/perl/ch-2.pl
new file mode 100644
index 0000000000..4360f6b2e4
--- /dev/null
+++ b/challenge-317/kjetillll/perl/ch-2.pl
@@ -0,0 +1,54 @@
+sub f { join( '', sort split//, pop ) eq
+        join( '', sort split//, pop )    }
+
+print f( "desc",   "dsec"   ) ? "ok\n" : "error\n";  # true
+print f( "duck",   "dcuk"   ) ? "ok\n" : "error\n";  # true
+print f( "poo",    "eop"    ) ? "error\n" : "ok\n";  # false
+print f( "stripe", "sprite" ) ? "ok\n" : "error\n";  # true
+
+
+=pod
+
+For long inputs the sorting in   sub f   is sub-optimal.
+
+Sorting makes this a   O( n * log n )   solution.
+
+For long inputs a faster solution in linear time:   O( n )   is counting the
+frequency of each letter and then compare the counts like in   sub f2   below.
+
+The break even according to the benchmarks at the bottom are around 100 chars.
+When the strings become longer than that the   sub f2   without sorting becomes
+faster. And much faster for very long inputs.
+
+=cut
+
+sub f2 {
+    my %freq1; $freq1{$_}++ for split//, shift;
+    my %freq2; $freq2{$_}++ for split//, shift;
+    return 0 if 0+keys(%freq1) != 0+keys(%freq2);
+    for( keys %freq1 ){
+	return 0 if $freq1{$_} != $freq2{$_};
+    }
+    return 1
+}
+
+print f2( "desc",   "dsec"   ) ? "ok\n" : "error\n";  # true
+print f2( "duck",   "dcuk"   ) ? "ok\n" : "error\n";  # true
+print f2( "poo",    "eop"    ) ? "error\n" : "ok\n";  # false
+print f2( "stripe", "sprite" ) ? "ok\n" : "error\n";  # true
+
+
+
+use Benchmark;
+use List::Util 'shuffle';
+for my $len ( 10, 30, 100, 300, 1e3, 1e4, 1e5, 1e6 ){
+    print "---------- len: $len\n";
+    my $a = join '', map ['a'..'z']->[rand(26)], 1 .. $len;
+    my $b = join '', shuffle split //, $a;
+    my $count = 3e6 / $len;
+    $count = 5 if $count < 5;
+    timethese($count, {
+	'f'  => sub { f($a,$b)  ? 1 : die },
+	'f2' => sub { f2($a,$b) ? 1 : die },
+	      });
+}