#!/usr/bin/perl

################################################################
# Staring experiment simulator
# Author: Rudis Muiznieks (rudis@sitosis.com)
# Feel free to modify or share this code as you see fit, so long
# as you give me credit as being the original author.
################################################################

use strict;
use warnings;

# configuration
my $usesheldrake = 1; # set to 1 to use sheldrake's trial sequences, 0 to generate random
my $yesbias = 5; # % bias of subjects to say yes instead of no
my $experiments = 50; # number of independent experiments to run
my $subjects = 20; # number of individual subjects to simulate for each experiment (ignored for sheldrake sequences)
my $trials = 20; # number of trials to run for each subject (ignored for sheldrake sequences)
my $method = 2; # the guessing method employed by the subject
my $fallacyweight = 33; # the % liklihood that subject will change answer with each trigger when fallacy is enabled

# possible guess methods:
# 0: completely random (no feedback)
# 1: random with gambler's fallacy (no feedback)
# 2: random with gambler's fallacy (feedback)

# fallacy trigers
# method = 0: none
# method = 1: subject guesses the same thing they guessed last time
# method = 2: trial was the same kind of trial as the last time

# hard code sheldrake's trial sequences
my $extrials = [
[1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 1],
[1, 1, 1, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 1, 0, 1, 0],
[1, 1, 1, 1, 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 1, 0, 1, 1],
[0, 0, 1, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 1, 1],
[0, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 0],
[0, 1, 1, 1, 0, 0, 1, 0, 1, 1, 1, 0, 0, 1, 0, 1, 1, 0, 0, 1],
[1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 1, 0, 0, 0, 1, 0, 1, 1, 0],
[1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 1, 0, 1, 1, 1],
[0, 0, 0, 1, 1, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 0],
[0, 1, 1, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 1],
[0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, 0, 1, 1, 1, 0, 0, 1, 1],
[1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 1, 1, 1, 0, 0, 1, 1],
[1, 1, 0, 0, 1, 1, 0, 1, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 0, 1],
[0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1, 0, 1, 1, 1, 1],
[0, 0, 0, 0, 1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 0, 1, 0, 0, 1, 0],
[1, 1, 1, 1, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0, 1, 1, 0],
[0, 0, 1, 1, 0, 0, 0, 1, 0, 1, 0, 1, 1, 1, 1, 0, 0, 1, 0, 1],
[1, 0, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 1, 0, 1, 1, 0, 1, 1],
[0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 1, 1, 1, 1],
[0, 1, 1, 0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1]
];
if($usesheldrake == 1){
	$subjects = 20;
	$trials = 20;
}

# global counters
my $gstaretrials = 0; # counts how many of the trials were staring trials
my $gcorrectyes = 0; # counts how many staring trials where correctly guessed
my $gcorrectno = 0; # counts how many non-staring trials were correctly guessed
my @gsubjplus = (0, 0, 0); # count + subjects (subjects who got more right than wrong) for stare, non-stare, and total trials
my @gsubjminus = (0, 0, 0); # count - subjects (subjects who got more wrong than right) for stare, non-stare, and total trials

# start experiment loop
for(my $e = 0; $e < $experiments; $e++){

	# experiment counters
	my $staretrials = 0; # counts how many of the trials were staring trials
	my $correctyes = 0; # stores how many staring trials were correctly guessed
	my $correctno = 0; # stores how many non-staring trials were correctly guessed
	my @subjplus = (0, 0, 0); # count + subjects (subjects who got more right than wrong) for stare, non-stare, and total trials
	my @subjminus = (0, 0, 0); # count - subjects (subjects who got more wrong than right) for stare, non-stare, and total trials

	# start subject loop 
	for(my $s = 0; $s < $subjects; $s++){

		# histories
		my @trialtypes = (); # history of all previous trials
		my @guesses = (); # history of all previous guesses
		my $fallacyscore = 0; # stores the subject's cumulative gambler's fallacy weight over successive trials
		my $subjstaretrials = 0; # count how many trials are stare trials for this individual subject
		my $subjcorrectyes = 0; # keep track of correct yes guesses for this individual subject
		my $subjcorrectno = 0; # keep track of correct no guesses for this individual subject

		# start trial loop
		for(my $i = 0; $i < $trials; $i++){
			my $trialtype; # either get it from sheldrake's sequences, or randomly generate
			if($usesheldrake == 1){
				$trialtype = $extrials->[$s]->[$i];
			} else {
				$trialtype = int(rand(2)); # 0 will be non-staring, 1 will be staring
			}
			my $guess = int(rand(100)) + $yesbias + $fallacyscore; # 0-49 is a no guess, 50+ is a yes guess

			# add current trial and guess to subject's memory
			unshift @trialtypes, $trialtype;
			unshift @guesses, $guess;

			# adjust gambler's fallacy value according to fallacy type
			if($i > 0){ # ignore first trial, since there is no memory to work with
				if($method == 1){ # fallacy applied to own guesses (no feedback)
					if($guesses[0] == $guesses[1] && $guess == 0){ # if the last two guesses were both no
						$fallacyscore += $fallacyweight; # subject is more likely to say yes next time
					} elsif($guesses[0] == $guesses[1] && $guess == 1){ # if the last two guesses were both yes
						$fallacyscore -= $fallacyweight; # subject is more likely to say no next time
					} else { # if the last two guesses were different, fallacy resets
						$fallacyscore = 0;
					}
				} elsif($method == 2){ # fallacy applied to trial types (feedback)
					if($trialtypes[0] == $trialtypes[1] && $trialtype == 0){ # if the last two trials were both no
						$fallacyscore += $fallacyweight; # subject is more likely to say yes next time
					} elsif($trialtypes[0] == $trialtypes[1] && $trialtype == 1){ # if the last two trials were both yes
						$fallacyscore -= $fallacyweight; # subject is more likely to say no next time
					} else { # if the last two trials were different, fallacy resets
						$fallacyscore = 0;
					}
				}
			}

			# adjust scores if the guess was accurate
			if($trialtype == 0){
				if($guess < 50){
					$correctno++;
					$subjcorrectno++;
				}
			} else {
				$staretrials++;
				$subjstaretrials++;
				if($guess >= 50){
					$correctyes++;
					$subjcorrectyes++;
				}
			}
		}

		# adjust +/- subject counts based on whether this subject got more right or wrong
		# (subjects who got equal number right and wrong are ignored)

		# calculate for staring trials
		if($subjcorrectyes > $subjstaretrials - $subjcorrectyes){
			$subjplus[0]++;
		} elsif($subjcorrectyes < $subjstaretrials - $subjcorrectyes){
			$subjminus[0]++;
		}
		# calculate for non staring trials
		if($subjcorrectno > $trials - $subjstaretrials - $subjcorrectno){
			$subjplus[1]++;
		} elsif($subjcorrectno < $trials - $subjstaretrials - $subjcorrectno){
			$subjminus[1]++;
		}
		# calculate for total trials
		if($subjcorrectyes + $subjcorrectno > $trials - $subjcorrectyes - $subjcorrectno){
			$subjplus[2]++;
		} elsif($subjcorrectyes + $subjcorrectno < $trials - $subjcorrectyes - $subjcorrectno){
			$subjminus[2]++;
		}
	}

	# add to global tallies
	$gstaretrials += $staretrials;
	$gcorrectyes += $correctyes;
	$gcorrectno += $correctno;
	$gsubjplus[0] += $subjplus[0];
	$gsubjplus[1] += $subjplus[1];
	$gsubjplus[2] += $subjplus[2];
	$gsubjminus[0] += $subjminus[0];
	$gsubjminus[1] += $subjminus[1];
	$gsubjminus[2] += $subjminus[2];

	# print experiment results 
	my $totaltrials = $subjects * $trials;
	my $totalcorrect = $correctyes + $correctno;

	print "EXPERIMENT #$e\n";
	print "Trials run: $totaltrials\n";
	print "Staring trials: $staretrials\n";
	print "Correct yes guesses: $correctyes\n";
	print "Correct no guesses: $correctno\n";
	print "Total correct: $totalcorrect\n";
	print "+: Stare($subjplus[0]) Non-stare($subjplus[1]) Total($subjplus[2])\n";
	print "-: Stare($subjminus[0]) Non-stare($subjminus[1]) Total($subjminus[2])\n";
	print "==============================\n";
}
	
# print total results 
my $gtotaltrials = $subjects * $trials * $experiments;
my $gtotalcorrect = $gcorrectyes + $gcorrectno;

print "TOTAL RESULTS\n";
print "Trials run: $gtotaltrials\n";
print "Staring trials: $gstaretrials\n";
print "Correct yes guesses: $gcorrectyes\n";
print "Correct no guesses: $gcorrectno\n";
print "Total correct: $gtotalcorrect\n";
print "+: Stare($gsubjplus[0]) Non-stare($gsubjplus[1]) Total($gsubjplus[2])\n";
print "-: Stare($gsubjminus[0]) Non-stare($gsubjminus[1]) Total($gsubjminus[2])\n";