Sus datos y restricciones de ejemplo en realidad solo permiten algunas soluciones: debe tocar John B. en cualquier otra canción, por ejemplo. Asumiré que tu lista de reproducción completa real no es esencialmente John B, con otras cosas al azar para dividirla .
Este es otro enfoque aleatorio. A diferencia de la solución de @ frostschutz, se ejecuta rápidamente. Sin embargo, no garantiza un resultado que coincida con sus criterios. También presento un segundo enfoque, que funciona en sus datos de ejemplo, pero sospecho que producirá malos resultados en sus datos reales. Con sus datos reales (ofuscados), agrego el enfoque 3, que es un azar uniforme, excepto que evita dos canciones del mismo artista en una fila. Tenga en cuenta que solo hace 5 "sorteos" en el "mazo" de las canciones restantes, si después de eso todavía se enfrenta a un artista duplicado, emitirá esa canción de todos modos, de esta manera, se garantiza que el programa realmente terminará.
Enfoque 1
Básicamente, genera una lista de reproducción en cada punto, preguntando "¿de qué artistas todavía tengo canciones sin reproducir?" Luego elegir un artista al azar, y finalmente una canción al azar de ese artista. (Es decir, cada artista tiene una ponderación igual, no en proporción al número de canciones).
Pruébelo en su lista de reproducción real y vea si produce mejores resultados que al azar uniforme.
Uso:./script-file < input.m3u > output.m3u
Asegúrese de chmod +x
ello, por supuesto. Tenga en cuenta que no maneja la línea de firma que está en la parte superior de algunos archivos M3U correctamente ... pero su ejemplo no tenía eso.
#!/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};
}
Enfoque 2
Como segundo enfoque, en lugar de elegir un artista al azar , puede usar elegir el artista con más canciones, que tampoco es el último artista que elegimos . El párrafo final del programa se convierte en:
# 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};
}
El resto del programa permanece igual. Tenga en cuenta que esta no es la forma más eficiente de hacerlo, pero debería ser lo suficientemente rápida para listas de reproducción de cualquier tamaño razonable. Con sus datos de ejemplo, todas las listas de reproducción generadas comenzarán con una canción de John B., luego una canción de Anna A., luego una canción de John B. Después de eso, es mucho menos predecible (ya que a todos menos a John B. le queda una canción). Tenga en cuenta que esto supone Perl 5.7 o posterior.
Enfoque 3
El uso es el mismo que el anterior 2. Tenga en cuenta la 0..4
parte, de ahí proviene el máximo de 5 intentos. Podría aumentar el número de intentos, por ejemplo, 0..9
daría 10 en total. ( 0..4
= 0, 1, 2, 3, 4
, lo que notarás es en realidad 5 elementos).
#!/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);
}