Merge pull request #181 from kianmeng/master

Challenge #009 C1 & C2 answers

2 files changed, 143 insertions, 0 deletions

diff --git a/challenge-009/kian-meng-ang/perl5/ch-1.pl b/challenge-009/kian-meng-ang/perl5/ch-1.pl
new file mode 100644
index 0000000000..11df083c0b
--- /dev/null
+++ b/challenge-009/kian-meng-ang/perl5/ch-1.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/env perl
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use constant MAX_DISTINCT_DIGITS => 5;
+
+my $n = 1;
+while ($n) {
+    my $square_number = $n ** 2;
+
+    # See https://www.perlmonks.org/?node_id=240191
+    my %digits;
+    @digits{ split '', $square_number } = ();
+
+    if (scalar keys %digits >= MAX_DISTINCT_DIGITS) {
+        say $square_number;
+        last;
+    }
+
+    $n++;
+}
+
+1;
+
+__END__
+$ perl ch1.pl
+12769
+
+# vi:et:sw=4 ts=4 ft=perl
diff --git a/challenge-009/kian-meng-ang/perl5/ch-2.pl b/challenge-009/kian-meng-ang/perl5/ch-2.pl
new file mode 100644
index 0000000000..e95147a7a5
--- /dev/null
+++ b/challenge-009/kian-meng-ang/perl5/ch-2.pl
@@ -0,0 +1,111 @@
+#!/usr/bin/env perl
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+MAIN: {
+    my $data = {
+        goldfish => 40,
+        bettas => 30,
+        guppes => 40,
+        angelfish => 50,
+    };
+
+    my $rank_standard = rank_standard($data);
+    my $rank_modified = rank_modified($data);
+    my $rank_densed = rank_densed($data);
+
+    my $header_format = q|%-15s%-10s%-10s%-10s%-10s|;
+    my @header_column = qw(name count standard modified densed);
+    say sprintf $header_format, @header_column;
+
+    my @skeys = reverse sort { $data->{$a} <=> $data->{$b} } (keys %{$data});
+    foreach my $name (@skeys) {
+        say sprintf $header_format,
+            $name,
+            $data->{$name},
+            $rank_standard->{$name}->{rank},
+            $rank_modified->{$name}->{rank},
+            $rank_densed->{$name}->{rank};
+    }
+}
+
+# Standard Ranking (1224): Items that compare equal receive the same ranking
+# number, and then a gap is left in the ranking numbers.
+sub rank_standard {
+    my ($data) = @_;
+
+    my ($data_by_group, $gkeys) = _group_and_sort_data($data);
+
+    my $ranked_data = {};
+    my $rank = 1;
+    foreach my $gkey (@{$gkeys}) {
+        foreach (@{$data_by_group->{$gkey}}) {
+            $ranked_data->{$_} = { value => $data->{$_}, rank => $rank }
+        }
+        $rank += scalar @{$data_by_group->{$gkey}};
+    }
+    return $ranked_data;
+}
+
+# Modified Ranking (1334): It is done by leaving the gaps in the ranking
+# numbers before the sets of equal-ranking items.
+sub rank_modified {
+    my ($data) = @_;
+
+    my ($data_by_group, $gkeys) = _group_and_sort_data($data);
+    my $ranked_data = {};
+    my $rank = 0;
+    foreach my $gkey (@{$gkeys}) {
+        $rank += scalar @{$data_by_group->{$gkey}};
+        foreach (@{$data_by_group->{$gkey}}) {
+            $ranked_data->{$_} = { value => $data->{$_}, rank => $rank }
+        }
+    }
+    return $ranked_data;
+}
+
+# Dense Ranking (1223): Items that compare equally receive the same ranking
+# number, and the next item(s) receive the immediately following ranking
+# number.
+sub rank_densed {
+    my ($data) = @_;
+
+    my ($data_by_group, $gkeys) = _group_and_sort_data($data);
+    my $ranked_data = {};
+    my $rank = 1;
+    foreach my $gkey (@{$gkeys}) {
+        foreach (@{$data_by_group->{$gkey}}) {
+            $ranked_data->{$_} = { value => $data->{$_}, rank => $rank }
+        }
+        $rank += 1;
+    }
+    return $ranked_data;
+}
+
+sub _group_and_sort_data {
+    my ($data) = @_;
+
+    my $data_by_group = {};
+    while ((my $k, my $v)= each %{$data}) {
+        push @{$data_by_group->{$v}}, $k;
+    }
+
+    my @gkeys = reverse sort { $a <=> $b } (keys %{$data_by_group});
+
+    return ($data_by_group, \@gkeys);
+}
+
+1;
+
+__END__
+$ perl ch-2.pl
+name           count     standard  modified  densed
+angelfish      50        1         1         1
+guppy          40        2         3         2
+goldfish       40        2         3         2
+bettas         30        4         4         3
+
+# vi:et:sw=4 ts=4 ft=perl