Generate pseudo-random list in Perl

user_13981987 0
Viewed 142

I have a list with 79 entries that each look similar to this:

"YellowCircle1.png\tc\tColor"

That is, each entry has 3 elements (.png-file, a letter, and a category). The category can be color, number or shape.

I want to create a new list from this, pseudo-randomized. That is, I want to have all 79 entries in a random order, but with a limitation.

I have created a perl script for a completely random version using shuffle:

# !/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";

However, what I eventually want is that the category does not switch more than once successively, but every 3 up to 5 times (randomly between these numbers). For example, if one line ends with "shape" and the following line with "color", the next line would have to be "color", because otherwise there would be 2 switches successively.

How would I create this? I suspect I would have to change the entries to something like hashes, so that I can create if-constructions based on the last element (that is "category") of each entry?

perl list random
1 Answers

The solution - as you already guessed - is to split the data and reshuffle the parts that dont fit with your rules.

Here is the code that does that.

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

using backtracking if no solution is found. (This is highly inefficient - a reshuffling would probably be better)

It uses a sub pick which returns the index of a next fitting entry. (If possibe)

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

In the sub pick

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

disallows 5 times the same type in a row. If you want only to dissalow 6 times the same type you have to change it to

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

The code:

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

enforces 3 times (at least) the same type. If you want to change this to 4 times you have to use

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