Perl-查找相似关联集

Perl-查找相似关联集,perl,Perl,我有以下数据集 A C A S B F B Q C A C I D K E Y F B F R I Y K P 第一列中的每个值在第二列中都有一个关联值。第1行中的值“A”具有关联的值“C”。在第二行中,值“A”与值“S”关联 使用Perl,我希望找到所有相关值的集合。使用上述规则,我将得到集合(ACEISY),(BFQR)和(

我有以下数据集

 A       C
 A       S
 B       F
 B       Q
 C       A
 C       I
 D       K
 E       Y
 F       B
 F       R
 I       Y
 K       P
第一列中的每个值在第二列中都有一个关联值。第1行中的值“A”具有关联的值“C”。在第二行中,值“A”与值“S”关联

使用Perl,我希望找到所有相关值的集合。使用上述规则,我将得到集合(ACEISY),(BFQR)和(DKP)

我正在寻找关于算法的建议,或者你如何解决这个问题的例子。我不确定哈希表是否是用于此目的的适当数据结构。任何帮助都将不胜感激

以下是我的实施:

while<INPUT>{
    my ($c1, $c2) = split;
    my %clusterhash = ();
    if (exists $clusterhash{$c1}){
        if (exists $clusterhash{$c1}{$c2}){
            #do nothing
        }
        else {
            $clusterhash{$c1}{$c2} = $c2;
        }
    }
    else{
        foreach my $key ( keys %clusterhash ) {
            if (exists $clusterhash{$key}{$c1}{
                $clusterhash{$c1}{$key} = $key;
            }
        }
        $clusterhash{$c1}{$c2} = $c2;
    }
}
while{
我的($c1,$c2)=分割;
我的%clusterhash=();
if(存在$clusterhash{$c1}){
if(存在$clusterhash{$c1}{$c2}){
#无所事事
}
否则{
$clusterhash{$c1}{$c2}=$c2;
}
}
否则{
foreach my$密钥(密钥%clusterhash){
if(exists$clusterhash{$key}{$c1}{
$clusterhash{$c1}{$key}=$key;
}
}
$clusterhash{$c1}{$c2}=$c2;
}
}

这本来不是一个答案,而是一个注释,但它太长了,不适合注释字段:

速度有什么问题吗?比如,数据太多了,经常循环可能不是一个好主意吗?因为如果重复循环没有问题,那么散列将是一个简单的解决方案:取第1列中尚未在散列中的第一个元素;将其添加到散列中,作为具有新集合号的键;遍历所有行,添加所有ist assoc将延迟值作为键添加到散列中,并使用相同的设置编号;如果在上一次迭代中添加了新键,请对这些键再次添加,直到没有添加新键;获取散列中尚未包含的下一个元素,并使用下一个集合索引重复该操作; 一旦没有未分配的元素,您就可以将散列中的所有元素作为键,并将其设置为值。 最后,您可能需要将其格式化为您想要的格式

编辑:好的,如果速度是一个问题,那么如何缩放值的数量而不是行的数量

有一个外部散列,集合索引作为键,内部散列作为值。这些内部散列将元素作为键和“1”作为值。遍历行。在每行中,检查值是否已经是一个或两个内部哈希中的键。如果它们在不同的哈希中,则合并这些哈希并删除外部哈希中的一个键。如果一个在一个哈希中,另一个不在,则将新值添加到第一个哈希中,如果它们在同一个哈希中,则不执行任何操作如果两者都不是散列,则为外部散列创建一个新键,并将这两个值添加到相应的内部散列中

如果内部散列很可能变大,或者可能有很多集,那么增长速度可能会非常慢。但是如果可能的值集与行数相比很小,那么增长速度可能会非常快

最佳编辑: 我有另一个想法,这一行最多看每一行三次(更可能是两次,假设随机关联),我认为这一行相当快,但需要更多的内存。
用两个大的散列遍历这些行。在每一行中,您将cell2添加到存储在hash1中的关键cell1处的数组中,并将cell1添加到存储在hash2中的关键cell2处的数组中。基本上,您将所有信息读取到这两个散列中。现在,您取一个hash1的随机键,并将该键以及所有元素添加到相应的数组int中o无论您希望存储最终集合的结构是什么(我将假定为第三个散列的键,集合号作为值)然后从hash1中删除键。现在,您还可以在hash2中查找所有这些元素作为键,并将这些数组中的所有内容添加到集合中,以及从hash2中删除这些键。现在,您将已添加到集合中的所有内容作为hash1的键,并再次将数组中的所有内容添加到集合中,依此类推。您必须一直这样做,直到hash1和hash2和ash2连续地没有任何内容要添加到集合中。然后,您获取另一个随机密钥并开始下一个集合。删除所有使用的密钥保证您不会得到任何内容两次,并且您不会经常检查同一行。这是假设查找哈希中是否存在密钥的速度实际上与我认为的速度一样快。

这并不是真的假定的o成为一个答案,但成为一个评论,但它增长太长,无法放入评论字段:

速度有什么问题吗?比如,数据太多了,经常循环可能不是一个好主意吗?因为如果重复循环没有问题,那么散列将是一个简单的解决方案:取第1列中尚未在散列中的第一个元素;将其添加到散列中,作为具有新集合号的键;遍历所有行,添加所有ist assoc将延迟值作为键添加到散列中,并使用相同的设置编号;如果在上一次迭代中添加了新键,请对这些键再次添加,直到没有添加新键;获取散列中尚未包含的下一个元素,并使用下一个集合索引重复该操作; 一旦没有未分配的元素,您就可以将散列中的所有元素作为键,并将其设置为值。 最后,您可能需要将其格式化为您想要的格式

编辑:好的,如果速度是一个问题,那么如何缩放值的数量而不是行的数量

有一个外部散列,集合索引作为键,内部散列作为值。这些内部散列将元素作为键和“1”作为值。遍历行。在每行中,检查值是否已经是一个或两个内部哈希中的键。如果它们在不同的哈希中,则合并这些哈希并删除外部哈希中的一个键。如果一个在一个哈希中,另一个不在,则将新值添加到第一个哈希中,如果它们在同一个哈希中,则不执行任何操作如果两者都不是散列,则为外部散列创建一个新键,并将这两个值添加到相应的内部散列中

如果内部哈希值可能变大,或者可能存在ma
use strict; use warnings; use feature qw/say/;

# build the graph
my %edge;
while (<>) {
  my ($from, $to) = split;
  $edge{$from}{$to} = $edge{$to}{$from} = undef;
}

while (my ($start) = keys %edge) {
  my @seen  = ($start);
  my @stack = ($start);

  while (@stack) {
    my $vertex = pop @stack;

    # delete edges from and to this vertex
    # NB: any connections to seen vertices are already removed.
    my @reachable = keys %{ delete($edge{$vertex}) // {} };
    delete $edge{$_}{$vertex} for @reachable;

    # mark new vertices as seen, and enqueue them
    push @seen, @reachable;
    push @stack, @reachable;
  }

  my $nodes = join ', ', sort @seen;
  say "node set: {$nodes}";
}
node set: {B, F, Q, R}
node set: {D, K, P}
node set: {A, C, E, I, S, Y}
use strict; use warnings; use feature qw/say/;
use Graph;

my $graph = Graph::Undirected->new;
while (<>) {
  my ($from, $to) = split;
  $graph->add_edge($from, $to);
}

for my $nodes_array ($graph->connected_components) {
  my $nodes = join ', ', sort @$nodes_array;
  say "node set: {$nodes}";
}
use strict; use warnings; use feature qw/say/;

my %subgraph_by_id;
my %subgraph_by_vertex;
while(<>) {
  my ($x, $y) = split;
  # case 1:
  # If an both vertices of an edge are unknown, they create a new subgraph.
  if (not exists $subgraph_by_vertex{$x} and not exists $subgraph_by_vertex{$y}) {
    my $new = [$x, $y];
    $subgraph_by_id{0+ $new} = $new;
    $subgraph_by_vertex{$_} = $new for $x, $y;
  }
  # case 2:
  # If exactly one vertex is known, the other node maps to the subgraph of the
  # first node, and is listed there as a member.
  elsif (not exists $subgraph_by_vertex{$x} or not exists $subgraph_by_vertex{$y}) {
    my ($known, $unknown) = (exists $subgraph_by_vertex{$x}) ? ($x, $y) : ($y, $x);
    my $subgraph = $subgraph_by_vertex{$unknown} = $subgraph_by_vertex{$known};
    push @$subgraph, $unknown;
  }
  # case 3:
  # both vertices are known. If they point to different subgraphs, all entries
  # are updated to point to the same subgraph which now contains the combined
  # nodes of the previous subgraphs.
  # Except all that copying would make for a horrible worst case.
  # Instead, we just add a reference to the smaller list, flattening it later.
  else {
    my $prev_x = $subgraph_by_vertex{$x};
    my $prev_y = $subgraph_by_vertex{$y};
    # don't test for inequality directly to allow subgraph nesting
    if ($subgraph_by_id{0+ $prev_x} != $subgraph_by_id{0+ $prev_y}) {
      my ($new, $old) = (@$prev_x > @$prev_y) ? ($prev_x, $prev_y) : ($prev_y, $prev_x);
      push @$new, $old;
      # $old not needed on top level any longer – associate it with $new by id
      $subgraph_by_id{0+ $old} = 0+ $new;
    }
  }
}

# skip symbolic IDs
for my $nodes_array (grep ref, values %subgraph_by_id) {
  my $nodes = join ', ', flatten($nodes_array);
  say "node set: {$nodes}";
}

sub flatten {
  return map { ref $_ ? flatten($_) : $_ } @{ shift() };
}