在 Perl 中生成伪随机列表

时间:2020-12-30 09:58:36

标签: list perl random

我有一个包含 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 次(在这些数字之间随机切换)。例如,如果一行以“形状”结尾,下一行以“颜色”结尾,则下一行必须是“颜色”,否则会连续出现 2 个开关。

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

1 个答案:

答案 0 :(得分:3)

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

这是执行此操作的代码。

# 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 次相同类型。如果你只想dissalow 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]);
        }