StimListeR for Stekic, Nielsen, & Kovic

require(reshape2)
require(plyr)
require(magrittr)
require(dplyr)
require(tidyr)
require(doBy)
require(stringr)

This function is supposed to do the sampling - once for every seednum, and return the sample

createsample <- function(seedval, condition, subcondition) {              
  
  set.seed(seedval)   
  
  #######################################################################################################
  # SAMPLING FOR LABELS
  ## First we specify the phonemes that are being us for labels
  SonorantCons <- c('m', 'n', 'l')
  PlosiveCons <- c('p', 't', 'k')
  Conv1Cons <- c('f', 'v', 'sh')
  Conv2Cons <- c('s', 'z', 'h')
  Vowels <- c("a", 'a:')
  
  ## Next we assemble them into Syllables
  PlosiveSyll1 <- as.vector(outer(PlosiveCons[c(1,2)], Vowels, paste, sep=""))
  PlosiveSyll2 <- as.vector(outer(PlosiveCons[c(1,3)], Vowels, paste, sep=""))
  PlosiveSyll3 <- as.vector(outer(PlosiveCons[c(2,3)], Vowels[1], paste, sep=""))

  SonorantSyll1 <- as.vector(outer(SonorantCons[c(1,2)], Vowels, paste, sep=""))
  SonorantSyll2 <- as.vector(outer(SonorantCons[c(1,3)], Vowels, paste, sep=""))
  SonorantSyll3 <- as.vector(outer(SonorantCons[c(2,3)], Vowels[1], paste, sep=""))

  Conv1Syll1 <- as.vector(outer(Conv1Cons[c(1,2)], Vowels, paste, sep=""))
  Conv1Syll2 <- as.vector(outer(Conv1Cons[c(1,3)], Vowels, paste, sep=""))
  Conv1Syll3 <- as.vector(outer(Conv1Cons[c(2,3)], Vowels[1], paste, sep=""))
  
  Conv2Syll1 <- as.vector(outer(Conv2Cons[c(1,2)], Vowels, paste, sep=""))
  Conv2Syll2 <- as.vector(outer(Conv2Cons[c(1,3)], Vowels, paste, sep=""))
  Conv2Syll3 <- as.vector(outer(Conv2Cons[c(2,3)], Vowels[1], paste, sep=""))
  
  ## And then we assemble those syllables into Words
  
  PlosiveWords12 <- as.vector(outer(PlosiveSyll1, PlosiveSyll2, paste, sep=''))
  PlosiveWords <- as.vector(outer(PlosiveWords12, PlosiveSyll3, paste, sep=''))

  SonorantWords12 <- as.vector(outer(SonorantSyll1, SonorantSyll2, paste, sep=''))
  SonorantWords <- as.vector(outer(SonorantWords12, SonorantSyll3, paste, sep=''))

  Conv1Words12 <- as.vector(outer(Conv1Syll1, Conv1Syll2, paste, sep=''))
  Conv1Words <- as.vector(outer(Conv1Words12, Conv1Syll3, paste, sep=''))

  Conv2Words12 <- as.vector(outer(Conv2Syll1, Conv2Syll2, paste, sep=''))
  Conv2Words <- as.vector(outer(Conv2Words12, Conv2Syll3, paste, sep=''))

  ## Then exclude a few real words
  ToExclude <- c('papaka', 'pa:paka')
  PlosiveWords <- setdiff(PlosiveWords, ToExclude)
  
  ## Now that we have created all of the words, we simply Sample from them
  
  PlosiveSelected <- sample(PlosiveWords, 12)
  SonorantSelected <- sample(SonorantWords, 12)
  Conv1Selected <- sample(Conv1Words, 12)
  Conv2Selected <- sample(Conv2Words, 12)

  PlosiveStarter <- PlosiveSelected[1:8]
  PlosiveSecondary <- PlosiveSelected[9:12]
  SonorantStarter <- SonorantSelected[1:8]
  SonorantSecondary <- SonorantSelected[9:12]
  Conv1Starter <- Conv1Selected[1:8]
  Conv1Secondary <- Conv1Selected[9:12]
  Conv2Starter <- Conv2Selected[1:8]
  Conv2Secondary <- Conv2Selected[9:12]
  
  StarterWords <- as.data.frame(rbind(PlosiveStarter, SonorantStarter, 
                                      Conv1Starter, Conv2Starter), 
                                row.names = FALSE)
  
  StarterWords$Type <- c('Plosive', "Sonorant", "Conv1", "Conv2")
  colnames(StarterWords) <- c(1:9)
  
  SecondaryWords <- as.data.frame(rbind(PlosiveSecondary, SonorantSecondary,
                                        Conv1Secondary, Conv2Secondary), 
                                  row.names = FALSE)
  
  SecondaryWords$Type <- c('Plosive', "Sonorant", "Conv1", "Conv2")
  colnames(SecondaryWords) <- c(1:5)
  #######################################################################################################
  # SAMPLING IMAGES
  lister = 1:5

  Chosen1 <- sample(lister, 3)
  Chosen2 <- sample(lister, 3)
  Chosen3 <- sample(lister, 3)
  Chosen4 <- sample(lister, 3)

  Images <- as.vector(ImageStims$NewName)

  JaggedStarter <- c(Chosen1[1:2], Chosen2[1:2]+10, Chosen3[1:2]+20, Chosen4[1:2]+30)
  JaggedStarter <- c(Images[c(JaggedStarter)], "J")
  CurvedStarter <- c(Chosen1[1:2]+5, Chosen2[1:2]+15, Chosen3[1:2]+25, Chosen4[1:2]+35)
  CurvedStarter <- c(Images[c(CurvedStarter)], "C")
  StarterImages <- as.data.frame(rbind(JaggedStarter, CurvedStarter))
  colnames(StarterImages) <- c(1:9)
  
  JaggedSecondary <- c(Chosen1[3], Chosen2[3]+10, Chosen3[3]+20, Chosen4[3]+30)
  JaggedSecondary <- c(Images[c(JaggedSecondary)], "J")
  CurvedSecondary <- c(Chosen1[3]+5, Chosen2[3]+15, Chosen3[3]+25, Chosen4[3]+35)
  CurvedSecondary <- c(Images[c(CurvedSecondary)], "J")
  SecondaryImages <- as.data.frame(rbind(JaggedSecondary, CurvedSecondary))
  colnames(SecondaryImages) <- c(1:5)
  
  #######################################################################################################
  # Generating Training Set and Testing Set to Pass to next function
  
  TrainingStims <- rbind(StarterWords, StarterImages)
  SecondaryStims <- rbind(SecondaryWords, SecondaryImages)
  
  ChosenStims <- cbind(TrainingStims, SecondaryStims)
  ChosenStims <- subset(ChosenStims, select = -c(9))
  colnames(ChosenStims) <- c(1:13)

  rm(ImageStims, SecondaryImages, SecondaryStims, SecondaryWords, StarterImages, StarterWords,
     TrainingStims, Chosen1, Chosen2, Chosen3, Chosen4, Conv1Cons, Conv1Secondary, Conv1Selected,
     Conv1Starter, Conv1Syll1, Conv1Syll2, Conv1Syll3, Conv1Words, Conv1Words12,
     Conv2Cons, Conv2Secondary, Conv2Selected,
     Conv2Starter, Conv2Syll1, Conv2Syll2, Conv2Syll3, Conv2Words, Conv2Words12, CurvedSecondary,
     CurvedStarter, Images, JaggedSecondary, JaggedStarter, lister, 
     PlosiveCons, PlosiveSecondary, PlosiveSelected,
     PlosiveStarter, PlosiveSyll1, PlosiveSyll2, PlosiveSyll3, PlosiveWords, PlosiveWords12,
     SonorantCons, SonorantSecondary, SonorantSelected,
     SonorantStarter, SonorantSyll1, SonorantSyll2, SonorantSyll3, SonorantWords, SonorantWords12,
     ToExclude, Vowels)
  
  ## FIRST WE CHOOSE LABELS FOR EVERY PARTICIPANT, BASED ON WHAT CONDITION THEY ARE IN
  ## For some conditions these lists will then be maintained as they are, while for the Category Label     conditions (1-3) the labels will be reassigned to a single one in the next code chunk

  TrainingStims <- as.data.frame(t(subset(ChosenStims, select=c(1:8))))
  TestingStims <- as.data.frame(t(subset(ChosenStims, select=c(9:12))))

  ## Congruent Labels (+NoLabels Condition (labels will be deleted later))
  if(condition==1|condition==4|condition==10){
    TrainingJaggedWords <- as.vector(TrainingStims$'1')
    TestingJaggedWords <- as.vector(TestingStims$'1')
    TrainingCurvedWords <- as.vector(TrainingStims$'2')
    TestingCurvedWords <- as.vector(TestingStims$'2')
  }
  
  ## Incongruent Labels
  if(condition==2|condition==5){
    TrainingJaggedWords <- as.vector(TrainingStims$'2')
    TestingJaggedWords <- as.vector(TestingStims$'2')
    TrainingCurvedWords <- as.vector(TrainingStims$'1')
    TestingCurvedWords <- as.vector(TestingStims$'1')
  }  
  
  ## Conventional Labels (C1=Jagged)
  if(condition=='3A'|condition=="6A"){
    TrainingJaggedWords <- as.vector(TrainingStims$'3')
    TestingJaggedWords <- as.vector(TestingStims$'3')
    TrainingCurvedWords <- as.vector(TrainingStims$'4')
    TestingCurvedWords <- as.vector(TestingStims$'4')
  }
  
  ## Conventional Labels (C2=Jagged)
  if(condition=='3B'|condition=='6B'){
    TrainingJaggedWords <- as.vector(TrainingStims$'4')
    TestingJaggedWords <- as.vector(TestingStims$'4')
    TrainingCurvedWords <- as.vector(TrainingStims$'3')
    TestingCurvedWords <- as.vector(TestingStims$'3')
  } 
  
  ## Arbitrary Labels (HalfHalf-"Congruent")
  if(condition==7){
    TrainingJaggedWords <- as.vector(TrainingStims$'1')
    TestingJaggedWords <- as.vector(TestingStims$'1')
    TrainingCurvedWords <- as.vector(TrainingStims$'2')
    TestingCurvedWords <- as.vector(TestingStims$'2')
    
    holder1 <- c(TrainingJaggedWords[1:4], TrainingCurvedWords[1:4])
    holder2 <- c(TrainingJaggedWords[5:8], TrainingCurvedWords[5:8])
    TrainingJaggedWords <- holder1
    TrainingCurvedWords <- holder2
    
    holder3 <- c(TestingJaggedWords[1:2], TestingCurvedWords[1:2])
    holder4 <- c(TestingJaggedWords[3:4], TestingCurvedWords[3:4])
    TestingJaggedWords <- holder3
    TestingCurvedWords <- holder4
  }
  
  ## Arbitrary Labels (HalfHalf-"Conventional")
  if(condition==8){
    TrainingJaggedWords <- as.vector(TrainingStims$'3')
    TestingJaggedWords <- as.vector(TestingStims$'3')
    TrainingCurvedWords <- as.vector(TrainingStims$'4')
    TestingCurvedWords <- as.vector(TestingStims$'4')
    
    holder1 <- c(TrainingJaggedWords[1:4], TrainingCurvedWords[1:4])
    holder2 <- c(TrainingJaggedWords[5:8], TrainingCurvedWords[5:8])
    TrainingJaggedWords <- holder1
    TrainingCurvedWords <- holder2
    
    holder3 <- c(TestingJaggedWords[1:2], TestingCurvedWords[1:2])
    holder4 <- c(TestingJaggedWords[3:4], TestingCurvedWords[3:4])
    TestingJaggedWords <- holder3
    TestingCurvedWords <- holder4
  }  
  
  ## Arbitrary Label (Fully Arbitrary, Randomly Sampled)
  if(condition==9){
    PossibleTrainingWords <- c(as.vector(TrainingStims$'1'), as.vector(TrainingStims$'2'),
                          as.vector(TrainingStims$'3'), as.vector(TrainingStims$'4'))
    PossibleTestingWords <- c(as.vector(TestingStims$'1'), as.vector(TestingStims$'2'),
                          as.vector(TestingStims$'3'), as.vector(TestingStims$'4'))   
                          
    ChosenTrainingWords <-  sample(PossibleTrainingWords, 16)  
    ChosenTestingWords <- sample(PossibleTestingWords, 8)
    
    TrainingJaggedWords <- ChosenTrainingWords[1:8]
    TestingJaggedWords <- ChosenTestingWords[1:4]
    TrainingCurvedWords <- ChosenTrainingWords[9:16]
    TestingCurvedWords <- ChosenTestingWords[5:8]
  }
  
  #############################################3
  ## NOW WE ASSIGN WORDS TO IMAGES
  
  # For most conditions this just means assigning the chosen labels to the chosen images
  # For a few conditions (1-3: category labels only) we choose a single one of the labels chosen above, using   that for all images
  # For condition 10, we simply put empty values into the label column
  
  if(condition==1|condition==2|condition=='3A'|condition=='3B'){
    TrainingJaggedWords <- rep(TrainingJaggedWords[1],8)
    TestingJaggedWords <- rep(TrainingJaggedWords[1],4)
    TrainingCurvedWords <- rep(TrainingCurvedWords[1],8)
    TestingCurvedWords <- rep(TrainingCurvedWords[1],4)
  }
  
  if(condition==10){
    TrainingJaggedWords <- rep('None',8)
    TestingJaggedWords <- rep('None',4)
    TrainingCurvedWords <- rep('None',8)
    TestingCurvedWords <- rep('None',4) 
  }
  
  ## Training Pairs
  TrainingJagged <- as.data.frame(cbind(as.vector(TrainingJaggedWords),
                                        as.vector(TrainingStims$JaggedStarter)))  
  TrainingCurved <- as.data.frame(cbind(as.vector(TrainingCurvedWords),
                                        as.vector(TrainingStims$CurvedStarter)))
  TrainingPairs <- rbind(TrainingJagged,TrainingCurved)
  
  ## Testing Pairs
  TestingJagged <- as.data.frame(cbind(as.vector(TestingJaggedWords),
                                        as.vector(TestingStims$JaggedStarter)))  
  TestingCurved <- as.data.frame(cbind(as.vector(TestingCurvedWords),
                                        as.vector(TestingStims$CurvedStarter)))
  TestingPairs <- rbind(TestingJagged,TestingCurved)
  
  rm(ChosenStims, TestingCurved, TestingCurvedWords, TestingJagged, TestingJaggedWords,
     TestingStims, TrainingCurved, TrainingCurvedWords, TrainingStims, TrainingJagged,
     TrainingJaggedWords)
  
  ChosenPairs <- rbind(TrainingPairs, TestingPairs)
  return(ChosenPairs)
}

createstimlist <- function(sampleY, condition, subcondition) {
  
  ####################################################################
  ## Set up Training trials
  rm(.Random.seed, envir=globalenv())           # this script resets the seed to something random
  
  
  #################
  ## NOW WE CAN ASSSEMBLE THE STIMLISTS (this bit doesn't need any if statements for conditions)
  
  ChosenPairs <- sampleY
  TrainingPairs <- ChosenPairs[(1:16),]
  
  TrainingList <- rbind(TrainingPairs[sample(nrow(TrainingPairs)),],
                    TrainingPairs[sample(nrow(TrainingPairs)),],
                    TrainingPairs[sample(nrow(TrainingPairs)),],
                    TrainingPairs[sample(nrow(TrainingPairs)),],
                    TrainingPairs[sample(nrow(TrainingPairs)),],
                    TrainingPairs[sample(nrow(TrainingPairs)),],
                    TrainingPairs[sample(nrow(TrainingPairs)),],
                    TrainingPairs[sample(nrow(TrainingPairs)),],
                    TrainingPairs[sample(nrow(TrainingPairs)),])
  
  colnames(TrainingList) <- c("Label", "Image")
  TrainingList$TrialNum <- 1:144
  TrainingList$TrialType <- "Training"
  TrainingList$Block <- rep(1:9, each=16)
  TrainingList$BlockTrial <- rep(1:16, 9)
  TrainingList$Condition <- condition
  TrainingList <- separate(data = TrainingList, col = Image, 
                       into = c('ImageSeed', 'ImageShape', "ImageCurviness", "ImageType"),
                       sep = "-", remove = FALSE)
  TrainingList$LabelType <- substring(TrainingList$Label, 1, 1)
  TrainingList$LabelType <- mapvalues(TrainingList$LabelType,
                                from = c('m', 'n', 'p', 't', 'f', 'v', 's', 'z'),
                                to = c('S', 'S', 'P', 'P', 'C1', 'C1', 'C2', 'C2'))
  Locations <- c('Left', 'Right', 'Up', 'Down')
  Locations <- c(Locations, Locations, Locations, Locations)
  TrainingList$Location <- c(sample(Locations), sample(Locations), sample(Locations), sample(Locations),
                         sample(Locations), sample(Locations), sample(Locations), sample(Locations),
                         sample(Locations))
  TrainingList$Approach <- mapvalues(TrainingList$Location,
                               from = c('Left', 'Right', 'Up', 'Down'),
                               to = c(39, 37, 40, 38))
  TrainingList$Retreat <- mapvalues(TrainingList$Location,
                               from = c('Left', 'Right', 'Up', 'Down'),
                               to = c(37, 39, 38, 40))
  TrainingList$SubCondition <- subcondition
  TrainingList$CorrectResponse <- ifelse(TrainingList$ImageShape == TrainingList$SubCondition,
                                         TrainingList$Approach, TrainingList$Retreat)
  
  
  ################################
  ##Now we make the TestingList
  
  TestingPairs <- ChosenPairs
  TestingList <- rbind(TestingPairs[sample(nrow(TestingPairs)),],
                    TestingPairs[sample(nrow(TestingPairs)),],
                    TestingPairs[sample(nrow(TestingPairs)),],
                    TestingPairs[sample(nrow(TestingPairs)),])
  
  colnames(TestingList) <- c("Label", "Image")
  TestingList$TrialNum <- 1:96
  TestingList$TrialType <- "Testing"
  TestingList$Block <- rep(1:4, each=24)
  TestingList$BlockTrial <- rep(1:24, 4)
  TestingList$Condition <- condition
  TestingList <- separate(data = TestingList, col = Image, 
                       into = c('ImageSeed', 'ImageShape', "ImageCurviness", "ImageType"),
                       sep = "-", remove = FALSE)
  TestingList$LabelType <- substring(TestingList$Label, 1, 1)
  TestingList$LabelType <- mapvalues(TestingList$LabelType,
                                from = c('m', 'n', 'p', 't', 'f', 'v', 's', 'z'),
                                to = c('S', 'S', 'P', 'P', 'C1', 'C1', 'C2', 'C2'))
  Locations <- c('Left', 'Right', 'Up', 'Down')
  Locations <- rep(Locations,6)
  TestingList$Location <- c(sample(Locations), sample(Locations), sample(Locations), sample(Locations))
  TestingList$Approach <- mapvalues(TestingList$Location,
                               from = c('Left', 'Right', 'Up', 'Down'),
                               to = c(39, 37, 40, 38))
  TestingList$Retreat <- mapvalues(TestingList$Location,
                               from = c('Left', 'Right', 'Up', 'Down'),
                               to = c(37, 39, 38, 40))
  TestingList$SubCondition <- subcondition
  TestingList$CorrectResponse <- ifelse(TestingList$ImageShape == TestingList$SubCondition,
                                         TestingList$Approach, TestingList$Retreat)
  
  StimList <- rbind(TrainingList, TestingList)
  
  rm(TestingPairs, TrainingPairs, Locations)

  return(StimList)  

}

Here is the function that actually writes out all of the csvs etc.

Don’t worry about the warnings that get kicked - they are just from the split function and are working correctly

writestimuli <- function(seeds, perseed, condition, subcondition) {  
  # do n times, storing the current iteration number in 'i'
  for (i in 1:seeds) {
    seednum <- i
    
    seedval <- sample(1:10000,1)
    
    sampleY <- createsample(seedval, condition, subcondition)
    
    for (j in 1:perseed) {
      
      stimlist <- createstimlist(sampleY,condition, subcondition)
      stimlist <- cbind(Id=paste(seednum, j, sep="-"), stimlist)
      write.table(stimlist, paste("F:/Google Drive/Experiments/Collaborations/Stekic et al/Repo/data/stimlists/",
                                  condition,"-", subcondition,"-", seednum, "-",
                                  seedval, "-", j, ".csv", sep = ''),
                  sep = "\t", row.names = FALSE)
      
    }
  }
}

ImageStims <- read.csv("F:/Google Drive/Experiments/Collaborations/Stekic et al/Repo/Figures/ChosenImages.csv")
conditions <- c('1', '2', '3A', '3B', '4', '5', '6A', '6B', '7', '8', '9', '10')
subconditions <- c('J', 'C')


for(condition in conditions){
  for(subcondition in subconditions){
    writestimuli(3,5, condition, subcondition)
  }
}