Равномерно распределить повторяющиеся строки

Мне нужно распределить набор повторяющихся строк как можно более равномерно.

Есть ли способ сделать это лучше, чем простое перемешивание с использованием unsort? Он не может делать то, что мне нужно.

Например, если вход

aaa
aaa
aaa
bbb
bbb

Выход мне нужен

aaa
bbb
aaa
bbb
aaa

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

aaa 3
bbb 2
... .
zzz 5

Существует ли существующий инструмент, модуль Perl или алгоритм для этого?

Источник

1 ответ

Решение

Аннотация: Учитывая ваше описание того, как вы определяете "равномерное распределение", я написал алгоритм, который вычисляет "вес" для каждой возможной перестановки. Тогда можно перебрать оптимальную перестановку.

Взвешивание расположения предметов

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

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

A B A C B A A

дал бы счет

A: 1 2 3 1 1
B: 2 3 3
C: 4 4

Т.е. две соседние строки имеют расстояние один, а строка в начале или конце имеет расстояние один до края строки. Эти свойства облегчают вычисление расстояний, но являются лишь константой, которая будет удалена позже.

Это код для подсчета расстояний:

sub distances {
    my %distances;
    my %last_seen;

    for my $i (0 .. $#_) {
        my $s = $_[$i];
        push @{ $distances{$s} }, $i - ($last_seen{$s} // -1);
        $last_seen{$s} = $i;
    }

    push @{ $distances{$_} }, @_ - $last_seen{$_} for keys %last_seen;

    return values %distances;
}

Далее мы рассчитываем стандартную дисперсию для каждого набора расстояний. Дисперсия одного расстояния d описывает, как далеко они от среднего а. В квадрате большие аномалии сильно оштрафованы:

variance(d, a) = (a - d)²

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

svar(items) = sqrt ∑_i variance(items[i], average(items))

Выражается как код Perl:

use List::Util qw/sum min/;

sub svar (@) {
    my $med = sum(@_) / @_;
    sqrt sum map { ($med - $_) ** 2 } @_;
}

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

Теперь мы должны объединить эти веса с общим весом нашей комбинации. Мы должны рассмотреть следующие свойства:

  • Строки с большим количеством вхождений должны иметь больший вес, чем строки с меньшим количеством вхождений.
  • Неравномерное распределение должно иметь больший вес, чем даже распределение, чтобы строго наказывать за неравномерность.

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

sub weigh_distance {
    return sum map {
        my @distances = @$_; # the distances of one string
        svar(@distances) ** $#distances;
    } distances(@_);
}

Оказывается, предпочитают хорошие распределения.

Теперь мы можем вычислить вес данной перестановки, передав его weigh_distance, Следовательно, мы можем решить, являются ли две перестановки одинаково хорошо распределенными, или одну предпочтительнее:

Выбор оптимальных перестановок

Учитывая выбор перестановок, мы можем выбрать те перестановки, которые являются оптимальными:

sub select_best {
    my %sorted;
    for my $strs (@_) {
        my $weight = weigh_distance(@$strs);
        push @{ $sorted{$weight} }, $strs;
    }
    my $min_weight = min keys %sorted;
    @{ $sorted{$min_weight} }
}

Это вернет хотя бы одну из данных возможностей. Если точный из них не важен, может быть выбран произвольный элемент массива повторных платежей.

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

Создание всех возможных перестановок

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

use Carp;
# called like make_perms(A => 4, B => 1, C => 1)
sub make_perms {
    my %words = @_;
    my @keys =
        sort  # sorting is important for cache access
        grep { $words{$_} > 0 }
        grep { length or carp "Can't use empty strings as identifiers" }
        keys %words;
    my ($perms, $ok) = _fetch_perm_cache(\@keys, \%words);
    return @$perms if $ok;
    # build perms manually, if it has to be.
    # pushing into @$perms directly updates the cached values
    for my $key (@keys) {
        my @childs = make_perms(%words, $key => $words{$key} - 1);
        push @$perms, (@childs ? map [$key, @$_], @childs : [$key]);
    }
    return @$perms;
}

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

sub _fetch_perm_cache {
    my ($keys, $idxhash) = @_;
    state %perm_cache;
    my $pointer = \%perm_cache;
    my $ok = 1;
    $pointer = $pointer->{$_}[$idxhash->{$_}] //= do { $ok = 0; +{} } for @$keys;
    $pointer = $pointer->{''} //= do { $ok = 0; +[] }; # access empty string key
    return $pointer, $ok;
}

То, что не все строки являются действительными ключами ввода, не является проблемой: каждая коллекция может быть перечислена, поэтому make_perms могут быть заданы целые числа в виде ключей, которые переводятся обратно в любые данные, которые они представляют вызывающей стороной. Обратите внимание, что кэширование делает это не-потокобезопасным (если %perm_cache были поделены).

Соединяя части

Теперь это просто вопрос

say "@$_" for select_best(make_perms(A => 4, B => 1, C => 1))

Это дало бы

A A C A B A
A A B A C A
A C A B A A
A B A C A A

которые все являются оптимальными решениями по используемому определению. Интересно, что решение

A B A A C A

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

Завершение тестовых случаев

Предпочтительными версиями являются первые: AABAA ABAAA, ABABACA ABACBAA(два "А" подряд), ABAC ABCA

Мы можем запустить эти тесты

use Test::More tests => 3;
my @test_cases = (
  [0 => [qw/A A B A A/], [qw/A B A A A/]],
  [1 => [qw/A B A C B A A/], [qw/A B A B A C A/]],
  [0 => [qw/A B A C/], [qw/A B C A/]],
);
for my $test (@test_cases) {
  my ($correct_index, @cases) = @$test;
  my $best = select_best(@cases);
  ok $best ~~ $cases[$correct_index], "[@{$cases[$correct_index]}]";
}

Из интереса мы можем вычислить оптимальные распределения для этих писем:

my @counts = (
  { A => 4, B => 1 },
  { A => 4, B => 2, C => 1},
  { A => 2, B => 1, C => 1},
);
for my $count (@counts) {
  say "Selecting best for...";
  say "  $_: $count->{$_}" for keys %$count;
  say "@$_" for select_best(make_perms(%$count));
}

Это приносит нам

Selecting best for...
  A: 4
  B: 1
A A B A A
Selecting best for...
  A: 4
  C: 1
  B: 2
A B A C A B A
Selecting best for...
  A: 2
  C: 1
  B: 1
A C A B
A B A C
C A B A
B A C A

Дальнейшая работа

  • Поскольку взвешивание придает одинаковую важность расстоянию до краев и расстоянию между буквами, симметричные установки являются предпочтительными. Это условие можно облегчить, уменьшив значение расстояния до краев.
  • Алгоритм генерации перестановок должен быть улучшен. Мемоизация может привести к ускорению. Готово! Генерация перестановки теперь в 50 раз быстрее для синтетических тестов и может получить доступ к кэшированному вводу в O (n), где n - количество различных входных строк.
  • Было бы здорово найти эвристику, которая будет направлять генерацию перестановок, а не оценивать все возможности. Возможная эвристика может рассмотреть вопрос о том, достаточно ли доступно различных строк, чтобы ни одна строка не имела соседей (т. Е. Расстояние 1). Эта информация может быть использована для сужения ширины дерева поиска.
  • Преобразование рекурсивной генерации перми в итеративное решение позволит переплетать поиск с вычислением веса, что упростит пропуск или откладывание неблагоприятных решений.

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

    weight(svar, occurrences) → weighted_variance
weight(0.9, 10) → 0.35
weight(0.5, 1)  → 0.5

    Это на самом деле должно быть полностью изменено.

редактировать

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

Он работает путем вставки строк через равные промежутки времени, а затем распространения повторений, которых можно избежать.

sub approximate {
    my %def = @_;
    my ($init, @keys) = sort { $def{$b} <=> $def{$a} or $a cmp $b } keys %def;
    my @out = ($init) x $def{$init};
    while(my $key = shift @keys) {
        my $visited = 0;
        for my $parts_left (reverse 2 .. $def{$key} + 1) {
            my $interrupt = $visited + int((@out - $visited) / $parts_left);
            splice @out, $interrupt, 0, $key;
            $visited = $interrupt + 1;
        }
    }
    # check if strings should be swapped
    for my $i ( 0 .. $#out - 2) {
        @out[$i, $i + 1] = @out[$i + 1, $i]
            if  $out[$i] ne $out[$i + 1]
            and $out[$i + 1] eq $out[$i + 2]
            and (!$i or $out[$i + 1 ] ne $out[$i - 1]);
    }
    return @out;
}

Редактировать 2

Я обобщил алгоритм для любых объектов, а не только для строк. Я сделал это путем перевода входных данных в абстрактное представление, например "два из первого, один из второго". Большим преимуществом здесь является то, что мне нужны только целые числа и массивы для представления перестановок. Кроме того, кэш меньше, потому что A => 4, C => 2, C => 4, B => 2 а также $regex => 2, $fh => 4 представляют одни и те же абстрактные мультимножества. Нарушение скорости, вызванное необходимостью преобразования данных между внешним, внутренним представлением и представлением в кэш-памяти, примерно уравновешено уменьшенным количеством рекурсий.

Большое узкое место находится в select_best sub, который я в основном переписал в Inline::C (до сих пор кушает ~80% времени выполнения).

Эти проблемы выходят за рамки первоначального вопроса, поэтому я не буду вставлять сюда код, но, думаю, я сделаю проект доступным через github, как только я сгладлю морщины.

Источник
Другие вопросы по тегам