Perl实现带类别切换限制的伪随机列表生成方案问询

你提到的需求是要控制类别切换的频率——不能连续切换超过1次，必须连续3-5次同类别后才允许切换到其他类别，这个逻辑确实不能靠单纯的shuffle实现，需要先把条目按类别分组，再通过控制类别选择的规则来生成最终序列。下面是具体的实现方案：

核心思路拆解 #

1. 按类别分组存储：先把所有条目按color/number/shape拆分到不同的数组里，这样我们可以随时从指定类别中取元素，而且每个类别内部先打乱，保证同类别内的随机性。
2. 控制类别切换规则：维护两个状态变量：当前使用的类别、当前类别已连续使用的次数。每次选择下一个条目时：
   • 如果连续次数还没达到3-5的随机阈值，继续从当前类别取元素
   • 如果达到阈值，就随机选一个和当前类别不同的新类别，重置连续次数为1
3. 处理边界情况：如果某个类别已经没有剩余元素，自动切换到其他有剩余元素的类别。

修改后的完整脚本 #

#!/usr/bin/perl
# Perl script to generate input list for E-Prime experiment
# with semi-randomized trials (controlled category switching)
# Date: 2020-12-30
use strict;
use warnings;
use List::Util 'shuffle', 'sample';

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

# Generate headline
print $fh "Weight	Nested	Procedure	CardIMG1	CardIMG3	CardIMG4	CardStim	CorrectAnswer	TrialType\n";

# Original stimulus list (保留你原来的所有条目)
my @stimulus = (
    "BlueCross1.png	m	Color",
    "BlueCross2.png	m	Color",
    "BlueStar1.png	m	Color",
    "BlueStar3.png	m	Color",
    "BlueTriangle2.png	m	Color",
    "BlueTriangle3.png	m	Color",
    "GreenCircle1.png	v	Color",
    "GreenCircle3.png	v	Color",
    "GreenCircle1.png	v	Color",
    "GreenCircle3.png	v	Color",
    "GreenCross1.png 	v	Color",
    "GreenCross4.png	v	Color",
    "GreenTriangle3.png	v	Color",
    "GreenTriangle4.png	v	Color",
    "RedCircle2.png	c	Color",
    "RedCircle3.png	c	Color",
    "RedCross2.png	c	Color",
    "RedCross4.png	c	Color",
    "RedStar3.png	c	Color",
    "RedStar4.png	c	Color",
    "YellowCircle1.png	n	Color",
    "YellowCircle2.png	n	Color",
    "YellowStar1.png	n	Color",
    "YellowTriangle2.png	n	Color",
    "YellowTriangle4.png	n	Color",
    "BlueCross1.png	c	Number",
    "BlueCross2.png	v	Number",
    "BlueStar1.png	c	Number",
    "BlueStar3.png	n	Number",
    "BlueTriangle2.png	v	Number",
    "GreenCircle1.png	c	Number",
    "GreenCircle3.png	n	Number",
    "BlueCross1.png	m	Color",
    "BlueCross2.png	m	Color",
    "BlueStar1.png	m	Color",
    "BlueStar3.png	m	Color",
    "BlueTriangle2.png	v	Number",
    "BlueTriangle3.png	n	Number",
    "GreenCircle1.png	c	Number",
    "GreenCircle3.png	n	Number",
    "GreenCross1.png	c	Color",
    "GreenCross4.png	m	Color",
    "GreenTriangle3.png	n	Color",
    "GreenTriangle4.png	m	Color",
    "RedCircle2.png	v	Number",
    "RedCircle3.png	n	Number",
    "RedCross2.png	v	Number",
    "RedCross4.png	m	Number",
    "RedStar3.png	n	Color",
    "RedStar4.png	m	Color",
    "YellowCircle1.png	c	Color",
    "YellowCircle2.png	v	Color",
    "YellowStar1.png	c	Number",
    "YellowStar4.png	m	Number",
    "YellowTriangle2.png	v	Number",
    "YellowTriangle4.png	m	Number",
    "BlueCross1.png	n	Shape",
    "BlueCross2.png	n	Shape",
    "BlueStar1.png	v	Shape",
    "BlueStar3.png	v	Shape",
    "BlueTriangle2.png	c	Shape",
    "BlueTriangle3.png	c	Shape",
    "GreenCircle1.png	m	Shape",
    "GreenCircle3.png	m Shape",
    "GreenCross1.png	n	Shape",
    "GreenCross4.png	n	Shape",
    "GreenTriangle3.png	c	Shape",
    "GreenTriangle4.png	c	Shape",
    "RedCircle2.png	m	Shape",
    "RedCircle3.png	m	Shape",
    "RedCross2.png	n	Shape",
    "RedCross4.png	n	Shape",
    "RedStar3.png	v	Shape",
    "RedStar4.png	v	Shape",
    "YellowCircle1.png	m	Shape",
    "YellowCircle2.png	m	Shape",
    "YellowStar1.png	v	Shape",
    "YellowStar4.png	v	Shape",
    "YellowTriangle2.png	c	Shape",
    "YellowTriangle4.png	c	Shape"
);

# --------------------------
# 1. 按类别分组并打乱每个组的内部顺序
# --------------------------
my %category_groups;
foreach my $item (@stimulus) {
    # 拆分条目，兼容制表符或空格分隔，清理类别前后冗余空格
    my ($img, $letter, $category) = split /\s+/, $item;
    $category =~ s/^\s+|\s+$//g;
    push @{$category_groups{$category}}, "$img	$letter	$category";
}
# 打乱每个类别内部的条目顺序，保证同类别内随机
foreach my $cat (keys %category_groups) {
    @{$category_groups{$cat}} = shuffle(@{$category_groups{$cat}});
}

# --------------------------
# 2. 生成符合切换规则的序列
# --------------------------
my @final_sequence;
my $current_category;
my $current_streak = 0;
my $total_items = scalar @stimulus;

# 初始化第一个类别：随机选一个有元素的类别
my @available_cats = grep { scalar @{$category_groups{$_}} > 0 } keys %category_groups;
$current_category = sample(1, @available_cats);
$current_streak = 1;
push @final_sequence, pop @{$category_groups{$current_category}};

while (scalar @final_sequence < $total_items) {
    # 生成当前类别需要连续的次数（3-5次随机）
    my $max_streak = int(rand(3)) + 3; # 3,4,5中的随机数

    if ($current_streak < $max_streak && scalar @{$category_groups{$current_category}} > 0) {
        # 继续用当前类别
        push @final_sequence, pop @{$category_groups{$current_category}};
        $current_streak++;
    } else {
        # 需要切换类别：选一个和当前不同的、有剩余元素的类别
        @available_cats = grep { $_ ne $current_category && scalar @{$category_groups{$_}} > 0 } keys %category_groups;
        # 处理极端情况：只剩当前类别有元素了
        if (!@available_cats) {
            @available_cats = grep { scalar @{$category_groups{$_}} > 0 } keys %category_groups;
        }
        $current_category = sample(1, @available_cats);
        $current_streak = 1;
        push @final_sequence, pop @{$category_groups{$current_category}};
    }
}

# --------------------------
# 3. 输出到文件
# --------------------------
print $fh "1		" . "TrialProc	RedTriangle1.png	Greenstar2.png	YellowCross3.png	BlueCircle4.png		$_
" for @final_sequence;

# Close text file
close($fh);

# Print to terminal
print "Done\n";

关键部分说明 #

1. 类别分组：用哈希%category_groups存储每个类别的条目数组，拆分时兼容了制表符和空格分隔的情况，还处理了原脚本中个别条目的格式小问题。
2. 连续次数控制：每次切换前随机生成3-5的连续上限，保证每次连续次数不是固定值，更接近伪随机的要求。
3. 边界处理：如果某个类别用完了，自动切换到其他有元素的类别，避免出现无元素可取的报错情况。
4. 内部随机：每个类别内部先打乱，这样同类别内的条目顺序是随机的，不会出现固定重复的序列。

内容的提问来源于stack exchange，提问作者neuronain