Peter
Peter Campbell Smith

Find the biggest
and the deepest

Weekly challenge 182 — 12 September 2022

Week 182 - 12 Sep 2022

Task 2

Task — Common path

Given a list of absolute Linux file paths, determine the deepest path to the directory that contains all of them.

Examples

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
Output:
    /a/b/c

Analysis

Let's start with the first item in the list - say /a/b/c/d/xx. We can immediately see that the longest possible answer is /a/b/c/d/, because any longer one would not be common to the first item.

So let's go down the list looking to see if they all start with /a/b/c/d/. As soon as we find one that doesn't, lets start again, stripping the deepest directory from our initial guess, which in our case leaves us with /a/b/c/.

Eventually we'll find a path that is common to all the items in the list, though that may simply be /.

Try it 

Try running the script with any input:



example: /a/b/c/d, /a/b/x/d, /a/b/x/y

Script


#!/usr/bin/perl

# Peter Campbell Smith - 2022-09-15
# PWC 182 task 2

use v5.28;
use utf8;
use warnings;

common_folder(
 qw[/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]);
    
common_folder(
 qw[/a/b/c/x.pl 
    /d/e/f/x.pl]);
    
common_folder(
 qw[/m/n/o/p/xx
    /m/n/o/p/xx]);  
    
sub common_folder {
    
    my (@paths, $guess, $try, $path, $good);
    @paths = @_;
    
    # show input
    say qq[\nInput:\n    ] . join(qq[\n    ], @paths);
    
    # get the path to the first one
    $paths[0] =~ m|(.*/)|;
    $guess = $1;

    # work backwards, stripping off the last folder
    TRY: for $try (1 .. 99) {
        
        # loop over the rest to see if they match
        $good = 1;
        for $path (@paths) {
            unless ($path =~ m|^$guess|) {
                $good = 0;
                last;
            }
        }
        # found the answer
        last if $good;
        
        # remove the last folder and try again
        $guess =~ s|/[^/]*/$|/|;
    }
    say qq[Output:\n    ] . substr($guess, 0, -1);
}   

    

Output


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
Output:
    /a/b/c

Input:
    /a/b/c/x.pl
    /d/e/f/x.pl
Output:
    

Input:
    /m/n/o/p/xx
    /m/n/o/p/xx
Output:
    /m/n/o/p