在Perl中生成伪随机列表

Question

我有一个包含79个条目的列表，每个条目看起来都类似于以下内容：

"YellowCircle1.png\tc\tColor"

也就是说，每个条目都有3个元素(..png file、一个字母和一个类别)。类别可以是颜色、数字或形状。

我想从这里创建一个新的列表，伪随机化。也就是说，我希望所有79个条目都是随机的，但有一个限制。

我已经为一个完全随机的版本创建了一个perl脚本，使用的是混洗：

# !/usr/bin/perl
# Perl script to generate input list for E-Prime experiment
# with semi-randomized trials
# Date: 2020-12-30

# Open text file
$filename = 'output_shuffled.txt';
open($fh, '>', $filename) or die "Could not open file '$filename'";

# Generate headline
print $fh "Weight\tNested\tProcedure\tCardIMG1\tCardIMG3\tCardIMG4\tCardStim\tCorrectAnswer\tTrialType\n";

# Array with list of stimuli including corresponding correct response and trial type
@stimulus = (
"BlueCross1.png\tm\tColor",
"BlueCross2.png\tm\tColor",
"BlueStar1.png\tm\tColor",
"BlueStar3.png\tm\tColor",
"BlueTriangle2.png\tm\tColor",
"BlueTriangle3.png\tm\tColor",
"GreenCircle1.png\tv\tColor",
"GreenCircle3.png\tv\tColor",
"GreenCircle1.png\tv\tColor",
"GreenCircle3.png\tv\tColor",
"GreenCross1.png \tv\tColor",
"GreenCross4.png\tv\tColor",
"GreenTriangle3.png\tv\tColor",
"GreenTriangle4.png\tv\tColor",
"RedCircle2.png\tc\tColor",
"RedCircle3.png\tc\tColor",
"RedCross2.png\tc\tColor",
"RedCross4.png\tc\tColor",
"RedStar3.png\tc\tColor",
"RedStar4.png\tc\tColor",
"YellowCircle1.png\tn\tColor",
"YellowCircle2.png\tn\tColor",
"YellowStar1.png\tn\tColor",
"YellowTriangle2.png\tn\tColor",
"YellowTriangle4.png\tn\tColor",
"BlueCross1.png\tc\tNumber",
"BlueCross2.png\tv\tNumber",
"BlueStar1.png\tc\tNumber",
"BlueStar3.png\tn\tNumber",
"BlueTriangle2.png\tv\tNumber",
"GreenCircle1.png\tc\tNumber",
"GreenCircle3.png\tn\tNumber",
"BlueCross1.png\tm\tColor",
"BlueCross2.png\tm\tColor",
"BlueStar1.png\tm\tColor",
"BlueStar3.png\tm\tColor",
"BlueTriangle2.png\tv\tNumber",
"BlueTriangle3.png\tn\tNumber",
"GreenCircle1.png\tc\tNumber",
"GreenCircle3.png\tn\tNumber",
"GreenCross1.png\tc\tColor",
"GreenCross4.png\tm\tColor",
"GreenTriangle3.png\tn\tColor",
"GreenTriangle4.png\tm\tColor",
"RedCircle2.png\tv\tNumber",
"RedCircle3.png\tn\tNumber",
"RedCross2.png\tv\tNumber",
"RedCross4.png\tm\tNumber",
"RedStar3.png\tn\tColor",
"RedStar4.png\tm\tColor",
"YellowCircle1.png\tc\tColor",
"YellowCircle2.png\tv\tColor",
"YellowStar1.png\tc\tNumber",
"YellowStar4.png\tm\tNumber",
"YellowTriangle2.png\tv\tNumber",
"YellowTriangle4.png\tm\tNumber",
"BlueCross1.png\tn\tShape",
"BlueCross2.png\tn\tShape",
"BlueStar1.png\tv\tShape",
"BlueStar3.png\tv\tShape",
"BlueTriangle2.png\tc\tShape",
"BlueTriangle3.png\tc\tShape",
"GreenCircle1.png\tm\tShape",
"GreenCircle3.png\tm Shape",
"GreenCross1.png\tn\tShape",
"GreenCross4.png\tn\tShape",
"GreenTriangle3.png\tc\tShape",
"GreenTriangle4.png\tc\tShape",
"RedCircle2.png\tm\tShape",
"RedCircle3.png\tm\tShape",
"RedCross2.png\tn\tShape",
"RedCross4.png\tn\tShape",
"RedStar3.png\tv\tShape",
"RedStar4.png\tv\tShape",
"YellowCircle1.png\tm\tShape",
"YellowCircle2.png\tm\tShape",
"YellowStar1.png\tv\tShape",
"YellowStar4.png\tv\tShape",
"YellowTriangle2.png\tc\tShape",
"YellowTriangle4.png\tc\tShape",
);

# Shuffle --> Pick at random without double entries
use List::Util 'shuffle';
@shuffled = shuffle(@stimulus);

# Print each line with fixed values and shuffled stimulus entries to file
print $fh "1\t" . "\t" . "TrialProc\t" . "RedTriangle1.png\t" . "Greenstar2.png\t" . "YellowCross3.png\t" . "BlueCircle4.png\t" . "\t$_\n" for @shuffled;

# Close text file
close($fh);

# Print to terminal
print "Done\n";

然而，我最终想要的是，这个类别不会连续切换一次，而是每3到5次(在这些数字之间随机切换一次)。例如，如果一行以“形状”结尾，而下一行以“颜色”结尾，则下一行必须是“颜色”，因为否则将有两个连续的开关。

我该怎么创造这个？我怀疑我必须将条目更改为类似于散列的内容，这样我就可以根据每个条目的最后一个元素(即“类别”)创建if-构造了吗？

Answer 1

解决方案--正如您已经猜到的--是拆分数据并重新调整不符合您的规则的部分。

下面是实现这一目的的代码。

# Shuffle --> Pick at random without double entries
use List::Util 'shuffle';
my @data = shuffle(map {[split("\t")]} @stimulus);
my @result, %used;
my $next = 0;
while (@result < @data) {
    my $pick = pick($next);
    if ($pick >= 0) {
        push @result, $pick;
        $used{$pick} = 1;
        $next = 0;
    } elsif (@result == 0) {
        die "no valid solution found"
    } else {
        ## backtrack
        print ".";
        $next = pop( @result )+1;
        $used{$next-1} = 0;
    }
}
my @shuffled = map {join("\t", @{$data[$_]})} @result;

如果没有找到解决方案，则使用回溯。(这是非常低效率的-改组可能会更好)

它使用一个子选择，它返回下一个拟合项的索引。(如有可能)

sub pick {
    my $next_element = shift;
    foreach my $element ($next_element .. $#data)  {
        next if $used {$element};
        my $type = $data[$element][2];
        if( $data[$result[-1]][2] eq $type ){
            if (@result >3) {
                next 
                    if ($type eq $data[$result[-2]][2] && 
                        $type eq $data[$result[-3]][2] && 
                        $type eq $data[$result[-4]][2] )
            }
        } else {
            if (@result >1) {
                next 
                    if ($data[$result[-1]][2] ne $data[$result[-2]][2]);
            }
        }
        return $element;
    }
    return -1;
}

在分机里

 if( $data[$result[-1]][2] eq $type ){
        if (@result >3) {
            next 
                if ($type eq $data[$result[-2]][2] && 
                    $type eq $data[$result[-3]][2] && 
                    $type eq $data[$result[-4]][2] )
        }

在一行中不允许同一类型的5倍。如果你只想诋毁6倍于同一类型，你必须将它更改为

if( $data[$result[-1]][2] eq $type ){
        if (@result >4) {
            next 
                if ($type eq $data[$result[-2]][2] && 
                    $type eq $data[$result[-3]][2] && 
                    $type eq $data[$result[-4]][2] && 
                    $type eq $data[$result[-5]][2] )
        }

守则：

        if (@result >1) {
            next 
                if ($data[$result[-1]][2] ne $data[$result[-2]][2]);
        }

强制3倍(至少)相同的类型。如果您想将此更改为4次，则必须使用

        if (@result >2) {
            next 
                if ($data[$result[-1]][2] ne $data[$result[-2]][2] 
                   || $data[$result[-1]][2] ne $data[$result[-3]][2]);
        }