随机随机播放文件，并带有一些额外的约束

Question

我有一个庞大的音乐播放列表，虽然有些艺术家有很多专辑，但其他人只有一首歌。我想对播放列表进行排序，这样同一位艺术家就不会连续播放两次，或者他的歌曲不会大部分出现在播放列表的开头或结尾。

示例播放列表：

$ cat /tmp/playlist.m3u
Anna A. - Song 1
Anna A. - Song 2
I--Rock - Song 1
John B. - Song 1
John B. - Song 2
John B. - Song 3
John B. - Song 4
John B. - Song 5
Kyle C. - Song 1
U--Rock - Song 1

来自sort -R或 的输出shuf：

$ sort -R /tmp/playlist.m3u
Anna A. - Song 1 #
U--Rock - Song 1
Anna A. - Song 2 # Anna's songs are all in the beginning.
John B. - Song 2
I--Rock - Song 1
John B. - Song 1
Kyle C. - Song 1
John B. - Song 4 #
John B. - Song 3 #
John B. - Song 5 # Three of John's songs in a row.

我期待的是：

$ some_command /tmp/playlist.m3u
John B. - Song 1
Anna A. - Song 1
John B. - Song 2
I--Rock - Song 1
John B. - Song 3
Kyle C. - Song 1
Anna A. - Song 2
John B. - Song 4
U--Rock - Song 1
John B. - Song 5

Answer 1

您的示例数据和约束实际上只允许几个解决方案 - 例如，您必须每隔一首歌播放 John B.。我将假设您实际的完整播放列表本质上不是John B，而是随机添加其他内容来分解它。

这是另一种随机方法。与@frostschutz 的解决方案不同，它运行速度很快。但是，它不能保证结果符合您的标准。我还介绍了第二种方法，它适用于您的示例数据 - 但我怀疑会对您的真实数据产生不良结果。有了你的真实数据（混淆），我添加了方法 3——这是一个统一的随机，除了它避免了同一艺术家连续的两首歌曲。请注意，它只会在剩余歌曲的“deck”中进行 5 次“绘制”，如果之后它仍然面临重复的艺术家，它无论如何都会输出那首歌曲——这样，它保证程序会真正完成。

方法一

基本上，它会在每个点生成一个播放列表，询问“我还有哪些艺术家未播放的歌曲？” 然后随机选择一位艺术家，最后是该艺术家的一首随机歌曲。（也就是说，每个艺术家的权重相等，而不是与歌曲数量成正比。）

在你的实际播放列表上试一试，看看它是否比均匀随机产生更好的结果。

用法：./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};
}

方法二

作为第二种方法，您可以使用选择歌曲最多的艺术家，而不是随机选择一位艺术家，该艺术家也不是我们选择的最后一位艺术家。然后程序的最后一段变成：

# 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};
}

程序的其余部分保持不变。请注意，到目前为止，这并不是最有效的方法，但对于任何合理大小的播放列表来说，它应该足够快。使用您的示例数据，所有生成的播放列表将以 John B. 歌曲开头，然后是 Anna A. 歌曲，然后是 John B. 歌曲。在那之后，它的可预测性要小得多（因为除了约翰 B. 之外，每个人都只剩下一首歌了）。请注意，这假定 Perl 5.7 或更高版本。

方法三

用法与之前的 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);
}

Answer 2

如果我必须将这种洗牌应用于一副扑克牌，我想我会先洗牌，然后在我眼前排成一排，从左到右处理，只要有相邻的俱乐部或心脏。 . 将除其中一个以外的所有其他对象随机移动到其他地方（尽管不在同一类型的另一个旁边）。

例如，用一只手

基本洗牌后：

     <  >< >   
                   1  2       3

两组相邻的黑桃，我们需要重新定位1、2和3。对于1，选择有：

               
    ?        ?                    ?        ?

我们从这 4 个中随机选择一个。 然后我们重复 2 和 3 的过程。

实施的perl将是：

shuf list | perl -e '
  @songs = map {/(.*?)-/; [$1,$_]} <>;
  for ($i = 0; $i < @songs; $i++) {
    if (($author = $songs[$i]->[0]) eq $previous) {
      my @reloc_candidates, $same;
      for($j = 0; $j < @songs; $j++) {
        # build a list of positions where we could move that song to
        if ($songs[$j]->[0] eq $author) {$same = 1} else {
          push @reloc_candidates, $j unless $same;
          $same = 0;
        }
      }
      push @reloc_candidates, $j unless $same;

      if (@reloc_candidates) {
        # now pick one of them at random:
        my $chosen = $reloc_candidates[int(rand(@reloc_candidates))];
        splice @songs, $chosen - ($chosen > $i), 0, splice @songs, $i, 1;
        $i -= $chosen > $i;
      }
    }
    $previous = $author;
  }
  print map {$_->[1]} @songs'

如果存在，它将找到与非相邻艺术家的解决方案（除非超过一半的歌曲来自同一艺术家），并且应该是统一的 AFAICT。