Разбор прост. Просто split /\t/
может быть достаточно. Однако Text :: xSV или Text :: CSV может быть лучше.
Для соединений вы можете использовать модуль Graph . Чтобы эффективно использовать этот модуль, вам необходимо понять хотя бы основы теории графов .
Обратите внимание, что сильно связанный компонент определяется как:
Направленный граф называется сильно связным, если существует путь от каждой вершины графа до любой другой вершины. В частности, это означает пути в каждом направлении; путь от 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 ]