如何解析制表符分隔的数据文件并将提取的数据分组到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. 创建2维阵列，其存储相互作用两个用户，即

     To Name a  b  c   d 
   

   From Name

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

   X =代表没有相互作用 <> =表示相互作用

在这种方法w e从第一行开始，即“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到b的路径以及从b到a的路径。

有向图G的强连通分量是它的最大强连通子图。

但是，请注意，如果你有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 ]