Merge branch 'manwar:master' into rogerbw-challenge-234

2 files changed, 86 insertions, 0 deletions

diff --git a/challenge-233/kjetillll/perl/ch-1.pl b/challenge-233/kjetillll/perl/ch-1.pl
new file mode 100644
index 0000000000..58c23dba0f
--- /dev/null
+++ b/challenge-233/kjetillll/perl/ch-1.pl
@@ -0,0 +1,51 @@
+# take words from command line arguments or use the test case here:
+
+my @words = @ARGV ? @ARGV: ("aba", "aabb", "abcd", "bac", "aabc");
+
+print number_of_pairs_of_similar_but_not_equal_words(@words);
+print "\n";
+
+
+sub number_of_pairs_of_similar_but_not_equal_words {
+    my $count = 0;
+    "@_" =~ /                            #regex searching all word pairs in stringified input words
+        (\b\w+\b)                        #word $1
+        .*
+        (\b\w+\b)                        #word $2
+        (??{                             #means execute and try to match againts regexp-part in last statement
+            $count++ if similar($1,$2);  #increase count if similar
+            "^";                         #keep searching for ^ (beginning, which wont be found) till all pairs done for
+        })
+    /x;                                  #/regex/ modifier x ignores spaces, newlines and #comments
+    $count;                              #return count
+}
+
+sub similar {
+    letters($_[0]) eq letters($_[1])   #similar
+    &&
+    $_[0] ne $_[1]                     #but not equal
+}
+
+
+#helper function/normalizer
+#returns string of distinct letters in alphabetical order
+#abba becomes ab and challenge becomes aceghln
+sub letters {
+    my %found;
+    for my $letter ( shift() =~ /[a-z]/gi ) {
+	$found{$letter}=1;
+    }
+    join '', sort keys %found;
+}
+
+__END__
+
+sub what_sane_people_would_do {
+   my $count = 1;
+   for my $f ( 0 .. $#_-1 ) {          #index first word in pair
+       for my $s ( $f+1 .. $#_ ) {     #index second word in pair
+	   $count++ if similar( $_[$f], $_[$s] );
+       }
+   }
+   return $count;
+}
diff --git a/challenge-233/kjetillll/perl/ch-2.pl b/challenge-233/kjetillll/perl/ch-2.pl
new file mode 100644
index 0000000000..1a7d6d7c58
--- /dev/null
+++ b/challenge-233/kjetillll/perl/ch-2.pl
@@ -0,0 +1,35 @@
+
+@ARGV ? print join(',', frequency_sort( @ARGV ))."\n"
+      : run_tests();
+
+sub frequency_sort {
+    my %freq;
+    $freq{$_}++ for @_;              #count the input ints
+    sort {                           #return sort of @_ by:
+	$freq{$a} <=> $freq{$b}      #increasing frequency
+	or                           #or
+	$b <=> $a                    #decreasing int
+    }
+    @_;
+}
+
+sub run_tests {
+    for(
+	{
+	    Input  => [1,1,2,2,2,3],
+	    Output => [3,1,1,2,2,2]
+	},
+	{
+	    Input  => [2,3,1,3,2],
+	    Output => [1,3,3,2,2]
+	},
+	{
+	    Input  => [-1,1,-6,4,5,-6,1,4,1],
+	    Output => [5,-1,4,4,-6,-6,1,1,1]
+	}
+    ){
+	my($input,$expected)=@$_{qw(Input Output)};
+	my @got = frequency_sort( @$input );
+	print "@got" eq "@$expected" ? 'ok' : '***ERROR', "\n";
+    }
+}