Challenge #74

2 files changed, 78 insertions, 0 deletions

diff --git a/challenge-074/dave-jacoby/perl/ch-1.pl b/challenge-074/dave-jacoby/perl/ch-1.pl
new file mode 100755
index 0000000000..e325d3ad96
--- /dev/null
+++ b/challenge-074/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures state };
+no warnings qw{ experimental };
+
+use List::Util qw{ first };
+use JSON;
+my $json = JSON->new->pretty->canonical;
+
+my @array;
+push @array, [ 1, 2, 2, 3, 2, 4, 2 ];
+push @array, [ 1, 3, 1, 2, 4, 5 ];
+
+for my $i (@array) {
+    my $output = majority_element( $i->@* );
+    print 'Input: @A = (';
+    print  join ', ', $i->@*;
+    say ')';
+    say qq{Output: $output};
+    say '';
+}
+
+sub majority_element ( @array ) {
+    my $floor = scalar @array / 2;
+    my %hash;
+    map { $hash{$_}++ } @array;
+
+    for my $k ( sort { $hash{$b} <=> $hash{$a} } keys %hash ) {
+        my $v = $hash{$k};
+        return $k if $v > $floor;
+    }
+
+    return -1;
+}
+
diff --git a/challenge-074/dave-jacoby/perl/ch-2.pl b/challenge-074/dave-jacoby/perl/ch-2.pl
new file mode 100755
index 0000000000..852fdbcd0c
--- /dev/null
+++ b/challenge-074/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,41 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures state };
+no warnings qw{ experimental };
+
+use List::Util qw{ first };
+use JSON;
+my $json = JSON->new->pretty->canonical;
+
+my @strings = qw{
+    ababc
+    xyzzyx
+};
+
+for my $string (@strings) {
+    my $output = fnr($string);
+    say qq{Input:   $string};
+    say qq{Output:  $output};
+    say '';
+}
+
+sub fnr ( $s ) {
+    my @output;
+    my @done;
+    for my $i ( 0 .. length $s ) {
+        my $l = substr( $s, $i, 1 );
+        push @done, $l;
+        my %hash;
+        map { $hash{$_}++ } @done;
+        my $o = '#';
+        for my $m ( reverse @done ) {
+            if ( $hash{$m} < 2 ) { $o = $m; last }
+        }
+        push @output, $o;
+
+    }
+    return join '', @output;
+    return uc $s;
+}