Merge pull request #3257 from pauloscustodio/009

Add Perl solution to challenge 009

4 files changed, 154 insertions, 0 deletions

diff --git a/challenge-009/paulo-custodio/README b/challenge-009/paulo-custodio/README
new file mode 100644
index 0000000000..87dc0b2fbd
--- /dev/null
+++ b/challenge-009/paulo-custodio/README
@@ -0,0 +1 @@
+Solution by Paulo Custodio
diff --git a/challenge-009/paulo-custodio/perl/ch-1.pl b/challenge-009/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..93dcf9620b
--- /dev/null
+++ b/challenge-009/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,27 @@
+#!/usr/bin/env perl
+
+# Challenge 009
+#
+# Challenge #1
+# Write a script that finds the first square number that has at least 5 distinct
+# digits. This was proposed by Laurent Rosenfeld.
+
+use strict;
+use warnings;
+use 5.030;
+
+sub num_diff_digits {
+	my($n) = @_;
+	my %digits;
+	while ($n > 0) {
+		my $digit = $n % 10;
+		$digits{$digit}++;
+		$n = int($n/10);
+	}
+	return scalar(keys %digits);
+}
+
+my $diff_digits = shift || 5;
+my $n = 1;
+$n++ while (num_diff_digits($n*$n) < $diff_digits);
+say $n*$n;
diff --git a/challenge-009/paulo-custodio/perl/ch-2.pl b/challenge-009/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..5736ea96cc
--- /dev/null
+++ b/challenge-009/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,94 @@
+#!/usr/bin/env perl
+
+# Challenge 009
+#
+# Challenge #2
+# Write a script to perform different types of ranking as described below:
+# 
+# 1. Standard Ranking (1224): Items that compare equal receive the same ranking
+#    number, and then a gap is left in the ranking numbers.
+# 2. Modified Ranking (1334): It is done by leaving the gaps in the ranking
+#    numbers before the sets of equal-ranking items.
+# 3. Dense Ranking    (1223): Items that compare equally receive the same
+#    ranking number, and the next item(s) receive the immediately following
+#    ranking number.
+
+use strict;
+use warnings;
+use 5.030;
+
+# in:  list of numbers
+# out: list of items with the same value reverse-ordered by value
+#	   each item is [index, value]
+sub rank_values {
+	my(@list) = @_;
+	my @sorted = reverse sort {$a->[1] <=> $b->[1]} 
+				 map {[$_, $list[$_]]} 0..$#list;
+	my @output;
+	while (@sorted) {
+		my @head;
+		my $first_value = $sorted[0][1];
+		while (@sorted && $sorted[0][1] == $first_value) {
+			push @head, shift @sorted;
+		}
+		push @output, \@head;
+	}
+	return @output;
+}
+
+# in:  list of numbers
+# out: corresponding list of ranking
+sub standard_ranking {
+	my(@list) = @_;
+	my @ranked = rank_values(@list);
+	my @ranks;
+	my $rank = 1;
+	while (@ranked) {
+		my @head = @{shift @ranked};
+		for (@head) {
+			$ranks[$_->[0]] = $rank;
+		}
+		$rank += @head;
+	}
+	return @ranks;
+}
+
+# in:  list of numbers
+# out: corresponding list of ranking
+sub modified_ranking {
+	my(@list) = @_;
+	my @ranked = rank_values(@list);
+	my @ranks;
+	my $rank = 1;
+	while (@ranked) {
+		my @head = @{shift @ranked};
+		$rank += @head - 1;
+		for (@head) {
+			$ranks[$_->[0]] = $rank;
+		}
+		$rank++;
+	}
+	return @ranks;
+}
+
+# in:  list of numbers
+# out: corresponding list of ranking
+sub dense_ranking {
+	my(@list) = @_;
+	my @ranked = rank_values(@list);
+	my @ranks;
+	my $rank = 1;
+	while (@ranked) {
+		my @head = @{shift @ranked};
+		for (@head) {
+			$ranks[$_->[0]] = $rank;
+		}
+		$rank++;
+	}
+	return @ranks;
+}
+
+say "Data:             ", join(", ", @ARGV);
+say "Standard ranking: ", join(", ", standard_ranking(@ARGV));
+say "Modified ranking: ", join(", ", modified_ranking(@ARGV));
+say "Dense ranking:    ", join(", ", dense_ranking(@ARGV));
diff --git a/challenge-009/paulo-custodio/test.pl b/challenge-009/paulo-custodio/test.pl
new file mode 100644
index 0000000000..4c38e4a5ac
--- /dev/null
+++ b/challenge-009/paulo-custodio/test.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use 5.030;
+use Test::More;
+
+is capture("perl perl/ch-1.pl 1"), "1\n";
+is capture("perl perl/ch-1.pl 2"), "16\n";
+is capture("perl perl/ch-1.pl 3"), "169\n";
+is capture("perl perl/ch-1.pl 4"), "1024\n";
+is capture("perl perl/ch-1.pl 5"), "12769\n";
+
+
+is capture("perl perl/ch-2.pl 2 3 1 4 2 2 1 0"), <<END;
+Data:             2, 3, 1, 4, 2, 2, 1, 0
+Standard ranking: 3, 2, 6, 1, 3, 3, 6, 8
+Modified ranking: 5, 2, 7, 1, 5, 5, 7, 8
+Dense ranking:    3, 2, 4, 1, 3, 3, 4, 5
+END
+
+
+done_testing;
+
+
+sub capture {
+	my($cmd) = @_;
+	my $out = `$cmd`;
+	$out =~ s/[ \r\t]*\n/\n/g;
+	return $out;
+}
+