add solutions for week 228 in perl

2 files changed, 51 insertions, 0 deletions

diff --git a/challenge-228/steven-wilson/perl/ch-01.pl b/challenge-228/steven-wilson/perl/ch-01.pl
new file mode 100644
index 0000000000..dae4b4e6ba
--- /dev/null
+++ b/challenge-228/steven-wilson/perl/ch-01.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+
+use 5.12.0;
+use Test::More;
+
+cmp_ok( sum_unique( ( 2, 1, 3, 2 ) ), '==', 4,  "2 unique elements" );
+cmp_ok( sum_unique( ( 1, 1, 1, 1 ) ), '==', 0,  "0 unique elements" );
+cmp_ok( sum_unique( ( 2, 1, 3, 4 ) ), '==', 10, "all elements unique" );
+done_testing();
+
+sub sum_unique {
+    my @elements = @_;
+    my %element_count;
+    my $sum = 0;
+    for (@elements) {
+        $element_count{$_}++;
+    }
+    for ( keys %element_count ) {
+        if ( $element_count{$_} == 1 ) {
+            $sum += $_;
+        }
+    }
+    return $sum;
+}
diff --git a/challenge-228/steven-wilson/perl/ch-02.pl b/challenge-228/steven-wilson/perl/ch-02.pl
new file mode 100644
index 0000000000..2af5a79c64
--- /dev/null
+++ b/challenge-228/steven-wilson/perl/ch-02.pl
@@ -0,0 +1,27 @@
+#!/usr/bin/env perl
+
+use 5.12.0;
+use List::Util qw / min /;
+use Test::More;
+
+cmp_ok( empty_array( ( 3, 4, 2 ) ), '==', 5, "array out of order" );
+cmp_ok( empty_array( ( 1, 2, 3 ) ), '==', 3, "array accending order" );
+cmp_ok( empty_array( () ), '==', 0, "array empty" );
+done_testing();
+
+sub empty_array {
+    my @elements = @_;
+    my $ops      = 0;
+    while ( @elements ) {
+        if ( min(@elements) == $elements[0] ) {
+            shift @elements;
+            $ops++;
+        }
+        else {
+            my $element = shift @elements;
+            push @elements, $element;
+            $ops++;
+        }
+    }
+    return $ops;
+}