7

我有一组事件列表。事件总是以给定的顺序发生，但并非每个事件都总是发生。这是一个示例输入：

[[ do, re, fa, ti ],
 [ do, re, mi ],
 [ do, la, ti, za ],
 [ mi, fa ],
 [ re, so, za ]]

输入值没有任何固有顺序。它们实际上是“创建符号链接”和“重新索引搜索”之类的消息。它们在单独的列表中进行排序，但是无法仅查看第一个列表中的“fa”和第二个列表中的“mi”并确定哪个在另一个之前。

我希望能够接受该输入并生成所有事件的排序列表：

[ do, re, mi, fa, so, la, ti, za ]

或者更好的是，关于每个事件的一些信息，比如计数：

[ [do, 3], [re, 3], [mi, 2],
  [fa, 2], [so, 1], [la, 1],
  [ti, 1], [za, 2] ]

我在做什么有名字吗？有公认的算法吗？如果这很重要，我正在用 Perl 写这个，但伪代码会做。

我知道，鉴于我的示例输入，我可能无法保证“正确”的顺序。但我真正的输入有更多的数据点，我相信只要有一点聪明，它就会有 95% 是正确的（这真的是我所需要的）。如果没有必要，我只是不想重新发明轮子。

4

10 回答 10

3

从理论上讲，让我建议以下算法：

  1. 构建有向图。
  2. 对于每个输入 [ X, Y, Z ]，如果边缘 X->Y 和 Y->Z 不存在，则创建它们。
  3. 对图进行拓扑排序。
  4. 瞧！

PS
这只是假设所有事件都以特定顺序发生（总是！）。如果不是这样，问题就变成了NP-Complete。

PPS
只是为了让你有一些有用的东西：Sort::Topological（不知道它是否真的有效，但它看起来是正确的）

于 2010-07-09T18:48:16.433 回答
3

您可以使用从观察到的顺序tsort推断出合理的（尽管不一定是唯一的）排序顺序（称为拓扑顺序）。您可能有兴趣阅读tsort的原始用途，它在结构上与您的问题相似。

请注意，这tsort需要一个无环图。就您的示例而言，这意味着您看不到 do 后跟 re 在一个序列中，而 re 后跟 do 在另一个序列中。

#! /usr/bin/perl

use warnings;
use strict;

use IPC::Open2;

sub tsort {
  my($events) = @_;

  my $pid = open2 my $out, my $in, "tsort";

  foreach my $group (@$events) {
    foreach my $i (0 .. $#$group - 1) {
      print $in map "@$group[$i,$_]\n", $i+1 .. $#$group;
    }
  }

  close $in or warn "$0: close: $!";

  chomp(my @order = <$out>);
  my %order = map +(shift @order => $_), 0 .. $#order;
  wantarray ? %order : \%order;
}

因为您将数据描述为稀疏，所以上面的代码提供tsort了有关事件邻接矩阵的尽可能多的信息。

有了这些信息，计算直方图并对其组件进行排序很简单：

my $events = [ ... ];

my %order = tsort $events;

my %seen;
do { ++$seen{$_} for @$_ } for @$events;

my @counts;
foreach my $event (sort { $order{$a} <=> $order{$b} } keys %seen) {
  push @counts => [ $event, $seen{$event} ];
  print "[ $counts[-1][0], $counts[-1][1] ]\n";
}

对于您提供的问题中的输入，输出是

[做，3]
[拉，1]
[重新，3]
[所以，1]
[英里，2]
[发，2]
[ 钛, 2 ]
[ 扎， 2 ]

这看起来很有趣，因为我们知道 solfège 的顺序，但是 re 和 la 在由 定义的偏序$events中是无法比较的：我们只知道它们都必须在 do 之后。

于 2010-07-09T20:22:41.247 回答
2

如果您不喜欢编写太多代码，则可以使用 unix 命令行实用程序tsort：

$ tsort -
do re
re fa
fa ti
do re
re mi
do la
la ti
ti za
mi fa
re so
so za

这是您的示例输入中所有对的列表。这产生作为输出：

do
la
re
so
mi
fa
ti
za

这基本上就是你想要的。

于 2010-07-09T20:06:07.310 回答
1

使用哈希进行聚合。

my $notes= [[qw(do re fa ti)],
       [qw(do re mi)],
       [qw(do la ti za)],
       [qw(mi fa)],
       [qw(re so za)]];

my %out;
foreach my $list (@$notes)
{
  $out{$_}++ foreach @$list;
}

print "$_: $out{$_}\n" foreach sort keys %out;

产量

do: 3
fa: 2
la: 1
mi: 2
re: 3
so: 1
ti: 2
za: 2

如果这是您想要的，则 %out 哈希很容易转换为列表。

my @newout;
push @newout,[$_,$out{$_}] foreach sort keys %out;
于 2011-04-21T15:54:00.330 回答
0 
perl -de 0
  DB<1> @a = ( ['a','b','c'], ['c','f'], ['h'] ) 
  DB<2> map { @m{@{$_}} = @$_ } @a
  DB<3> p keys %m
chabf

我能想到的最快的捷径。无论哪种方式，您都必须至少迭代一次...

于 2010-07-09T18:42:06.793 回答
0

这是合并排序的完美候选者。转到此处的维基百科页面以获得算法的一个很好的表示http://en.wikipedia.org/wiki/Merge_sort

您所描述的实际上是合并排序的子集/小调整。您不是从未排序的数组开始，而是有一组要合并在一起的排序数组。只需按照维基百科页面中关于数组对和合并函数结果的描述调用“合并”函数，直到你有一个数组（将被排序）。

要将输出调整为您想要的方式，您需要定义一个比较函数，如果一个事件小于、等于或大于另一个事件，则该函数可以返回。然后，当您的合并函数找到两个相等的事件时，您可以将它们折叠成一个事件并为该事件保留计数。

于 2010-07-09T18:45:26.173 回答
0

粗略地说，我给它的名字是“散列”。您正在将事物放入名称值对中。如果你想保持某种秩序，你必须用一个保持秩序的数组来补充散列。那个订单对我来说是“遭遇订单”。

use strict;
use warnings;

my $all 
    = [[ 'do', 're', 'fa', 'ti' ],
       [ 'do', 're', 'mi' ],
       [ 'do', 'la', 'ti', 'za' ],
       [ 'mi', 'fa' ],
       [ 're', 'so', 'za' ]
     ];

my ( @order, %counts );

foreach my $list ( @$all ) { 
    foreach my $item ( @$list ) { 
        my $ref = \$counts{$item}; # autovivs to an *assignable* scalar.
        push @order, $item unless $$ref;
        $$ref++;
    }
}

foreach my $key ( @order ) { 
    print "$key: $counts{$key}\n";
}

# do: 3
# re: 3
# fa: 2
# ti: 2
# mi: 2
# la: 1
# za: 2
# so: 1

还有其他类似的答案，但我的答案包含这个巧妙的自动生存技巧。

于 2010-07-09T19:31:15.450 回答
0

我也不确定这会被称为什么，但我想出了一种方法来找到给定数组数组作为输入的顺序。本质上，伪代码是：

10 在所有数组中查找最早的项目
20 将其推送到列表中
30 从所有数组中删除该项目
40 如果还有任何项目，则转到 10

这是一个工作原型：

#!/usr/bin/perl

use strict;

sub InList {
    my ($x, @list) = @_;
    for (@list) {
        return 1 if $x eq $_;
    }
    return 0;
}

sub Earliest {
    my @lists = @_;
    my $earliest;
    for (@lists) {
        if (@$_) {
            if (!$earliest
                || ($_->[0] ne $earliest && InList($earliest, @$_))) {

                $earliest = $_->[0];
            }
        }
    }
    return $earliest;
}

sub Remove {
    my ($x, @lists) = @_;

    for (@lists) {
        my $n = 0;
        while ($n < @$_) {
            if ($_->[$n] eq $x) {
                splice(@$_,$n,1);
            }
            else {
                $n++
            }
        }
    }
}

my $list = [
    [ 'do', 're', 'fa', 'ti' ],
    [ 'do', 're', 'mi' ],
    [ 'do', 'la', 'ti', 'za' ],
    [ 'mi', 'fa' ],
    [ 're', 'so', 'za' ]
];

my @items;

while (my $earliest = Earliest(@$list)) {
    push @items, $earliest;
    Remove($earliest, @$list);
}

print join(',', @items);

输出：

做,re,mi,fa,la,ti,so,za

于 2010-07-09T20:42:41.247 回答
0

解决方案：

这解决了提问者修改之前的原始问题。

#!/usr/local/bin/perl -w
use strict; 

   main();
    
   sub main{
      # Changed your 3-dimensional array to a 2-dimensional array
      my @old = (
                   [ 'do', 're', 'fa', 'ti' ],
                   [ 'do', 're', 'mi' ],
                   [ 'do', 'la', 'ti', 'za' ],
                   [ 'mi', 'fa' ],
                   [ 're', 'so', 'za' ]
                );
      my %new;

      foreach my $row (0.. $#old ){                           # loop through each record (row)
         foreach my $col (0..$#{$old[$row]} ){                # loop through each element (col)                    
            $new{ ${$old[$row]}[$col] }{count}++;
            push @{ $new{${$old[$row]}[$col]}{position} } , [$row,$col];
         }
      }

      foreach my $key (sort keys %new){
         print "$key : $new{$key} " , "\n";                   # notice each value is a hash that we use for properties 
      }      
   }

如何检索信息：

   local $" = ', ';                       # pretty print ($") of array in quotes
   print $new{za}{count} , "\n";          # 2    - how many there were
   print "@{$new{za}{position}[1]} \n";   # 4,2  - position of the second occurrence
                                          #        remember it starts at 0

基本上，我们在散列中创建一个唯一的元素列表。对于这些元素中的每一个，我们都有一个“属性”哈希，其中包含一个标量count和一个用于position. 数组中元素的数量应该根据元素在原始元素中出现的次数而有所不同。

标量属性并不是真正需要的，因为您总是可以使用position数组的标量来检索相同的数字。注意：如果您曾经从数组中添加/删除元素count并且position它们的含义将不相关。

  • 例子：print scalar @{$new{za}{position}};会给你一样的print $new{za}{count};
于 2010-07-09T21:20:31.437 回答
0

刚刚意识到你的问题说他们没有预定的顺序，所以这可能无关紧要。

Perl代码：

$list = [
    ['do', 're', 'fa', 'ti' ],
    ['do', 're', 'mi' ],
    ['do', 'la', 'ti', 'za' ],
    ['mi', 'fa' ],
    ['re', 'so', 'za' ]
];
%sid = map{($_,$n++)}qw/do re mi fa so la ti za/;

map{map{$k{$_}++}@$_}@$list;
push @$result,[$_,$k{$_}] for sort{$sid{$a}<=>$sid{$b}}keys%k;

print "[@$_]\n" for(@$result);

输出：

[do 3]
[re 3]
[mi 2]
[fa 2]
[so 1]
[la 1]
[ti 2]
[za 2]
于 2010-07-10T15:32:53.640 回答