Question

有几条路径，例如：

1: /abc/def/some/common/part/xyz/file1.ext
2: /other/path/to/7433/qwe/some/common/part/anotherfile.ext
3: /misc/path/7433/qwe/some/common/part/filexx.ext
4: /2443/totally/different/path/file9988.ext
5: /abc/another/same/path/to/ppp/thisfile.ext
6: /deep1/deep2/another/same/path/to/diffone/filename.ext

我需要找到共同的部分 - 每个可能的部分，例如。在上面如果可能找到共同的部分：

 /some/common/part/ - in the paths 1,2,3
 /another/same/path/to/ - in the 5,6
 /path/to/ - in the 2,5,6
 /path/ - 2,3,4,5,6

等。

我根本不知道如何解决这个问题 - 哪种方法很好

基于字符串 - 稍微查找字符串的公共部分
基于列表 - 将所有路径拆分为列表，稍微比较常见元素的数组
树形图 - 稍微找到图形的公共部分
其他？

当我得到一些方向如何解决这个问题时，我（可能）能够自己编码 - 所以不要免费编程服务 - 但需要一些指导如何开始。

我确信这里已经有一些CPAN模块可以帮助我，但我真的不知道如何从上述问题的30k模块列表中找到合适的有用模块。：（

编辑 - 我需要的是：

约有200k文件，在10k目录中，其中许多“属于一起”，如：

/u/some/path/project1/subprojct/file1
/u/backup/of/work/date/project1/subproject/file2
/u/backup_of_backup/of/work/date/project1/subproject/file2
/u/new/addtions/to/projec1/subproject/file3

文件是dirrerent类（pdf，图像，doc，txt等），有几个是相同的（如上面的file2 - 很容易使用Digest :: MD5过滤），但是“将它们组合在一起”的唯一方法是基于关于路径的“共同部分” - 例如“project1 / subproject”等等..

另一个文件具有相同的MD5，因此可以过滤掉重复项，但它们位于不同的树中，例如

/u/path/some/file
/u/path/lastest_project/menu/file
/u/path/jquery/menu/file
/u/path/example/solution/jquery/menu/file

所以，文件是相同的，（相同的md5），但需要稍微将一个副本移动到正确的地方（并删除其他人），并需要在某种程度上确定“最常用的是“常用路径，收集标签......（旧路径元素是标签）

背后的想法是：

如果相同的md5文件 存储在某些公共路径下 - 我可以决定在哪里移动一个副本 ...

它更复杂，但对于解释就足够了;）

只需要降低硬盘上的熵;）

Answer 1

关于在这个帖子中找到最长的常见连续子串有一些讨论：http://www.nntp.perl.org/group/perl.fwp/2002/02/msg1662.html

“胜利者”似乎是以下代码，但您可以尝试其他一些内容：

#!/usr/bin/perl
use strict;
use warnings;

sub lcs {

    my $this = shift;
    my $that = shift;

    my $str = join "\0", $this, $that;
    my $len = 1;
    my $lcs;
    while ($str =~ m{ ([^\0]{$len,}) (?= [^\0]* \0 [^\0]*? \1 ) }xg) {
        $lcs = $1;
        $len = 1 + length($1);
    }

    if ($len == 1) { print("No common substring\n"); }
    else {
        print("Longest common substring of length $len: \"");
        print("$lcs");
        print("\"\n");
    }
}

请记住，您需要稍微调整一下，以便考虑到您只需要匹配的整个子目录...即将if ($len == 1)更改为if ($len == 1 or $lcs !~ /^\// or $lcs !~ /\/$/)

您还需要添加一些簿记来跟踪哪些匹配。当我在上面的示例中运行此代码时，它还会在第1行和第1行中找到/abc/匹配项。 5。

可能存在或可能不存在问题的一点是以下两行：

/abc/another/same/path/to/ppp/thisfile.ext
/abc/another/different/path/to/ppp/otherfile.ext

匹配：

/abc/another/

但不是：

/path/to/ppp/

但是 - 这是坏消息 - 您必须与n = 200,000个文件进行O（n ^ 2）比较。这可能需要花费大量时间。

另一个解决方案是遍历列表中的每个路径，将所有可能的目录路径添加为哈希的键并将文件本身推送到哈希（以便该值是具有此路径的文件数组在里面）。像这样：

use strict;
use warnings;
my %links;

open my $fh, "<", 'filename' or die "Can't open $!";
while (my $line = <$fh>) {
    chomp($line);
    my @dirs = split /\//, $line;
    for my $i (0..$#dirs) {
        if ($i == $#dirs) {
            push(@{ $links{$dirs[$i]} }, $line);
        }
        for my $j ($i+1..$#dirs) {
            push(@{ $links{join("/",@dirs[$i..$j])} }, $line);
            #PROCESS THIS if length of array is > 1
        }
    }
}

当然，这会占用大量的内存。要处理200,000个文件，无论您尝试什么，都可能会遇到困难，但也许您可以将其分解为更易于管理的块。希望这会给你一个起点。

Answer 2

要解决此问题，您需要正确的数据结构。计算部分路径的哈希很有效：

use File::Spec;

my %Count_of = ();

while( <DATA> ){
  my @names = File::Spec->splitdir( $_ );

  # remove file
  pop @names;

  # if absolute path, remove empty names at start
  shift @names while length( $names[0] ) == 0;

  # don't count blank lines
  next unless @names;

  # move two cursor thru the names,
  # and count the partial parts
  # created from one to the other
  for my $i ( 0 .. $#names ){
    for my $j ( $i .. $#names ){
      my $partial_path = File::Spec->catdir( @names[ $i .. $j ] );
      $Count_of{ $partial_path } ++;
    }
  }
}

# now display the results
for my $path ( sort { $Count_of{$b} <=> $Count_of{$a} || $a cmp $b } keys %Count_of ){

  # skip if singleton.
  next if $Count_of{ $path } <= 1;

  printf "%3d : %s\n", $Count_of{ $path }, $path;
}


__DATA__
/abc/def/some/common/part/xyz/file1.ext
/other/path/to/7433/qwe/some/common/part/anotherfile.ext
/misc/path/7433/qwe/some/common/part/filexx.ext
/2443/totally/different/path/file9988.ext
/abc/another/same/path/to/ppp/thisfile.ext
/deep1/deep2/another/same/path/to/diffone/filename.ext

如何使用perl查找路径中的公共部分？

2 个答案: