Perl Weekly Challenge 182.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 182.
Task 1: Max Index
Submitted by: Mohammad S Anwar
You are given a list of integers.
Write a script to find the index of the first biggest number in the
list.
Example
Input: @n = (5, 2, 9, 1, 7, 6)
Output: 2 (as 3rd element in the list is the biggest number)
Input: @n = (4, 2, 3, 1, 5, 0)
Output: 4 (as 5th element in the list is the biggest number)
The task is easily solved with the max and firstidx routines from
List::Util and List::MoreUtils.
perl -MList::Util=max -MList::MoreUtils=firstidx -E '
$m=max @ARGV; say firstidx {$_==$m} @ARGV;' 5 2 9 1 7 6
Results:
2
Another example:
perl -MList::Util=max -MList::MoreUtils=firstidx -E '
$m=max @ARGV; say firstidx {$_==$m} @ARGV;
' 4 2 3 1 5 0
Results:
4
The price to pay is to go twice through the list, once to get the maximum and the second to get its index. The full code is:
1 # Perl weekly challenge 182
2 # Task 1: Max Index
3 #
4 # See https://wlmb.github.io/2022/09/12/PWC182/#task-1-max-index
5 use v5.36;
6 use List::Util qw(max);
7 use List::MoreUtils qw(firstidx);
8 die "Usage: $0 N0 [N1...]\nto get index of maximum among N0, N1..."
9 unless @ARGV;
10 my $max=max(@ARGV);
11 my $index=firstidx {$_==$max} @ARGV;
12 say "The index of the biggest number in (", join(", ", @ARGV), ") is $index";
Examples:
./ch-1.pl 5 2 9 1 7 6
./ch-1.pl 4 2 3 1 5 0
Results:
The index of the biggest number in (5, 2, 9, 1, 7, 6) is 2
The index of the biggest number in (4, 2, 3, 1, 5, 0) is 4
Task 2: Common Path
Submitted by: Julien Fiegehenn
Given a list of absolute Linux file paths, determine the deepest path
to the directory that contains all of them.
Example
Input:
/a/b/c/1/x.pl
/a/b/c/d/e/2/x.pl
/a/b/c/d/3/x.pl
/a/b/c/4/x.pl
/a/b/c/d/5/x.pl
Ouput:
/a/b/c
I solve this task with a nice and dirty trick: I take advantage of
autovivification to create a hash of hashes of hashes isomorphous
to a directory structure. To that end, I convert a line such as
/a/b/c/1/x.pl to the line $f{r}{a}{b}{c}{1}//={}, i.e., ending
with an empty hash if not previously defined, and then I eval it,
neglecting all dangers. Then, the first
subhash to have more (or less) than one key corresponds to the deepest common
path. This can be programmed with a three-liner, using split and join to
transform the input line
perl -n -E '
@d=split "/";pop @d;shift @d;eval "\$f{".join("}{", "r", @d) . "}//={}"; END {$d=$f{r};
print "/"; while(1){@d=keys %$d; say(""), last unless @d==1;
print "@d/"; $d=$d->{"@d"}}}' <<EOF
/a/b/c/1/x.pl
/a/b/c/d/e/2/x.pl
/a/b/c/d/3/x.pl
/a/b/c/4/x.pl
/a/b/c/d/5/x.pl
EOF
Results:
/a/b/c/
Notice that I added a root directory "r" as a guard for the case when the
common path is only /. I added a trailing / missing from the examples,
so that it is clear that I only print directories, and to be able to
deal with the case where only the root directory is common.
A slightly shorter version may be written by using regular expressions:
perl -n -E '
s(/)(\$f{r/);s(/)(}{)g; s({[^{]*$)(//={}); eval;END {$d=$f{r}; print "/"; while(1){
@d=keys %$d; say(""), last unless @d==1; print "@d/"; $d=$d->{"@d"}}}
' <<EOF
/a/b/c/1/x.pl
/a/b/c/d/e/2/x.pl
/a/b/c/d/3/x.pl
/a/b/c/4/x.pl
/a/b/c/d/5/x.pl
EOF
Results:
/a/b/c/
I test it with a few edge cases. Only the root directory:
perl -n -E '
s(/)(\$f{r/);s(/)(}{)g; s({[^{]*$)(//=1); eval;END {$d=$f{r}; print "/"; while(1){
@d=keys %$d; say(""), last unless @d==1; print "@d/"; $d=$d->{"@d"}}}
' <<EOF
/
EOF
Results:
/
No common subdirectories:
perl -n -E '
s(/)(\$f{r/);s(/)(}{)g; s/{[^{]*$/=1/; eval;END {$d=$f{r}; print "/"; while(1){
@d=keys %$d; say(""), last unless @d==1; print "@d/"; $d=$d->{"@d"}}}
' <<EOF
/a/b/x.pl
/c/d/x.pl
EOF
Results:
/
So it seems to be working.
An alternative approach is to make an array of directories from the first input line and trim it to keep only those that are shared with subsequent lines. This also fits a 3-liner
perl -n -MList::Util=all -MList::MoreUtils=zip6 -E '
@p=split "/"; pop @p; $d=t($d, @p); END{say join("/", @$d), "/";}
BEGIN{sub t($p, @c){ $p=\@c unless defined $p; @n=map {$_->[0]} grep
{(all {defined} @$_) && $_->[0] eq $_->[1]} zip6 @$p, @c; return \@n;}}'<<EOF
/a/b/c/1/x.pl
/a/b/c/d/e/2/x.pl
/a/b/c/d/3/x.pl
/a/b/c/4/x.pl
/a/b/c/d/5/x.pl
EOF
Results:
/a/b/c/
The corresponding full code is:
1 # Perl weekly challenge 182
2 # Task 2: Common Path
3 #
4 # See https://wlmb.github.io/2022/09/12/PWC182/#task-2-common-path
5 use v5.36;
6 use List::Util qw(all);
7 use List::MoreUtils qw(zip6);
8 use Cwd qw(getcwd);
9 my $dirs;
10 while(<>){
11 canonical($_);
12 my @parts=split '/';
13 pop @parts; # remove non-directory or empty at end
14 $dirs=trim($dirs, @parts);
15 }
16 say join("/", @$dirs), "/";
17
18 sub canonical{
19 for($_[0]){ # localize $_
20 s{^\s*}{}; # remove leading space
21 s{^([^/])}{getcwd . "/$1"}e; # convert to absolute if relative
22 s{/\./}{/}g; # /a/./->/a/
23 1 while s{/[^/]*/\.\.(/|$)}{/}; # /a/b/../->/a/
24 s{/\.\.(/|$)}{/}g; # /..->/ at beginning
25 1 while s{//}{/}; # //->/
26 }
27 }
28
29 sub trim($previous, @current){
30 $previous=\@current unless defined $previous;
31 my @new=map {$_->[0]}
32 grep {(all {defined $_}(@$_)) && $_->[0] eq $_->[1]}
33 zip6 @$previous, @current;
34 return \@new;
35 }
36
I added a routine to convert the paths to a canonical form,
admitting relative paths and the special directories “.” and
“..”. There are packaged routines to do this, as abs_path in Cwd,
but they sometimes fail if the paths don’t correspond to actual files
in the filesystem. I use the actual filesystem only to produce
absolute from relative paths.
Example:
./ch-2.pl <<EOF
/a/b/c/1/x.pl
/a/b/c/d/e/2/x.pl
/a/b/c/d/3/x.pl
/a/b/c/4/x.pl
/a/b/c/d/5/x.pl
EOF
Results:
/a/b/c/
Other examples:
./ch-2.pl <<EOF
/a/b/x.pl
/c/d/e/2/x.pl
EOF
Results:
/
A couple of somewhat contrived examples:
perl ./ch-2.pl <<EOF
//..//../../..////a/d/../b/c
//..//..//a/./b/d
EOF
Results:
/a/b/
perl ./ch-2.pl <<EOF
..//a/d/../b/c
..///a/./b/d
EOF
I also make a full code based on a hash of hashes, as the first solutions above. Instead of relying on autovivification and evaling a string, I build the hash one level at a time.
1 # Perl weekly challenge 182
2 # Task 2: Common Path
3 #
4 # See https://wlmb.github.io/2022/09/12/PWC182/#task-2-common-path
5 use v5.36;
6 use Cwd qw(getcwd);
7 my $dirs;
8 while(<>){
9 canonical($_);
10 my @parts=split '/';
11 pop @parts; # remove non-directory or empty at end
12 my $d=$dirs->{shift @parts}//={};
13 $d=$d->{$_}//={} foreach(@parts); # create/update and traverse hash of hashes
14 }
15 my $d=$dirs->{""};
16 print "/";
17 while(1){
18 my @subdirs=keys %$d;
19 say(""), last unless @subdirs==1;
20 print "@subdirs/";
21 $d=$d->{"@subdirs"}
22 }
23 sub canonical{
24 for($_[0]){ # localize $_
25 s{^\s*}{}; # remove leading space
26 s{^([^/])}{getcwd . "/$1"}e; # convert to absolute if relative
27 s{/\./}{/}g; # /a/./->/a/
28 1 while s{/[^/]*/\.\.(/|$)}{/}; # /a/b/../->/a/
29 s{/\.\.(/|$)}{/}g; # /..->/ at beginning
30 1 while s{//}{/}; # //->/
31 }
32 }
33
Example:
./ch-2a.pl <<EOF
/a/b/c/1/x.pl
/a/b/c/d/e/2/x.pl
/a/b/c/d/3/x.pl
/a/b/c/4/x.pl
/a/b/c/d/5/x.pl
EOF
Results:
/a/b/c/