Чередование редких сортированных массивов

Если вам не нравится писать много кода, вы можете использовать утилиту командной строки 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

что, в общем-то, то, что вам нужно.

Это идеальный кандидат для Merge Sort. Перейдите на страницу Википедии здесь для довольно хорошего представления алгоритма http://en.wikipedia.org/wiki/Merge_sort

То, что вы описали, на самом деле является подмножеством/малой модификацией сортировки слиянием. Вместо того, чтобы начинать с несортированного массива, у вас есть набор отсортированных массивов, которые вы хотите объединить вместе. Просто вызовите функцию "merge", как описано на странице википедии, для пар ваших массивов и результатов функции merge, пока не получите один массив (который будет отсортирован).

Чтобы настроить вывод так, как вам нужно, вам потребуется определить функцию сравнения, которая может возвращать, если одно событие меньше, равно или больше другого события. Затем, когда ваша функция слияния найдет два одинаковых события, вы можете объединить их в одно событие и вести подсчет для этого события.

Только что понял, что ваш вопрос сказал, что их порядок не предопределен, поэтому это может не относиться к делу.

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]

Я тоже не совсем уверен, как это будет называться, но я придумал способ найти порядок, задав массив массивов в качестве входных данных. По сути, псевдокод выглядит так:

10 Найти самый ранний элемент во всех массивах
20 Поместить его в список
30 Удалить этот элемент из всех массивов
40 Goto 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);

Выходные данные:

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

Решение:

Это решает исходный вопрос до того, как он был изменен задавшим его.

#!/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   

По сути, мы создаем уникальный список элементов в хэше. Для каждого из этих элементов у нас есть хэш "property", который содержит скаляр count и массив для position. Количество элементов в массиве должно меняться в зависимости от того, сколько вхождений элемента было в оригинале.

Свойство scalar на самом деле не нужно, поскольку вы всегда можете взять скаляр массива position для получения того же числа. Примечание: если вы будете добавлять/удалять элементы из массива count и position не будут коррелировать по значению.

• пример: print scalar @{$new{za}{position}}; даст вам то же самое, что и print $new{za}{count};

Теоретически позвольте мне предложить следующий алгоритм:

1. Построить ориентированный граф.
2. Для каждого входа [X, Y, Z] создайте края X-> Y и Y-> Z, если их еще нет.
3. Выполните топологическую сортировку графа.
4. Вуаля!

PS
Это только при условии, что все события происходят в определенном порядке (всегда!). Если это не так, проблема становится NP-Complete.

PPS
И просто для того, чтобы у вас было что-то полезное: Sort :: Topological (не знаю, действительно ли это работает, но кажется правильным)

perl -de 0
  DB<1> @a = ( ['a','b','c'], ['c','f'], ['h'] ) 
  DB<2> map { @m{@{$_}} = @$_ } @a
  DB<3> p keys %m
chabf

Самый быстрый способ, который я могу придумать. В любом случае, вы должны пройтись по всем элементам хотя бы один раз...

Грубо говоря, я бы назвал это "хэшированием". Вы помещаете вещи в пары "имя-значение". Если вы хотите сохранить некое подобие порядка, вам нужно дополнить хэш массивом, который сохраняет порядок. Для меня этот порядок - "порядок встреч".

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

Есть и другие ответы, подобные этому, но мой содержит этот аккуратный трюк автовивификации.