# Perl Weekly Challenge 182.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 182.

``````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  #
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
``````

``````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  #
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  #
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/
``````
Written on September 12, 2022