aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJörg Sommrey <28217714+jo-37@users.noreply.github.com>2020-08-18 21:17:58 +0200
committerJörg Sommrey <28217714+jo-37@users.noreply.github.com>2020-08-18 21:17:58 +0200
commita3ec42c4beada6d969c26c863d914f1334795f36 (patch)
tree68ead201f375835ea2f9dfe76f111aada0063201
parentc81bbaaab14c1b99dcf68f5f9d1818e6295905a0 (diff)
parentb50a7169eea8dd1c8efb078f92f085bb5eb258b4 (diff)
downloadperlweeklychallenge-club-a3ec42c4beada6d969c26c863d914f1334795f36.tar.gz
perlweeklychallenge-club-a3ec42c4beada6d969c26c863d914f1334795f36.tar.bz2
perlweeklychallenge-club-a3ec42c4beada6d969c26c863d914f1334795f36.zip
Solutions to challenge 074
-rwxr-xr-xchallenge-074/jo-37/perl/ch-1.pl24
-rw-r--r--challenge-074/jo-37/perl/ch-2.pl53
2 files changed, 77 insertions, 0 deletions
diff --git a/challenge-074/jo-37/perl/ch-1.pl b/challenge-074/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..6e95824317
--- /dev/null
+++ b/challenge-074/jo-37/perl/ch-1.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+use v5.16;
+use Test2::V0;
+use warnings FATAL => 'all';
+
+use List::MoreUtils qw(frequency);
+use List::Util qw(pairfirst);
+use Math::Utils qw(floor);
+
+sub majority_element {
+
+ # As there can be at most one element with a frequency
+ # above floor(size_of_list / 2), only the first matching
+ # value/frequency-pair may have the result.
+ (pairfirst {$b > floor(@_ / 2)} frequency @_)[0] // -1;
+}
+
+is majority_element(1, 2, 2, 3, 2, 4, 2), 2, 'first example';
+is majority_element(1, 3, 1, 2, 4, 5), -1, 'second example';
+is majority_element(1, 2, 2, 3, 2, 4, 2, 1), -1, 'even sized list';
+is majority_element(0, 1, 0, 1, 0), 0, 'zero majority';
+
+done_testing;
diff --git a/challenge-074/jo-37/perl/ch-2.pl b/challenge-074/jo-37/perl/ch-2.pl
new file mode 100644
index 0000000000..8cbc7ae0b9
--- /dev/null
+++ b/challenge-074/jo-37/perl/ch-2.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+
+use v5.16;
+use Test2::V0;
+use warnings FATAL => 'all';
+
+use List::Util qw(first);
+
+# The description of the task and the given examples are - to my
+# understanding - not consistent.
+#
+# "Write a script to print the series of first non-repeating character
+# (left -> right) for the given string."
+#
+# Input: $S = 'ababc'
+# Output: 'abb#c'
+# Pass 1: "a", the FNR character is 'a'
+# Pass 2: "ab", the FNR character is 'b'
+#
+# The characters chosen in the examples are apparently the "first
+# non-repeating character (right -> left). I'd rather call this
+# the "last non-repeating" character (LNR).
+#
+# Maybe this little ambiguity is intentional. At least it adds a nice
+# new aspect. So this sub provides both variants.
+
+sub nr_char {
+ my @arr = split //, shift;
+ # mode: fnr or lnr
+ my $lnr = shift;
+ my (%freq, @head);
+
+ join '', map {
+ # While traversing the input string character-wise,
+ # count frequencies and collect the (reversed) head.
+ $freq{$_}++;
+
+ # Emulate unshift (lnr, reversed) or push (fnr, forward)
+ # to augment the head.
+ splice @head, $lnr ? 0 : @head, 0, $_;
+
+ # The first singleton character from the (reversed) head
+ # is the requested output character.
+ (first {$freq{$_} == 1} @head) // '#';
+ } @arr;
+}
+
+is nr_char('ababc', 1), 'abb#c', 'first example, lnr';
+is nr_char('xyzzyx', 1), 'xyzyx#', 'second example, lnr';
+is nr_char('ababc'), 'aab#c', 'first example, fnr';
+is nr_char('xyzzyx'), 'xxxxx#', 'second example, fnr';
+
+done_testing;