Twoje przykładowe dane i ograniczenia w rzeczywistości pozwalają tylko na kilka rozwiązań - na przykład musisz zagrać Johna B. Zakładam, że twoja pełna lista odtwarzania nie jest zasadniczo Johnem B, z losowymi innymi rzeczami, które mogą ją zepsuć .
To kolejne losowe podejście. W przeciwieństwie do rozwiązania @ frostschutz działa szybko. Nie gwarantuje to jednak, że wynik spełni twoje kryteria. Przedstawiam również drugie podejście, które działa na przykładowych danych - ale podejrzewam, że przyniesie złe wyniki na twoich prawdziwych danych. Mając twoje prawdziwe dane (zaciemnione), dodaję podejście 3 - które jest jednolite losowo, z tym wyjątkiem, że unika dwóch piosenek tego samego artysty z rzędu. Zauważ, że powoduje tylko 5 „wciągnięć” do „talii” pozostałych utworów, jeśli po tym nadal będzie musiał zmierzyć się ze zduplikowanym wykonawcą, i tak wyda ten utwór - w ten sposób gwarantuje to, że program faktycznie się zakończy.
Podejście 1
Zasadniczo generuje listę odtwarzania w każdym punkcie, pytając „z jakich artystów nadal mam nieodtwarzane utwory?” Następnie wybranie losowego artysty i wreszcie losowa piosenka tego artysty. (Oznacza to, że każdy artysta ma jednakową wagę, nieproporcjonalną do liczby utworów).
Wypróbuj swoją playlistę i sprawdź, czy przynosi lepsze wyniki niż jednolicie losowy.
Zastosowanie:./script-file < input.m3u > output.m3u
Oczywiście, upewnij się chmod +x
. Zauważ, że nie obsługuje poprawnie linii podpisu znajdującej się na górze niektórych plików M3U ... ale twój przykład tego nie miał.
#!/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};
}
Podejście 2
Jako drugie podejście, zamiast wybierania losowego artysty , możesz użyć wybrania wykonawcy z największą liczbą piosenek, który nie jest również ostatnim artystą, którego wybraliśmy . Ostatni akapit programu staje się następnie:
# 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};
}
Reszta programu pozostaje taka sama. Zauważ, że zdecydowanie nie jest to najskuteczniejszy sposób na zrobienie tego, ale powinno być wystarczająco szybkie dla list odtwarzania o rozsądnych rozmiarach. Na podstawie przykładowych danych wszystkie wygenerowane listy odtwarzania zaczną się od piosenki Johna B., potem piosenki Anny A., a następnie piosenki Johna B. Potem jest to znacznie mniej przewidywalne (ponieważ wszyscy oprócz Johna B. ma jeszcze jedną piosenkę). Zauważ, że zakłada to Perl 5.7 lub nowszy.
Podejście 3
Użycie jest takie samo jak w poprzednim 2. Zwróć uwagę na 0..4
część, z której pochodzi 5 maks. Prób. Możesz zwiększyć liczbę prób, np. 0..9
Dałbyś 10 ogółem. ( 0..4
= 0, 1, 2, 3, 4
, które zauważysz, to w rzeczywistości 5 pozycji).
#!/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);
}