Ваши примеры данных и ограничения на самом деле допускают только несколько решений - например, вы должны играть Джона Б. каждую другую песню. Я собираюсь предположить, что ваш настоящий полный плейлист не является по сути Джоном Б. со случайным другим материалом, чтобы разбить его .
Это еще один случайный подход. В отличие от решения @ frostschutz, оно работает быстро. Однако это не гарантирует результат, который соответствует вашим критериям. Я также представляю второй подход, который работает с данными вашего примера, но я подозреваю, что он даст плохие результаты на ваших реальных данных. Имея ваши реальные данные (обфусцированные), я добавляю подход 3 - который является равномерным случайным, за исключением того, что он избегает двух песен одного исполнителя подряд. Обратите внимание, что он делает только 5 «дро» в «колоду» оставшихся песен, если после этого он все еще сталкивается с дублирующим исполнителем, он все равно выведет эту песню - таким образом, он гарантированно завершит программу.
Подход 1
По сути, он генерирует плейлист в каждой точке, спрашивая, «от каких исполнителей у меня до сих пор нетигранные песни?» Затем выбираем случайного исполнителя и, наконец, случайную песню этого исполнителя. (То есть каждый исполнитель имеет одинаковый вес, не пропорционально количеству песен.)
Попробуйте его в своем плейлисте и посмотрите, дает ли он лучшие результаты, чем случайный.
Использование:./script-file < input.m3u > output.m3u
Убедитесь в chmod +x
этом, конечно. Обратите внимание, что он не обрабатывает строку подписи, которая находится в верхней части некоторых файлов M3U ... но в вашем примере этого не было.
#!/usr/bin/perl
use warnings qw(all);
use strict;
use List::Util qw(shuffle);
# split the input playlist by artist
my %by_artist;
while (defined(my $line = <>)) {
my $artist = ($line =~ /^(.+?) - /)
? $1
: 'UNKNOWN';
push @{$by_artist{$artist}}, $line;
}
# sort each artist's songs randomly
foreach my $l (values %by_artist) {
@$l = shuffle @$l;
}
# pick a random artist, spit out their "last" (remeber: in random order)
# song, remove from the list. If empty, remove artist. Repeat until no
# artists left.
while (%by_artist) {
my @a_avail = keys %by_artist;
my $a = $a_avail[int rand @a_avail];
my $songs = $by_artist{$a};
print pop @$songs;
@$songs or delete $by_artist{$a};
}
Подход 2
В качестве второго подхода вместо выбора случайного исполнителя можно выбрать исполнителя с большинством песен, который также не является последним выбранным исполнителем . Последний пункт программы становится:
# pick the artist with the most songs who isn't the last artist, spit
# out their "last" (remeber: in random order) song, remove from the
# list. If empty, remove artist. Repeat until no artists left.
my $last_a;
while (%by_artist) {
my %counts = map { $_, scalar(@{$by_artist{$_}}) } keys %by_artist;
my @sorted = sort { $counts{$b} <=> $counts{$a} } shuffle keys %by_artist;
my $a = (1 == @sorted)
? $sorted[0]
: (defined $last_a && $last_a eq $sorted[0])
? $sorted[1]
: $sorted[0];
$last_a = $a;
my $songs = $by_artist{$a};
print pop @$songs;
@$songs or delete $by_artist{$a};
}
Остальная часть программы остается прежней. Обратите внимание, что это далеко не самый эффективный способ сделать это, но он должен быть достаточно быстрым для плейлистов любого нормального размера. С вашими примерами все сгенерированные плейлисты начнутся с песни Джона Б., затем песни Анны А., затем песни Джона Б. После этого все гораздо менее предсказуемо (поскольку у всех, кроме Джона Б., осталась одна песня). Обратите внимание, что это предполагает Perl 5.7 или новее.
Подход 3
Использование такое же, как и в предыдущем 2. Обратите внимание на 0..4
часть, откуда берется максимум 5 попыток. Вы можете увеличить количество попыток, например, 0..9
даст 10 всего. ( 0..4
= 0, 1, 2, 3, 4
, который вы заметите, на самом деле это 5 пунктов).
#!/usr/bin/perl
use warnings qw(all);
use strict;
# read in playlist
my @songs = <>;
# Pick one randomly. Check if its the same artist as the previous song.
# If it is, try another random one. Try again 4 times (5 total). If its
# still the same, accept it anyway.
my $last_artist;
while (@songs) {
my ($song_idx, $artist);
for (0..4) {
$song_idx = int rand @songs;
$songs[$song_idx] =~ /^(.+?) - /;
$artist = $1;
last unless defined $last_artist;
last unless defined $artist; # assume unknown are all different
last if $last_artist ne $artist;
}
$last_artist = $artist;
print splice(@songs, $song_idx, 1);
}