随机打乱文件并带有一些附加约束

Question 1

您的示例数据和约束实际上只允许几种解决方案 - 例如，您必须每隔一首歌播放 John B.。我假设你的实际完整播放列表本质上不是John B，用随机的其他东西来打破它。

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

方法一

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

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

用法：./script-file < input.m3u > output.m3uchmod +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};
}

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

方法3

用法与前面的 2 相同。注意这0..4部分，这就是 5 attempts max 的来源。您可以增加尝试次数，例如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

您的示例数据和约束实际上只允许几种解决方案 - 例如，您必须每隔一首歌播放 John B.。我假设你的实际完整播放列表本质上不是John B，用随机的其他东西来打破它。

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

方法一

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

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

用法：./script-file < input.m3u > output.m3uchmod +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};
}

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

方法3

用法与前面的 2 相同。注意这0..4部分，这就是 5 attempts max 的来源。您可以增加尝试次数，例如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);
}

Question 2

如果我必须将这种洗牌应用于一副扑克牌，我想我会首先洗牌，然后将牌在我眼前排成一排，并从左到右处理，无论是否有相邻的梅花或红心。 . 将除其中一个之外的所有内容随机移动到其他位置（尽管不是与同一类型的另一个相邻）。

例如，用一只手

Answer

如果我必须将这种洗牌应用于一副扑克牌，我想我会首先洗牌，然后将牌在我眼前排成一排，并从左到右处理，无论是否有相邻的梅花或红心。 . 将除其中一个之外的所有内容随机移动到其他位置（尽管不是与同一类型的另一个相邻）。

例如，用一只手

Question 3

如果你不介意它效率极低的话......

while [ 1 ]
do
    R="`shuf playlist`"
    D="`echo "$R" | sed -e 's/ - .*//' | uniq -c -d`"
    if [ "$D" == "" ]
    then
        break
    #else # DEBUG ONLY:
    #    echo --- FAIL: ---
    #    echo "$D"
    #    echo -------------
    fi
done

echo "$R"

它只是不断滚动，直到得到一个没有连续两个或更多约翰的结果。如果您的播放列表中有太多约翰，以至于这样的组合不存在或极不可能滚动，那么它就会挂起。

您输入的结果示例：

John B. - Song 4
Kyle C. - Song 1
Anna A. - Song 2
John B. - Song 3
Anna A. - Song 1
John B. - Song 1
U--Rock - Song 1
John B. - Song 2
I--Rock - Song 1
John B. - Song 5

如果您取消注释调试行，它会告诉您失败的原因：

--- FAIL: ---
      3 John B.
-------------
--- FAIL: ---
      2 John B.
      2 John B.
-------------

如果它无限期挂起，这应该有助于确定原因。

Answer