Чередование разреженных отсортированных массивов - PullRequest
Новая
       6

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

7 голосов
/ 09 июля 2010

У меня есть набор списков событий.События всегда происходят в заданном порядке, но не каждое событие всегда происходит.Вот пример ввода: 

[[ 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% правильно (это действительно все, что мне нужно).Я просто не хочу заново изобретать колесо, если мне не нужно.

Ответы [ 10 ]

3 голосов
/ 10 июля 2010

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

Обратите внимание, что tsort требует ациклического графа. С точки зрения вашего примера, это означает, что вы не можете видеть, что do следует, затем 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";
}

Для ввода вашего вопроса, который вы указали, выведите 

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

Это выглядит забавно, потому что мы знаем порядок solfège, но re и la несравнимы в частичном порядке , определяемом $events: мы знаем только, что они оба должны следовать после do.

3 голосов
/ 09 июля 2010

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

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

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

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

2 голосов
/ 10 июля 2010

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

, что в основном то, что вы хотите.

1 голос
/ 21 апреля 2011

Используйте хеш для агрегации. 

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;
0 голосов
/ 10 июля 2010

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

Код 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]
0 голосов
/ 10 июля 2010

Решение:

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

#!/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};
0 голосов
/ 10 июля 2010

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

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);

Выход:

, ре, ми, фа, ля, ти, так, ZA

0 голосов
/ 09 июля 2010

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

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

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

0 голосов
/ 09 июля 2010

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

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

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

0 голосов
/ 09 июля 2010 
perl -de 0
  DB<1> @a = ( ['a','b','c'], ['c','f'], ['h'] ) 
  DB<2> map { @m{@{$_}} = @$_ } @a
  DB<3> p keys %m
chabf

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

...