perl - 如何解析制表符分隔的数据文件并在 Perl 中对提取的数据进行分组？

Question

我是 Perl 的新手。我需要解析制表符分隔的文本文件。例如:

From name   To name      Timestamp                 Interaction
a             b        Dec  2 06:40:23 IST 2000        comment
c             d        Dec  1 10:40:23 IST 2001          like
e             a        Dec  1 16:03:01 IST 2000         follow
b             c        Dec  2 07:50:29 IST 2002         share
a             c        Dec  2 08:50:29 IST 2001        comment
c             a        Dec 11 12:40:23 IST 2008          like
e             c        Dec  2 07:50:29 IST 2000         like
c             b        Dec 11 12:40:23 IST 2008        follow
b             a        Dec  2 08:50:29 IST 2001        share

解析后，我需要根据用户交互创建组。在这个例子中

a<->b
b<->a
c<->a
a<->c
b<->c
c<->b

为此我们可以创建一个组。我们需要显示组列表。我需要一些关于如何解析文件和表单组的指示？

编辑约束-> 创建组至少需要 3 个用户。交互只不过是在两个用户之间进行一些交流。无论哪种沟通方式都无所谓

我的解决方法是

1. 我们删除了用户之间的重复交互。例如“a<>b like”，如果存在“a<>b follow”，那么我们删除这一行。

2. 创建存储两个用户交互的二维数组，即

             To Name   a       b        c          d
   

   来自姓名

      a                X       <>       <>         X
      b                <>      X        <>         X
      c                <>      <>       X          X 
      d                X       <>       X          X
   

   X=代表没有互动<>=代表互动

在这种方法中，我们从第一行开始，即“a”用户检查“b”。如果“a”与“b”交互，那么我们执行相反的操作，即“b”与“a”交互。对每一列执行相同的步骤。

但这种方法取决于用户数量。如果存在 1000 个用户，那么我们必须创建 1000 X 1000 矩阵。有没有其他方法可以解决这个问题

我添加了示例输入

a   c   Dec  2 06:40:23 IST 2000    comment
f   g   Dec  2 06:40:23 IST 2009    like
c   a   Dec  2 06:40:23 IST 2009    like
g   h   Dec  2 06:40:23 IST 2008    like
a   d   Dec  2 06:40:23 IST 2008    like
r   t   Dec  2 06:40:23 IST 2007    share
d   a   Dec  2 06:40:23 IST 2007    share
t   u   Dec  2 06:40:23 IST 2006    follow
a   e   Dec  2 06:40:23 IST 2006    follow
k   l   Dec  2 06:40:23 IST 2009    like
e   a   Dec  2 06:40:23 IST 2009    like
j   k   Dec  2 06:40:23 IST 2003    like
c   d   Dec  2 06:40:23 IST 2003    like
l   j   Dec  2 06:40:23 IST 2002    like
d   c   Dec  2 06:40:23 IST 2002    like
m   n   Dec  2 06:40:23 IST 2005    like
c   e   Dec  2 06:40:23 IST 2005    like
m   l   Dec  2 06:40:23 IST 2011    like
e   c   Dec  2 06:40:23 IST 2011    like
h   j   Dec  2 06:40:23 IST 2010    like
d   e   Dec  2 06:40:23 IST 2010    like
o   p   Dec  2 06:40:23 IST 2009    like
e   d   Dec  2 06:40:23 IST 2009    like
p   q   Dec  2 06:40:23 IST 2000    comment
q   p   Dec  2 06:40:23 IST 2009    like
a   p   Dec  2 06:40:23 IST 2008    like    
p   a   Dec  2 06:40:23 IST 2007    share
l   p   Dec  2 06:40:23 IST 2003    like
j   l   Dec  2 06:40:23 IST 2002    like
t   r   Dec  2 06:40:23 IST 2000    comment
r   h   Dec  2 06:40:23 IST 2009    like
j   f   Dec  2 06:40:23 IST 2008    like    
g   d   Dec  2 06:40:23 IST 2007    share
w   q   Dec  2 06:40:23 IST 2003    like
o   y   Dec  2 06:40:23 IST 2002    like
x   y   Dec  2 06:40:23 IST 2000    comment
y   x   Dec  2 06:40:23 IST 2009    like
x   z   Dec  2 06:40:23 IST 2008    like    
z   x   Dec  2 06:40:23 IST 2007    share
y   z   Dec  2 06:40:23 IST 2003    like
z   y   Dec  2 06:40:23 IST 2002    like

输出应该是:

(a,c, d, e)
(x,y,z)

Answer 1

解析很容易。只是一个 split /\t/ 可能就够了。然而，Text::xSV或 Text::CSV可能会更好。

对于连接，您可以使用 Graph模块。为了能够有效地使用该模块，您至少需要了解 graph theory 的基础知识.

请注意 strongly connected component定义为:

A directed graph is called strongly connected if there is a path from each vertex in the graph to every other vertex. In particular, this means paths in each direction; a path from a to b and also a path from b to a.

The strongly connected components of a directed graph G are its maximal strongly connected subgraphs.

但是，请注意，如果您有 a <-> b和 b <-> c , a , b , 和 c将形成一个强连接的组件，这意味着这是一个比组中所有成员在两个方向上相互交互更弱的要求。

我们仍然可以使用它来减少搜索空间。一旦你有了候选组，你就可以检查每个候选组，看看它是否符合你对组的定义。如果一个候选组不符合你的要求，那么你可以检查所有少一个成员的子集。如果您在其中未找到任何组，则可以查看所有成员少两个的子集，依此类推，直到达到最小组大小限制。

下面的脚本使用了这个想法。但是，它很可能不会扩展。我强烈怀疑有人可以组合一些 SQL 魔术，但我的头脑太有限了。

#!/usr/bin/env perl

use strict;
use warnings;

use Graph;
use Algorithm::ChooseSubsets;

use constant MIN_SIZE => 3;

my $interactions = Graph->new(
    directed => 1,
);

while (my $interaction = <DATA>) {
    last unless $interaction =~ /\S/;
    my ($from, $to) = split ' ', $interaction, 3;

    $interactions->add_edge($from, $to);
}

my @groups = map {
    is_group($interactions, $_) ? $_
                                : check_subsets($interactions, $_)
} grep @$_ >= MIN_SIZE, $interactions->strongly_connected_components;


print "Groups: \n";
print "[ @$_ ]\n" for @groups;

sub check_subsets {
    my ($graph, $candidate) = @_;

    my @groups;
    for my $size (reverse MIN_SIZE .. (@$candidate - 1)) {
        my $subsets = Algorithm::ChooseSubsets->new(
            set => $candidate,
            size => $size,
        );

        my $groups_found;
        while (my $subset = $subsets->next) {
            if (is_group($interactions, $subset)) {
                ++$groups_found;
                push @groups, $subset;
            }
        }
        last if $groups_found;
    }

    return @groups;
}

sub is_group {
    my ($graph, $candidate) = @_;

    for my $member (@$candidate) {
        for my $other (@$candidate) {
            next if $member eq $other;
            return unless $graph->has_edge($member, $other);
            return unless $graph->has_edge($other, $member);
        }
    }

    return 1;
}

__DATA__
a   c   Dec  2 06:40:23 IST 2000    comment
f   g   Dec  2 06:40:23 IST 2009    like
c   a   Dec  2 06:40:23 IST 2009    like
g   h   Dec  2 06:40:23 IST 2008    like
a   d   Dec  2 06:40:23 IST 2008    like
r   t   Dec  2 06:40:23 IST 2007    share
d   a   Dec  2 06:40:23 IST 2007    share
t   u   Dec  2 06:40:23 IST 2006    follow
a   e   Dec  2 06:40:23 IST 2006    follow
k   l   Dec  2 06:40:23 IST 2009    like
e   a   Dec  2 06:40:23 IST 2009    like
j   k   Dec  2 06:40:23 IST 2003    like
c   d   Dec  2 06:40:23 IST 2003    like
l   j   Dec  2 06:40:23 IST 2002    like
d   c   Dec  2 06:40:23 IST 2002    like
m   n   Dec  2 06:40:23 IST 2005    like
c   e   Dec  2 06:40:23 IST 2005    like
m   l   Dec  2 06:40:23 IST 2011    like
e   c   Dec  2 06:40:23 IST 2011    like
h   j   Dec  2 06:40:23 IST 2010    like
d   e   Dec  2 06:40:23 IST 2010    like
o   p   Dec  2 06:40:23 IST 2009    like
e   d   Dec  2 06:40:23 IST 2009    like
p   q   Dec  2 06:40:23 IST 2000    comment
q   p   Dec  2 06:40:23 IST 2009    like
a   p   Dec  2 06:40:23 IST 2008    like
p   a   Dec  2 06:40:23 IST 2007    share
l   p   Dec  2 06:40:23 IST 2003    like
j   l   Dec  2 06:40:23 IST 2002    like
t   r   Dec  2 06:40:23 IST 2000    comment
r   h   Dec  2 06:40:23 IST 2009    like
j   f   Dec  2 06:40:23 IST 2008    like
g   d   Dec  2 06:40:23 IST 2007    share
w   q   Dec  2 06:40:23 IST 2003    like
o   y   Dec  2 06:40:23 IST 2002    like
x   y   Dec  2 06:40:23 IST 2000    comment
y   x   Dec  2 06:40:23 IST 2009    like
x   z   Dec  2 06:40:23 IST 2008    like
z   x   Dec  2 06:40:23 IST 2007    share
y   z   Dec  2 06:40:23 IST 2003    like
z   y   Dec  2 06:40:23 IST 2002    like

输出:

Groups:[ y z x ][ e d a c ]