在 Perl 中生成伪随机列表

Generate pseudo-random list in Perl

我有一个包含 79 个条目的列表,每个条目看起来都与此类似:

"YellowCircle1.png\tc\tColor"

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

我想以此创建一个新列表,伪随机化。也就是说,我想随机排列所有 79 个条目,但有一个限制。

我已经使用 shuffle 创建了一个完全随机版本的 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次(随机在这些数字之间)。例如,如果一行以“shape”结尾,下一行以“color”结尾,则下一行必须是“color”,否则将连续出现 2 个开关。

我将如何创建它?我怀疑我必须将条目更改为散列之类的东西,以便我可以根据每个条目的最后一个元素(即“类别”)创建 if 结构?

正如您已经猜到的那样,解决方案是拆分数据并重新排列不符合您规则的部分。

这是执行该操作的代码。

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

如果找不到解决方案,则使用回溯。 (这是非常低效的 - 重新洗牌可能会更好)

它使用一个子选择,returns 下一个配件条目的索引。 (如果可能的话)

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]);
        }