Perl Weekly Challenge 112.
My solutions (task 1, task 2, task 2a and task 2b) to the The Weekly Challenge - 112.
Task 1: Canonical Path
Submitted by: Mohammad S Anwar
You are given a string path, starting with a slash ‘/'.
Write a script to convert the given absolute path to the
simplified canonical path.
In a Unix-style file system:
- A period '.' refers to the current directory
- A double period '..' refers to the directory up a level
- Multiple consecutive slashes ('//') are treated as a
single slash '/'
The canonical path format:
- The path starts with a single slash '/'.
- Any two directories are separated by a single slash '/'.
- The path does not end with a trailing '/'.
- The path only contains the directories on the path from
the root directory to the target file or directory
Example
Input: "/a/"
Output: "/a"
Input: "/a/b//c/"
Output: "/a/b/c"
Input: "/a/b/c/../.."
Output: "/a"
For this task I repeatedly apply substitutions to simplify the path, until it doesn’t change anymore.
# Perl weekly challenge 112
# Task 1: Canonical path
#
# See https://wlmb.github.io/2021/05/12/PWC112/#task-1-canonical-path
use strict;
use warnings;
use v5.12;
use Cwd qw(cwd);
my $cwd=cwd; # Current working directory, for relative paths
for my $input(@ARGV){ #provide paths in @ARGV
my $path=$input;
$path = "$cwd/$path" unless $path=~m{^/}; # relative -> absolute path
$path.="/"; #add temporal trailing slash as guard
while($path=~s{//}{/}){}; # remove all //
while($path=~s{/\./}{/}){}; # remove all /.
while($path=~s{/[^/]+?/\.\./}{/}){}; # remove all /dir/..
while($path=~s{^/(\.\./)+}{/}){}; # remove all leading /..
$path=~s{^(/.*)/$}{$1}; # remove trailing / if not first
say "Input: $input Output: $path";
}
Example:
./ch-1.pl /a/ /a/b//c/ /a/b/c/../..
Results:
Input: /a/ Output: /a
Input: /a/b//c/ Output: /a/b/c
Input: /a/b/c/../.. Output: /a
More contrived examples: parent of root directory, files with dots, relative paths.
./ch-1.pl /../../.. /.file /file. /..file /file.. ../../../../../../../../file/
Results:
Input: /../../.. Output: /
Input: /.file Output: /.file
Input: /file. Output: /file.
Input: /..file Output: /..file
Input: /file.. Output: /file..
Input: ../../../../../../../../file/ Output: /home/mochan/file
Task 2: Climb Stairs
Submitted by: Mohammad S Anwar
You are given $n steps to climb
Write a script to find out the distinct ways to climb to the
top. You are allowed to climb either 1 or 2 steps at a time.
Example
Input: $n = 3
Output: 3
Option 1: 1 step + 1 step + 1 step
Option 2: 1 step + 2 steps
Option 3: 2 steps + 1 step
Input: $n = 4
Output: 5
Option 1: 1 step + 1 step + 1 step + 1 step
Option 2: 1 step + 1 step + 2 steps
Option 3: 2 steps + 1 step + 1 step
Option 4: 1 step + 2 steps + 1 step
Option 5: 2 steps + 2 steps
Consider choosing $n1 single steps and $n2 double steps. Then
$n==$n1+2*$n2, and $n2 can take any value from 0 up
to $n/2. For each value of $n2 I can reorder the steps
arbitrarily, but permuting two single steps or two double steps has no
effect. Thus, the total number of distinct ways to climb is
factorial($n1+$n2)/(factorial($n1)*factorial($n2) summed over all
possible values of $n2, where factorial($x) is the factorial
function that yields the total number of possible orderings of $x
objects.
# Perl weekly challenge 112
# Task 2: Climb stairs. Count ways.
#
# See https://wlmb.github.io/2021/05/12/PWC112/#task-2-climb-stairs
use strict;
use warnings;
use v5.12;
use Memoize;
foreach my $n(@ARGV){ # Number of steps from @ARGV
my $ways=0;
foreach my $n2(0..$n/2){
my $n1=$n-2*$n2;
$ways+=factorial($n1+$n2)/(factorial($n1)*factorial($n2));
}
say "Input: $n Output: $ways";
}
For the factorial I use a simple memoized recursive implementation.
memoize('factorial');
sub factorial {
my $x=shift @_; #assume non-negative integer
return 1 if $x==0 or $x==1;
return $x*factorial($x-1);
}
Example:
./ch-2.pl `seq 10`
Results:
Input: 1 Output: 1
Input: 2 Output: 2
Input: 3 Output: 3
Input: 4 Output: 5
Input: 5 Output: 8
Input: 6 Output: 13
Input: 7 Output: 21
Input: 8 Output: 34
Input: 9 Output: 55
Input: 10 Output: 89
One has to be aware that the factorial function grows very fast, so the
simple program above may fail due to integer overflow for relatively
small numbers. It could be fixed by using bigint, or approximate
solutions could be obtained by replacing the factorials by the
logarithm of the gamma function (available for example in PDL), replacing the divisions by
substractions and taking the exponential of the result.
It could be of interest to actually produce all the sequences of
steps. To that end I use a combinator-iterator that yields all
combinations of $n bits that has $k ones. The iterator is quite
dumb. It looks at all $n bit numbers and filters out those that don’t
have the correct number of ones. Then I interpret each 1 as a single
and each 0 as a double step.
# Perl weekly challenge 112
# Task 2: Climb stairs. List ways.
#
# See https://wlmb.github.io/2021/05/12/PWC112/#task-2-climb-stairs
use strict;
use warnings;
use v5.12;
use List::Util qw(sum0);
foreach my $n(@ARGV){ # Number of steps from @ARGV
say "\nInput: $n\nCombinations:";
foreach my $n2(0..$n/2){
my $n1=$n-2*$n2;
my $total=$n1+$n2;
my $combinator=combinator($total, $n1);
while(my @combination=$combinator->()){
say join ",", map {$_==0?"double":"single"} @combination;
}
}
}
sub combinator { # produces combinations of n taken k at a time
my ($n,$k)=@_;
my @number=((1) x $k, (0) x ($n-$k)); # binary $n-bit number as array
my $done=0;
my $iter=0;
sub { #dumb but simple
return if $done;
return @number if $iter++==0; #first time through
while(increment(@number)){
return @number if sum0(@number)==$k;
}
$done=1;
return;
}
}
sub increment {
$_[0]++; #use @_ directly to modify it
for(0..@_-2){
return @_ if $_[$_] < 2;
$_[$_]=0; #carry to next digit
++$_[$_+1];
}
return @_ if $_[-1] < 2;
}
Example:
./ch-2a.pl `seq 7`
Results:
Input: 1
Combinations:
single
Input: 2
Combinations:
single,single
double
Input: 3
Combinations:
single,single,single
single,double
double,single
Input: 4
Combinations:
single,single,single,single
single,single,double
single,double,single
double,single,single
double,double
Input: 5
Combinations:
single,single,single,single,single
single,single,single,double
single,single,double,single
single,double,single,single
double,single,single,single
single,double,double
double,single,double
double,double,single
Input: 6
Combinations:
single,single,single,single,single,single
single,single,single,single,double
single,single,single,double,single
single,single,double,single,single
single,double,single,single,single
double,single,single,single,single
single,single,double,double
single,double,single,double
double,single,single,double
single,double,double,single
double,single,double,single
double,double,single,single
double,double,double
Input: 7
Combinations:
single,single,single,single,single,single,single
single,single,single,single,single,double
single,single,single,single,double,single
single,single,single,double,single,single
single,single,double,single,single,single
single,double,single,single,single,single
double,single,single,single,single,single
single,single,single,double,double
single,single,double,single,double
single,double,single,single,double
double,single,single,single,double
single,single,double,double,single
single,double,single,double,single
double,single,single,double,single
single,double,double,single,single
double,single,double,single,single
double,double,single,single,single
single,double,double,double
double,single,double,double
double,double,single,double
double,double,double,single
I didn’t like too much generating all $n bit numbers and choosing
those that have $k ones, as it throws away most of them. Better to
only generate numbers with the expected number of bits. Thus, I
changed the combinator. Here, I start with the sequence 1111...0000
with the desired number of ones and zeroes. At every step, I change
the leftmost subsequence 10 to 01 (advance the less significant
bit that can advance) and restart all the bits to its left to a
compact sub-block of only ones followed by only zeroes 11..00. Thus assuming the leftmost bit is
the less significant, I produce in numerical sequence all $n bit
numbers with exactly $k ones.
# Perl weekly challenge 112
# Task 2: Climb stairs. List ways, second version.
#
# See https://wlmb.github.io/2021/05/12/PWC112/#task-2-climb-stairs
use strict;
use warnings;
use v5.12;
use List::Util qw(sum0 first);
foreach my $n(@ARGV){ # Number of steps from @ARGV
say "\nInput: $n\nCombinations:";
foreach my $n2(0..$n/2){
my $n1=$n-2*$n2;
my $total=$n1+$n2;
my $combinator=combinator($total, $n1);
while(my @combination=$combinator->()){
say join ",", map {$_==0?"double":"single"} @combination;
}
}
}
sub combinator { # produces combinations of n taken k at a time
my ($n,$k)=@_;
my @number=((1) x $k, (0) x ($n-$k)); # binary $n-bit number as array
my $done=0;
my $iter=0;
sub {
return if $done;
return @number if $iter++==0; #first time through
@number=following(@number);
return @number if @number;
$done=1;
return;
}
}
sub following {
my @number=@_;
my $first_10=first {$number[$_]==1 && $number[$_+1]==0} (0..@number-2);
return unless defined $first_10;
@number[$first_10, $first_10+1]=(0,1);
restart (@number[0..$first_10-1]);
return @number;
}
sub restart {
return unless @_;
my $ones=sum0 @_;
@_[0..$ones-1]=(1)x$ones;
@_[$ones..@_-1]=(0)x(@_-$ones);
}
Example:
./ch-2b.pl `seq 7`
Results:
Input: 1
Combinations:
single
Input: 2
Combinations:
single,single
double
Input: 3
Combinations:
single,single,single
single,double
double,single
Input: 4
Combinations:
single,single,single,single
single,single,double
single,double,single
double,single,single
double,double
Input: 5
Combinations:
single,single,single,single,single
single,single,single,double
single,single,double,single
single,double,single,single
double,single,single,single
single,double,double
double,single,double
double,double,single
Input: 6
Combinations:
single,single,single,single,single,single
single,single,single,single,double
single,single,single,double,single
single,single,double,single,single
single,double,single,single,single
double,single,single,single,single
single,single,double,double
single,double,single,double
double,single,single,double
single,double,double,single
double,single,double,single
double,double,single,single
double,double,double
Input: 7
Combinations:
single,single,single,single,single,single,single
single,single,single,single,single,double
single,single,single,single,double,single
single,single,single,double,single,single
single,single,double,single,single,single
single,double,single,single,single,single
double,single,single,single,single,single
single,single,single,double,double
single,single,double,single,double
single,double,single,single,double
double,single,single,single,double
single,single,double,double,single
single,double,single,double,single
double,single,single,double,single
single,double,double,single,single
double,single,double,single,single
double,double,single,single,single
single,double,double,double
double,single,double,double
double,double,single,double
double,double,double,single
I realize that before the first 1-0 I must have a single block of 1’s, or a block of only 0’s followed by a block of only 1’s. Maybe it helps to optimize the program.
# Perl weekly challenge 112
# Task 2: Climb stairs. List ways, third version.
#
# See https://wlmb.github.io/2021/05/12/PWC112/#task-2-climb-stairs
use strict;
use warnings;
use v5.12;
use List::Util qw(min first);
foreach my $n(@ARGV){ # Number of steps from @ARGV
say "\nInput: $n\nCombinations:";
foreach my $n2(0..$n/2){
my $n1=$n-2*$n2;
my $total=$n1+$n2;
my $combinator=combinator($total, $n1);
while(my @combination=$combinator->()){
say join ",", map {$_==0?"double":"single"} @combination;
}
}
}
sub combinator { # produces combinations of n taken k at a time
my ($n,$k)=@_;
my @number=((1) x $k, (0) x ($n-$k)); # binary $n-bit number as array
my $done=0;
my $iter=0;
sub {
return if $done;
return @number if $iter++==0; #first time through
@number=following(@number);
return @number if @number;
$done=1;
return;
}
}
sub following {
my @number=@_;
my $zeroes = my $first_1=first {$number[$_]==1} (0..@number-1);
return unless defined $first_1; # 000...000
my $first_10=(first {$number[$_]==0} ($first_1+1..@number-1));
return unless defined $first_10; # 000...111
@number[$first_10-1,$first_10]=(0,1); # advance;xs
my $ones = $first_10-1-$first_1;
my $change=min($zeroes, $ones); # number of bits to change
@number[0..$change-1,$first_10-1-$change..$first_10-2]=((1)x$change, (0)x $change);
return @number;
}
I checked that the results are the same. I timed the different programs.
time (./ch-2a.pl `seq 25` >/dev/null) 2>&1
time (./ch-2b.pl `seq 25` >/dev/null) 2>&1
time (./ch-2c.pl `seq 25` >/dev/null) 2>&1
Results:
real 0m28.419s
user 0m28.405s
sys 0m0.011s
real 0m2.021s
user 0m2.020s
sys 0m0.000s
real 0m2.175s
user 0m2.170s
sys 0m0.004s
Clearly, the first attempt is the worst. Nevertheless, it seems that the last attempt is not better than the second.