diff options
| author | Jörg Sommrey <28217714+jo-37@users.noreply.github.com> | 2020-08-18 21:17:58 +0200 |
|---|---|---|
| committer | Jörg Sommrey <28217714+jo-37@users.noreply.github.com> | 2020-08-18 21:17:58 +0200 |
| commit | a3ec42c4beada6d969c26c863d914f1334795f36 (patch) | |
| tree | 68ead201f375835ea2f9dfe76f111aada0063201 | |
| parent | c81bbaaab14c1b99dcf68f5f9d1818e6295905a0 (diff) | |
| parent | b50a7169eea8dd1c8efb078f92f085bb5eb258b4 (diff) | |
| download | perlweeklychallenge-club-a3ec42c4beada6d969c26c863d914f1334795f36.tar.gz perlweeklychallenge-club-a3ec42c4beada6d969c26c863d914f1334795f36.tar.bz2 perlweeklychallenge-club-a3ec42c4beada6d969c26c863d914f1334795f36.zip | |
Solutions to challenge 074
| -rwxr-xr-x | challenge-074/jo-37/perl/ch-1.pl | 24 | ||||
| -rw-r--r-- | challenge-074/jo-37/perl/ch-2.pl | 53 |
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; |
