summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGuillermo Ramos2019-07-01 13:53:37 +0200
committerGuillermo Ramos2019-07-01 13:53:37 +0200
commitd916ca90c354b29cc1b0953508e9601576a4fd1e (patch)
treef1997d85fb0736cfb0abdf4cb534f81df8220df3
parent85d335507fbb74df316bd5831e621e1a37884c35 (diff)
downloadperlweekly-d916ca90c354b29cc1b0953508e9601576a4fd1e.tar.gz
[all] Formatting, missing comments in header, etc
-rwxr-xr-x005/ch1.pl58
-rwxr-xr-x006/ch1.pl45
-rwxr-xr-x007/ch1.pl5
-rwxr-xr-x008/ch1.pl8
-rwxr-xr-x009/ch1.pl4
-rwxr-xr-x009/ch2.pl66
-rwxr-xr-x010/ch1.pl174
-rwxr-xr-x010/ch2.pl76
-rwxr-xr-x012/ch2.pl13
-rwxr-xr-x015/ch1.pl3
10 files changed, 249 insertions, 203 deletions
diff --git a/005/ch1.pl b/005/ch1.pl
index 1c3436f..aa06105 100755
--- a/005/ch1.pl
+++ b/005/ch1.pl
@@ -1,37 +1,41 @@
#!/usr/bin/env perl
+#
+# Write a program which prints out all anagrams for a given word. For more information about Anagram, please check this wikipedia page
+# (https://en.wikipedia.org/wiki/Anagram)
+################################################################################
use strict;
use warnings;
sub anagrams {
- # Tail-recursive with accumulator; iterate over the word accumulating the
- # anagrams that can be formed with the already-seen characters
- sub iter {
- # @acc contains the already computed anagrams
- my ($word, @acc) = @_;
- if (length($word) == 0) {
- # Finished consuming word -> return accumulator
- return @acc;
- } else {
- # Split the current word: first letter vs the rest
- my ($head, $tail) = $word =~ /^(.)(.*)$/;
- @_ = $tail; # Next word will be the tail of the previous one
- # Compute new anagrams by inserting the current letter in all the
- # positions of the previous anagrams
- foreach my $anagram (@acc) {
- for (my $i = 0; $i <= length($anagram); $i++) {
- push(@_, $anagram);
- substr($_[-1], $i, 0) = $head;
- }
- }
- goto &iter;
- }
- }
- iter(shift, (""));
+ # Tail-recursive with accumulator; iterate over the word accumulating the
+ # anagrams that can be formed with the already-seen characters
+ sub iter {
+ # @acc contains the already computed anagrams
+ my ($word, @acc) = @_;
+ if (length($word) == 0) {
+ # Finished consuming word -> return accumulator
+ return @acc;
+ } else {
+ # Split the current word: first letter vs the rest
+ my ($head, $tail) = $word =~ /^(.)(.*)$/;
+ @_ = $tail; # Next word will be the tail of the previous one
+ # Compute new anagrams by inserting the current letter in all the
+ # positions of the previous anagrams
+ foreach my $anagram (@acc) {
+ for (my $i = 0; $i <= length($anagram); $i++) {
+ push(@_, $anagram);
+ substr($_[-1], $i, 0) = $head;
+ }
+ }
+ goto &iter;
+ }
+ }
+ iter(shift, (""));
}
for (@ARGV) {
- for (anagrams($_)) {
- print $_, "\n";
- }
+ for (anagrams($_)) {
+ print $_, "\n";
+ }
}
diff --git a/006/ch1.pl b/006/ch1.pl
index 5ec9203..bac675c 100755
--- a/006/ch1.pl
+++ b/006/ch1.pl
@@ -1,34 +1,39 @@
#!/usr/bin/env perl
+#
+# Create a script which takes a list of numbers from command line and print the
+# same in the compact form. For example, if you pass “1,2,3,4,9,10,14,15,16”
+# then it should print the compact form like “1-4,9,10,14-16”
+################################################################################
use strict;
use warnings;
sub compact {
- my @ns = split(/,/, shift);
- my $from = my $to = shift @ns; # The first interval is the first number
- my @intervals;
+ my @ns = split(/,/, shift);
+ my $from = my $to = shift @ns; # The first interval is the first number
+ my @intervals;
- # Store the current interval ($from, $to) and advance to the next one
- my $save = sub {
- push(@intervals, $from == $to ? $from : "$from-$to");
- $from = $to = shift;
- };
+ # Store the current interval ($from, $to) and advance to the next one
+ my $save = sub {
+ push(@intervals, $from == $to ? $from : "$from-$to");
+ $from = $to = shift;
+ };
- # Iterate over the numbers, expanding the last interval or starting a new one
- foreach my $n (@ns) {
- if ($to == $n-1) {
- $to = $n;
- } else {
- &$save($n);
- }
- }
+ # Iterate over the numbers, expanding the last interval or starting a new one
+ foreach my $n (@ns) {
+ if ($to == $n-1) {
+ $to = $n;
+ } else {
+ &$save($n);
+ }
+ }
- # Store the last interval (except for empty input)
- &$save if defined $to;
+ # Store the last interval (except for empty input)
+ &$save if defined $to;
- return join(",", @intervals);
+ return join(",", @intervals);
}
foreach (@ARGV) {
- print compact($_), "\n";
+ print compact($_), "\n";
}
diff --git a/007/ch1.pl b/007/ch1.pl
index 8102da6..490ced4 100755
--- a/007/ch1.pl
+++ b/007/ch1.pl
@@ -1,4 +1,9 @@
#!/usr/bin/env perl
+#
+# Print all the niven numbers from 0 to 50 inclusive, each on their own line. A
+# niven number is a non-negative number that is divisible by the sum of its
+# digits
+################################################################################
use strict;
use warnings;
diff --git a/008/ch1.pl b/008/ch1.pl
index 81d590c..bbd1893 100755
--- a/008/ch1.pl
+++ b/008/ch1.pl
@@ -1,10 +1,14 @@
#!/usr/bin/env perl
+#
+# Write a script that computes the first five perfect numbers. A perfect number
+# is an integer that is the sum of its positive proper divisors (all divisors
+# except itself).
+# (https://en.wikipedia.org/wiki/Perfect_number)
+################################################################################
use strict;
use warnings;
-my @primes;
-
sub perfect {
my $sum = 0;
my $n = shift;
diff --git a/009/ch1.pl b/009/ch1.pl
index e98223d..12147ce 100755
--- a/009/ch1.pl
+++ b/009/ch1.pl
@@ -1,4 +1,8 @@
#!/usr/bin/env perl
+#
+# Write a script that finds the first square number that has at least 5 distinct
+# digits
+################################################################################
use strict;
use warnings;
diff --git a/009/ch2.pl b/009/ch2.pl
index 336dda0..d20def5 100755
--- a/009/ch2.pl
+++ b/009/ch2.pl
@@ -1,41 +1,53 @@
#!/usr/bin/env perl
+#
+# 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.
+#
+# (https://en.wikipedia.org/wiki/Ranking)
+##############################################################################
use strict;
use warnings;
sub rank {
- my $rank_type = shift;
- my @points = sort @_;
+ my $rank_type = shift;
+ my @points = sort @_;
- my %ranks;
- my $rank = $rank_type eq "modified" ? 0 : 1;
+ my %ranks;
+ my $rank = $rank_type eq "modified" ? 0 : 1;
- my $interval_begin = 0;
- my $i;
- for ($i = 0; $i < @points; $i++) {
- my $point = $points[$i];
- if ($point != $points[$interval_begin]) {
- my @points_to_add = @points[$interval_begin .. ($i-1)];
- $rank += @points_to_add if $rank_type eq "modified";
- $ranks{$rank} = \@points_to_add;
- if ($rank_type eq "standard") {
- $rank += @points_to_add;
- } elsif ($rank_type eq "dense") {
- $rank = $rank + 1;
- }
- $interval_begin = $i;
- }
- }
- my @points_to_add = @points[$interval_begin .. ($i-1)];
- $rank += @points_to_add if $rank_type eq "modified";
- $ranks{$rank} = \@points_to_add;
- return \%ranks;
+ my $interval_begin = 0;
+ my $i;
+ for ($i = 0; $i < @points; $i++) {
+ my $point = $points[$i];
+ if ($point != $points[$interval_begin]) {
+ my @points_to_add = @points[$interval_begin .. ($i-1)];
+ $rank += @points_to_add if $rank_type eq "modified";
+ $ranks{$rank} = \@points_to_add;
+ if ($rank_type eq "standard") {
+ $rank += @points_to_add;
+ } elsif ($rank_type eq "dense") {
+ $rank = $rank + 1;
+ }
+ $interval_begin = $i;
+ }
+ }
+ my @points_to_add = @points[$interval_begin .. ($i-1)];
+ $rank += @points_to_add if $rank_type eq "modified";
+ $ranks{$rank} = \@points_to_add;
+ return \%ranks;
}
# Get rank type and points as CLI arguments
my $rank_type = shift || "";
grep /^$rank_type$/, qw(modified standard dense)
- or die "Usage: $0 {modified, standard, dense} rank1 rank2 ...";
+ or die "Usage: $0 {modified, standard, dense} rank1 rank2 ...";
my @points = @ARGV;
# Compute rankings
@@ -43,6 +55,6 @@ my $ranks = rank($rank_type, @points);
# Display rankings
for my $rank (sort (keys %$ranks)) {
- my @positions = @{$ranks->{$rank}};
- print "$rank. @positions\n";
+ my @positions = @{$ranks->{$rank}};
+ print "$rank. @positions\n";
}
diff --git a/010/ch1.pl b/010/ch1.pl
index f2073ad..ad385d6 100755
--- a/010/ch1.pl
+++ b/010/ch1.pl
@@ -11,108 +11,108 @@ use warnings;
# CLI usage
sub usage {
- print "$0 {-e ARABIC | -d ROMAN | --test}\n";
- exit shift;
+ print "$0 {-e ARABIC | -d ROMAN | --test}\n";
+ exit shift;
}
usage -1 unless @ARGV > 0;
if ($ARGV[0] eq "--test") {
- test();
+ test();
} else {
- usage -1 unless @ARGV == 2;
- if ($ARGV[0] eq "-d") {
- print decode($ARGV[1]), "\n";
- } elsif ($ARGV[0] eq "-e") {
- print encode($ARGV[1]), "\n";
- } else {
- usage -1;
- }
+ usage -1 unless @ARGV == 2;
+ if ($ARGV[0] eq "-d") {
+ print decode($ARGV[1]), "\n";
+ } elsif ($ARGV[0] eq "-e") {
+ print encode($ARGV[1]), "\n";
+ } else {
+ usage -1;
+ }
}
# roman -> arabic
sub decode {
- my @roman = split //, shift;
-
- # Decimal value of each roman symbol
- my %dec = (
- M => 1000,
- D => 500,
- C => 100,
- L => 50,
- X => 10,
- V => 5,
- I => 1,
- );
- my $arabic = 0; # Return value
-
- # Iterate over roman symbols
- for (my $i = 0; $i < @roman; $i++) {
- # Get current and next symbols
- my ($currsym, $nextsym) = @roman[$i .. $i+1];
- my $val = $dec{$currsym};
-
- # Sub current value if next symbol is bigger; add it otherwise
- if (defined $nextsym && $val < $dec{$nextsym}) {
- $arabic -= $val;
- } else {
- $arabic += $val;
- }
- }
-
- return $arabic;
+ my @roman = split //, shift;
+
+ # Decimal value of each roman symbol
+ my %dec = (
+ M => 1000,
+ D => 500,
+ C => 100,
+ L => 50,
+ X => 10,
+ V => 5,
+ I => 1,
+ );
+ my $arabic = 0; # Return value
+
+ # Iterate over roman symbols
+ for (my $i = 0; $i < @roman; $i++) {
+ # Get current and next symbols
+ my ($currsym, $nextsym) = @roman[$i .. $i+1];
+ my $val = $dec{$currsym};
+
+ # Sub current value if next symbol is bigger; add it otherwise
+ if (defined $nextsym && $val < $dec{$nextsym}) {
+ $arabic -= $val;
+ } else {
+ $arabic += $val;
+ }
+ }
+
+ return $arabic;
}
# arabic -> roman
sub encode {
- die "ERROR: Unable to encode numbers bigger than 9999" if $_[0] > 9999;
-
- my @arabic = split //, shift;
-
- my @symbols = ("I", "V", "X", "L", "C", "D", "M");
- my @roman; # Return value (roman symbols)
-
- # Iterate arabic digits from right to left (upward units)
- for (my $i = $#arabic; $i >= 0; $i--) {
- my $digit = $arabic[$i];
-
- # Roman symbols corresponding to (1-5-10) given the current base
- my ($one, $five, $ten) = @symbols;
-
- # Roman symbols to add at the beginning of the current result
- my @to_add;
-
- # 4 and 9 are (5-1) and (10-1) respectively
- if ($one ne "M" && ($digit == 4 || $digit == 9)) {
- push @to_add, $one;
- $digit++;
- }
-
- # Add the roman equivalents to the current digit
- if ($one eq "M") {
- # For 4000-9999, just add as much M's as needed
- push @to_add, (map $one, (1..$digit));
- } elsif ($digit == 10) {
- push @to_add, $ten;
- } elsif ($digit > 4) {
- push @to_add, ($five, map $one, (6..$digit));
- } elsif ($digit > 0) {
- push @to_add, (map $one, (1..$digit));
- }
- unshift @roman, @to_add;
-
- # For the next decimal, discard two roman symbols (one + five)
- shift @symbols foreach (1..2);
- }
-
- return join "", @roman;
+ die "ERROR: Unable to encode numbers bigger than 9999" if $_[0] > 9999;
+
+ my @arabic = split //, shift;
+
+ my @symbols = ("I", "V", "X", "L", "C", "D", "M");
+ my @roman; # Return value (roman symbols)
+
+ # Iterate arabic digits from right to left (upward units)
+ for (my $i = $#arabic; $i >= 0; $i--) {
+ my $digit = $arabic[$i];
+
+ # Roman symbols corresponding to (1-5-10) given the current base
+ my ($one, $five, $ten) = @symbols;
+
+ # Roman symbols to add at the beginning of the current result
+ my @to_add;
+
+ # 4 and 9 are (5-1) and (10-1) respectively
+ if ($one ne "M" && ($digit == 4 || $digit == 9)) {
+ push @to_add, $one;
+ $digit++;
+ }
+
+ # Add the roman equivalents to the current digit
+ if ($one eq "M") {
+ # For 4000-9999, just add as much M's as needed
+ push @to_add, (map $one, (1..$digit));
+ } elsif ($digit == 10) {
+ push @to_add, $ten;
+ } elsif ($digit > 4) {
+ push @to_add, ($five, map $one, (6..$digit));
+ } elsif ($digit > 0) {
+ push @to_add, (map $one, (1..$digit));
+ }
+ unshift @roman, @to_add;
+
+ # For the next decimal, discard two roman symbols (one + five)
+ shift @symbols foreach (1..2);
+ }
+
+ return join "", @roman;
}
# Property:
# forall (x : Arabic). x == decode(encode(x))
sub test {
- foreach my $i (1..9999) {
- my $roman = encode($i);
- my $arabic = decode($roman);
- die "ERROR: $i -> $roman -> $arabic" if $i != $arabic;
- }
- print "Test successful\n";
+ foreach my $i (1..9999) {
+ my $roman = encode($i);
+ my $arabic = decode($roman);
+ die "ERROR: $i -> $roman -> $arabic" if $i != $arabic;
+ }
+ print "Test successful\n";
}
diff --git a/010/ch2.pl b/010/ch2.pl
index f0566df..a5a37f5 100755
--- a/010/ch2.pl
+++ b/010/ch2.pl
@@ -11,54 +11,54 @@ use warnings;
use List::Util qw<max min>;
sub jaro {
- my @s1 = split //, shift;
- my @s2 = split //, shift;
+ my @s1 = split //, shift;
+ my @s2 = split //, shift;
- # Two chars in s1 and s2 match if they are not farther away than this number
- my $match_dist = int(max (scalar @s1, scalar @s2) / 2)-1;
- $match_dist = 0 if $match_dist < 0;
+ # Two chars in s1 and s2 match if they are not farther away than this number
+ my $match_dist = int(max (scalar @s1, scalar @s2) / 2)-1;
+ $match_dist = 0 if $match_dist < 0;
- # Maps indices from s1 chars to matching s2 chars
- my %matches;
+ # Maps indices from s1 chars to matching s2 chars
+ my %matches;
- # Compute matches (fill the %matches hash)
- S1:
- foreach my $i (0 .. $#s1) {
- foreach my $j ($i-min($i, $match_dist) .. min($i+$match_dist, $#s2)) {
- # Skip s2 char if already matched
- next if grep(/$j/, values %matches);
+ # Compute matches (fill the %matches hash)
+ S1:
+ foreach my $i (0 .. $#s1) {
+ foreach my $j ($i-min($i, $match_dist) .. min($i+$match_dist, $#s2)) {
+ # Skip s2 char if already matched
+ next if grep(/$j/, values %matches);
- # If characters match, store match and advance to next char in s1
- if ($s1[$i] eq $s2[$j]) {
- $matches{$i} = $j;
- next S1;
- }
- }
- }
+ # If characters match, store match and advance to next char in s1
+ if ($s1[$i] eq $s2[$j]) {
+ $matches{$i} = $j;
+ next S1;
+ }
+ }
+ }
- # Count number of matches and exit if 0
- my $m = keys %matches;
- return 0 if $m == 0;
+ # Count number of matches and exit if 0
+ my $m = keys %matches;
+ return 0 if $m == 0;
- # Count transpositions
- my $t = 0;
- for my $k (keys %matches) {
- $t += 1 if $k != $matches{$k};
- }
+ # Count transpositions
+ my $t = 0;
+ for my $k (keys %matches) {
+ $t += 1 if $k != $matches{$k};
+ }
- # Finally compute and return Jaro distance
- return (($m/@s1) + ($m/@s2) + (($m-$t)/$m))/3;
+ # Finally compute and return Jaro distance
+ return (($m/@s1) + ($m/@s2) + (($m-$t)/$m))/3;
}
sub jaro_winkler {
- my ($s1, $s2) = @_;
- my $jarosim = jaro $s1, $s2;
- my $l;
- for ($l = 0; $l < length $s1; $l++) {
- last if (substr($s1, $l, 1) ne (substr $s2, $l, 1));
- }
- my $p = 0.1;
- return $jarosim + $l*$p*(1-$jarosim);
+ my ($s1, $s2) = @_;
+ my $jarosim = jaro $s1, $s2;
+ my $l;
+ for ($l = 0; $l < length $s1; $l++) {
+ last if (substr($s1, $l, 1) ne (substr $s2, $l, 1));
+ }
+ my $p = 0.1;
+ return $jarosim + $l*$p*(1-$jarosim);
}
die "Usage: $0 <s1> <s2>" unless @ARGV == 2;
diff --git a/012/ch2.pl b/012/ch2.pl
index ffd870c..3162569 100755
--- a/012/ch2.pl
+++ b/012/ch2.pl
@@ -1,4 +1,17 @@
#!/usr/bin/env perl
+#
+# Write a script that finds the common directory path, given a collection of
+# paths and directory separator. For example, if the following paths are
+# supplied
+#
+# /a/b/c/d
+# /a/b/cd
+# /a/b/cc
+# /a/b/c/d/e
+#
+# and the path separator is /. Your script should return /a/b as common
+# directory path.
+################################################################################
use strict;
use warnings;
diff --git a/015/ch1.pl b/015/ch1.pl
index c6cc4db..b5ea460 100755
--- a/015/ch1.pl
+++ b/015/ch1.pl
@@ -7,8 +7,7 @@
use strict;
use warnings;
-use List::Util qw<any>;
-use List::Util qw<max>;
+use List::Util qw<any max>;
my $LIMIT = 10;