# # This is perl program "RMCLS.pl" (Reward-Modulated Combination Learning System) that simulates the system described in Section 6 # of the article "Neuron as a reward-modulated combinatorial switch and a model of learning behavior", Marat M. Rvachev, # Neural Networks 46 (2013) 62-74, DOI: 10.1016/j.neunet.2013.04.010 # http://www.sciencedirect.com/science/article/pii/S0893608013001263 # http://arxiv.org/abs/1109.4140 # # Command line arguments: $clusterSize (denoted "n_c" in the article), $numClusters ("N_c"), $numClustersToFire ("M"), # $randomNeuronFiring (flag determining if the trial neuron firing is random or round-robin), # $numSimulations (the number of simulations to average over), $outputFile (the output file name) # # When run with various arguments the program produces results of Section 6 of the paper. # For example, executing "RMCLS.pl 1 48 6 0 1000 outputFile" produces the black curve # in Figure 15(b). # # A list of commands to produce results in Section 6 is in the file "run_RMCLS.txt" # # Author: Marat M. Rvachev, 2013 # # Copyright: free for use, modification and re-use with reference to the author $inputNeurons = 12; # The number of input neurons (denoted "N_i" in the article) $outputNeurons = 3; # The number of output neurons ("N_o") $clusterSize = 4; # The number of synapses in a synaptic cluster ("n_c", default is 4) $numClusters = 10000; # The number of synaptic clusters on an output neuron ("N_c", default is 10,000) if ($ARGV[0] > 0){$clusterSize = $ARGV[0]; $numClusters = $ARGV[1]; } $totalLearningObjectPresentations = 168; # The total number of learning object presentations (high enough not to matter). Use 240 to reproduce Figure 15(a) results $numTestObjects = 4; # The number of testing objects $weakPositiveReward = 0.1; # The reward for pushing an object off the table $strongPositiveReward = 0.25; # The reward for eating an apple $strongNegativeReward = -1; # Flag to reset excited cluster weights to 0 if negative reward is received $numClustersToFire = 70; # The number of excited clusters with the weight at least 1 that make a motor neuron fire ("M", default is 70) $randomNeuronFiring = 0; # 0: The motor neurons are fired in round robin in the trial firings; 1: random motor neurons are fired in the trial firings (default is 0) $numSimulations = 1000; # The total number of simulations to average over (default is 1,000) $outputFile = "outputFile.txt"; # Default output file if ($ARGV[0] > 0){$numClustersToFire = $ARGV[2]; $randomNeuronFiring = $ARGV[3]; $numSimulations = $ARGV[4]; $outputFile = $ARGV[5]; } $verbose = 1; # Flag for expanded on screen output $verbose2 = 0; # Second flag for expanded on screen output if ($verbose || $verbose2) { print "Command line arguments: n_c, N_c, M, randomNeuronFiringFlag, numSimulations, outputFile\n"; } # Input neuron definitions (this is for illustration, these arrays are not used) @round = (0,0,0,0,1,0,0,0,0,0,0,0); # "x_1" in the paper @symmetrical = (0,0,0,0,0,1,0,0,0,0,0,0); # "x_2" @hasStemOnTop = (0,0,1,0,0,0,0,0,0,0,0,0); # "x_3" @noStemOnTop = (0,0,0,1,0,0,0,0,0,0,0,0); # "x_4" @smoothSurface = (1,0,0,0,0,0,0,0,0,0,0,0); # "x_5" @roughSurface = (0,1,0,0,0,0,0,0,0,0,0,0); # "x_6" @small = (0,0,0,0,0,0,0,0,0,1,0,0); # "x_7" @medium = (0,0,0,0,0,0,0,0,0,0,1,0); # "x_8" @large = (0,0,0,0,0,0,0,0,0,0,0,1); # "x_9" @red = (0,0,0,0,0,0,1,0,0,0,0,0); # "x_10" @yellow = (0,0,0,0,0,0,0,1,0,0,0,0); # "x_11" @green = (0,0,0,0,0,0,0,0,1,0,0,0); # "x_12" # Output neuron definitions (this is for illustration, these arrays are not used) @eat = (1,0,0); # Eat ("y_1") @pushOffTheTable = (0,1,0); # Push an object off the table ("y_2") @doNothing = (0,0,1); # Do nothing ("y_3") # Learning objects that are presented to the subject: $objects[0] = [1,0,1,0,1,1,1,0,0,1,0,0]; # small red apple $objects[1] = [0,1,0,1,1,1,0,1,0,0,0,1]; # large yellow stone $objects[2] = [1,0,1,0,1,1,0,1,0,0,1,0]; # medium yellow apple $objects[3] = [0,1,0,1,1,1,0,0,1,0,1,0]; # medium green stone $objects[4] = [1,0,1,0,1,1,0,1,0,1,0,0]; # small yellow apple $objects[5] = [0,1,0,1,1,1,0,0,1,0,0,1]; # large green stone $objects[6] = [1,0,1,0,1,1,1,0,0,0,1,0]; # medium red apple $objects[7] = [0,1,0,1,1,1,0,1,0,0,1,0]; # medium yellow stone # Objects used to test if the subject would make correct actions if they were presented: $testObjects[0] = [1,0,1,0,1,1,0,0,1,0,0,1]; # large green apple $testObjects[1] = [1,0,1,0,1,1,1,0,0,0,0,1]; # large red apple $testObjects[2] = [0,1,0,1,1,1,1,0,0,1,0,0]; # small red stone $testObjects[3] = [0,1,0,1,1,1,0,1,0,0,1,0]; # medium yellow stone srand(12345678); # Set the random number seed for($iSimulation = 1; $iSimulation <= $numSimulations; $iSimulation++){ # Loop over $numSimulations random instances of the subjects my $flagPassedAll4Tests, $flagPushedOffApplesAndStones, $flagDidNotLearnOneAnswer; # Various variables describing performance on the tests # Hash "clusters" stores the synaptic clusters and their weights (the maximum number of synapses in a cluster in this program is 4). # Format: %clusters{output neuron #}{input #1}{input #2}{input #3}{input #4} = 1 + weight. The value V of at least 1 means that a cluster # exists on the motor neuron "output neuron #" with synapses coming from input neurons #1, #2, #3 and #4; the cluster weight is (V-1). # Hash "clustersCtr" counts the number of idential clusters on the same output neuron (note such clusters will always have the same weight). Format: # $clustersCtr{output neuron #}{input #1}{input #2}{input #3}{input #4} -- the number of clusters on the motor neuron "output neuron #" that # have synapses coming from input neurons #1, #2, #3 and #4. The counter has base 0, e.g., the value of 1 means there are 2 identical clusters. undef %clusters; undef %clustersCtr; %clusters = {}, %clustersCtr = {}; generateClusters(); # Randomly generate the synaptic clusters my $iMotorNeuronFiring = 0; for(my $iLearningTime = 1; $iLearningTime <= $totalLearningObjectPresentations; $iLearningTime++){ # Loop over learning objects, counter with base 1 my @object = (); my $iObjectNum = int(rand(8)); # Randomly select the learning object shown to the subject @object = @{$objects[$iObjectNum]}; my @firingOutputNeurons = @{getFiringOutputNeurons (\@object)}; # Get array of activated outputs in response to the object $flagTrialFiring = 0; if ( $firingOutputNeurons[0] + $firingOutputNeurons[1] + $firingOutputNeurons[2] == 0){ # If no neurons fire, generate a trial firing, random or round-robin if ($randomNeuronFiring == 1) { $iMotorNeuronFiring = int(rand(3)); }else{ $iMotorNeuronFiring++; if ($iMotorNeuronFiring == 3 ) {$iMotorNeuronFiring = 0;} } $firingOutputNeurons[$iMotorNeuronFiring] = 1; $flagTrialFiring = 1; # Flag indicates this is a trial (non-memorized) firing } $reward = getReward (\@object, \@firingOutputNeurons); # Get reward for the action updateClusters ($reward, \@object, \@firingOutputNeurons); # Update synaptic cluster weights with the consequences of rewards # Various counters for how the subject would respond to the 4 test objects at this point in learning my $iCountHadOneFiringOutput = 0; # Count the number of responses where a single output fired my $iCountCorrectAnswers = 0; # Count the number of correct responses my $iCountPushedOffApples = 0; # Count the number of times an apple was pushed off my $iCountAteStones = 0; # Count the number of times a stone was eaten for(my $iTestObject = 0; $iTestObject < $numTestObjects ; $iTestObject++ ) { # Loop over the test objects my @testObject = @{$testObjects[$iTestObject]}; my $isApple = 0; if ($testObject[0] == 1 && $testObject[2] == 1 && $testObject[4] == 1 && $testObject[5] == 1){$isApple = 1;} # The test object is an apple my @testFiringOutputNeurons = @{ getFiringOutputNeurons (\@testObject) }; if ( ($testFiringOutputNeurons[0] + $testFiringOutputNeurons[1] + $testFiringOutputNeurons[2]) == 1){ $iCountHadOneFiringOutput++; if($isApple == 1 && $testFiringOutputNeurons[0] == 1){ # The subject is eating an apple (correct action) $iCountCorrectAnswers++; } if ($isApple == 0 && $testFiringOutputNeurons[1] == 1){ # The subject is pushing off stone (correct action) $iCountCorrectAnswers++; } if($isApple == 1 && $testFiringOutputNeurons[1] == 1){ # The subject is pushing off apple (incorrect action) $iCountPushedOffApples++; } if($isApple == 0 && $testFiringOutputNeurons[0] == 1){ # The subject is eating a stone (incorrect action) $iCountAteStones++; } } } my $printOnScreen = ($verbose2 || $verbose && $iLearningTime == $totalLearningObjectPresentations); if ($printOnScreen){ print "Simulation: $iSimulation, time: $iLearningTime, ";} if($iCountCorrectAnswers == 4){ # If $iCountCorrectAnswers = 4, the subject correctly passed all 4 tests $flagPassedAll4Tests = 1; if ($printOnScreen){ print "all 4 tests passed correctly";} }else{ $flagPassedAll4Tests = 0; $learningCurveIncorrectCtr[$iLearningTime]++; } if($iCountPushedOffApples == 2 && $iCountCorrectAnswers == 2){ $flagPushedOffApplesAndStones = 1; if ($printOnScreen){ print "pushed off apples and stones";} }else{ $flagPushedOffApplesAndStones = 0; } if($iCountHadOneFiringOutput < 4){ $flagDidNotLearnOneAnswer = 1; if ($printOnScreen){ print "did not learn one answer";} }else{ $flagDidNotLearnOneAnswer = 0; } if ($printOnScreen){ print "\n";} $learningCurveTotalTrialsCtr[$iLearningTime]++; } # End loop over learning objects if ($flagPassedAll4Tests == 1){ $ctrPassedAll4Tests++;} if ($flagPushedOffApplesAndStones == 1){ $ctrPushedOffApplesAndStones++;} if ($flagDidNotLearnOneAnswer == 1){ $ctrDidNotLearnOneAnswer++;} $ctrSimulations++; } # End loop over simulations $percPassedAll4Tests = sprintf ("%.3f", $ctrPassedAll4Tests / $ctrSimulations * 100); $percPushedOffApplesAndStones = sprintf ("%.3f", $ctrPushedOffApplesAndStones / $ctrSimulations * 100); $percDidNotLearnOneAnswer = sprintf ("%.3f", $ctrDidNotLearnOneAnswer / $ctrSimulations * 100); $percFailedTheRest = 100 - $percPassedAll4Tests - $percPushedOffApplesAndStones - $percDidNotLearnOneAnswer; $outputMsg = "\nCluster size: $clusterSize synapses, clusters per output neuron: $numClusters, the number of clusters to fire a neuron: $numClustersToFire, randomNeuronFiring = $randomNeuronFiring, simulations: $ctrSimulations. After $totalLearningObjectPresentations learning object presentations: % passed all 4 tests: $percPassedAll4Tests, % failed (pushed off 2 apples and 2 stones): $percPushedOffApplesAndStones, % failed (did not learn one answer): $percDidNotLearnOneAnswer, % failed (other): $percFailedTheRest. Learning curve: (Objects presented) (Incorrect answer on any of the 4 tests, %)\n"; foreach $i (1 .. $#learningCurveTotalTrialsCtr){ $avgIncorrectOnAnyTests = sprintf ("%.3f", $learningCurveIncorrectCtr[$i] / $learningCurveTotalTrialsCtr[$i] * 100); $outputMsg .= "$i $avgIncorrectOnAnyTests\n"; } print "$outputMsg"; open (FILE, ">>$outputFile"); print FILE "$outputMsg"; close (FILE); sleep 2; exit; # Randomly generate synaptics clusters sub generateClusters(){ for(my $iOutputNeuron = 0; $iOutputNeuron < $outputNeurons ; $iOutputNeuron++ ) { for(my $iCluster = 0; $iCluster < $numClusters ; $iCluster++ ) { my $i1 = int(rand($inputNeurons)); my $i2 = int(rand($inputNeurons)); my $i3 = int(rand($inputNeurons)); my $i4 = int(rand($inputNeurons)); if ($clusterSize == 3){$i4 = 9999;} # Set unused input indexes to 9999 if ($clusterSize == 2){$i3 = 9999; $i4 = 9999;} if ($clusterSize == 1){$i2 = 9999; $i3 = 9999; $i4 = 9999;} if ($clusters{$iOutputNeuron}{$i1}{$i2}{$i3}{$i4} > 0){ $clustersCtr{$iOutputNeuron}{$i1}{$i2}{$i3}{$i4}++; # Increment counter for identical clusters } $clusters{$iOutputNeuron}{$i1}{$i2}{$i3}{$i4} = 1; } } return; } # Get memorized output (if any) given an input object sub getFiringOutputNeurons { my @object = @{ $_[0] }; my @firingOutputNeurons = (0,0,0); my @firingInputs = @{ getFiringInputsOrOutputsIndexes(\@object)}; # Transform @object into array of indexes of firing inputs foreach my $iOutputNeuron (0, 1, 2) { my $iCountActiveClusters = 0; foreach my $input1 (@firingInputs){ foreach my $input2 (@firingInputs, 9999){ foreach my $input3 (@firingInputs, 9999){ foreach my $input4 (@firingInputs, 9999){ if ($clusters{$iOutputNeuron}{$input1}{$input2}{$input3}{$input4} >= 2){ # $clusters >= 2 -- cluster exists and can drive neuron firing $iCountActiveClusters++; $iCountActiveClusters += $clustersCtr{$iOutputNeuron}{$input1}{$input2}{$input3}{$input4}; # account for identical clusters } } } } } if ( $iCountActiveClusters >= $numClustersToFire){ $firingOutputNeurons[$iOutputNeuron] = 1; } } return \@firingOutputNeurons; } # Return reward based on actions and the presented object sub getReward { # Arguments are @object and @firingOutputNeurons my @object = @{ $_[0] }; my @firingOutputNeurons = @{ $_[1] }; my $reward = 0; if ($object[0] == 1 && $object[2] == 1 && $object[4] == 1 && $object[5] == 1){ # The object is an apple if ($firingOutputNeurons[0] == 1) { # The subject is eating $reward = $strongPositiveReward; # Strong positive reward, 0.25 } elsif ($firingOutputNeurons[1] == 1 ){ # The subject is pushing off the table $reward = $weakPositiveReward; # Weak positive reward, 0.1 } elsif ($firingOutputNeurons[2] == 1 ){ # The subject is doing nothing $reward = $strongNegativeReward; # Negative reward flag } } if (!($object[0] == 1 && $object[2] == 1 && $object[4] == 1 && $object[5] == 1)){ # The object is a stone if ($firingOutputNeurons[0] == 1) { # The subject is eating $reward = $strongNegativeReward; # Negative reward flag } elsif ($firingOutputNeurons[1] == 1 ){ # The subject is pushing off the table $reward = $weakPositiveReward; # Weak positive reward, 0.1 } elsif ($firingOutputNeurons[2] == 1 ){ # The subject is doing nothing $reward = $strongNegativeReward; # Negative reward flag } } if ($firingOutputNeurons[0] + $firingOutputNeurons[1] + $firingOutputNeurons[2] >= 2){ $reward = $strongNegativeReward; # Negative reward if more than 1 neurons fire simultaneously } return $reward; } # Update cluster weights in accordance with the learning rules sub updateClusters { my $reward = $_[0]; my @object = @{ $_[1] }; my @firingOutputNeurons = @{ $_[2] }; # If this is a memorized (non-trial) firing and the reward is positive, do not change cluster weights if ($flagTrialFiring == 0 && $reward > 0 ){ return; } my $ctr = 0; my $firingOutputNeuronNumber; my @firingOutputsIndexes = @{getFiringInputsOrOutputsIndexes (\@firingOutputNeurons)}; my @firingInputsIndexes = @{getFiringInputsOrOutputsIndexes (\@object) }; foreach $firingOutputNeuronNumber (@firingOutputsIndexes){ foreach my $input1 (@firingInputsIndexes){ foreach my $input2 (@firingInputsIndexes, 9999){ foreach my $input3 (@firingInputsIndexes, 9999){ foreach my $input4 (@firingInputsIndexes, 9999){ if ($clusters{$firingOutputNeuronNumber}{$input1}{$input2}{$input3}{$input4} > 0){ # If the cluster exists and was excited if ($reward == $strongNegativeReward) { $clusters{$firingOutputNeuronNumber}{$input1}{$input2}{$input3}{$input4} = 1; # reset to 1 if negative reward (1 means the cluster exists but has 0 weight) }else{ $clusters{$firingOutputNeuronNumber}{$input1}{$input2}{$input3}{$input4} += $reward; # otherwise add the reward amount } } } } } } } return; } sub getFiringInputsOrOutputsIndexes{ # The argument is @object in format (1,0,0,1,0,1,...), the output is the list of indexes of active neurons my @object = @{ $_[0] }; # in the format (0,3,5,...) my @firingList = (); my $ctr = 0; foreach my $i (@object){ if ($i == 1){ push(@firingList, $ctr); } $ctr++; } return \@firingList; }