library(testthat)
Resample <- function(x){
x[sample.int(length(x))]
}
test_that("Resample", {
x <- 1:10
expect_that(length(Resample(x[x > 8])), equals(2))
expect_that(length(Resample(x[x > 9])), equals(1))
expect_that(length(Resample(x[x > 10])), equals(0))
})
RandomPick <- function(data, n) {
if ( is.data.frame(data) ){
data[sample(nrow(data), n, replace=T),]
} else {
data[sample(length(data), n, replace=T)]
}
}
test_that("RandomPick", {
n <- 10
bigger <- 1:(3 * n)
equal <- 1:n
smaller <- c(1)
empty <- c()
df <- data.frame(a=c(1,2,3), b=c(4,5,6))
expect_equal(length(RandomPick(bigger, n)), n)
expect_equal(length(RandomPick(equal, n)), n)
expect_equal(length(RandomPick(smaller, n)), n)
expect_equal(length(RandomPick(empty, n)), 0)
expect_equal(nrow(RandomPick(df, n)), n)
})
CreateBlock <- function(data){
result <- data.frame(Stimulus=character(BLOCK_SIZE),
StimulusType=factor(character(BLOCK_SIZE),
c("LearnedWord","NewWord","Nonword")),
stringsAsFactors=F)
result[1:25,] <- RandomPick(data[data$StimulusType=="NewWord",], 1)
result[26:50,] <- RandomPick(data[data$StimulusType=="LearnedWord",], 25)
result[51:100,] <- RandomPick(data[data$StimulusType=="Nonword",],50)
result <- result[sample(nrow(result)),]
rownames(result) <- 1:nrow(result)
result
}
BLOCK_SIZE <- 100
test_that("CreateBlock", {
stim <- as.character(1:300)
data <- data.frame(Stimulus=stim)
data$StimulusType[1:100] <- "NewWord"
data$StimulusType[101:200] <- "LearnedWord"
data$StimulusType[201:300] <- "Nonword"
block <- CreateBlock(data)
trialNewWords <- block$Stimulus[ block$StimulusType == "NewWord" ]
trialLearnedWords <- block$Stimulus[ block$StimulusType == "LearnedWord" ]
trialNonwords <- block$Stimulus[ block$StimulusType == "Nonword" ]
expect_that(nrow(block), equals(BLOCK_SIZE))
expect_that(length(trialNewWords), equals(25))
expect_that(length(unique(trialNewWords)), equals(1))
expect_that(length(trialLearnedWords), equals(25))
expect_that(length(trialNonwords), equals(50))
# What should be expected for empty vectors?
})
PresentTrials <- function(trialCount, present, data){
trials <- data.frame()
for ( curTrial in 1:trialCount ) {
curBlock <- ( (curTrial - 1) %/% BLOCK_SIZE) + 1
curTrialInBlock <- ( (curTrial - 1) %% BLOCK_SIZE ) + 1
isNewBlock <- curTrialInBlock == 1
if ( isNewBlock ){
isNotFirstBlock <- curBlock > 1
if ( isNotFirstBlock ){
newWordTrials <- block[block$StimulusType == "NewWord",]
stopifnot(length(unique(newWordTrials$Stimulus)) == 1)
wordResponses <- newWordTrials[newWordTrials$Response == "Word",]
wordResponseRate <- nrow(wordResponses) / nrow(newWordTrials)
if ( wordResponseRate >= 0.8 ){
data$StimulusType[data$Stimulus == newWordTrials$Stimulus] <- "LearnedWord"
}
}
block <- CreateBlock(data)
block$Block <- curBlock
block$TrialInBlock <- 1:nrow(block)
# TODO: Add words to learned
}
curStim <- block$Stimulus[curTrialInBlock]
curStimIsWord <- present(curStim)
block$Trial[curTrialInBlock] <- curTrial
block$Response[curTrialInBlock] <- curStimIsWord
trials <- rbind(trials, block[curTrialInBlock,])
}
rownames(trials) <- 1:trialCount
result <- list(Trials=trials,Stimuli=data)
result
}
test_that("PresentTrials", {
stim <- as.character(1:300)
data <- data.frame(Stimulus=stim)
data$StimulusType[1:100] <- "NewWord"
data$StimulusType[101:200] <- "LearnedWord"
data$StimulusType[201:300] <- "Nonword"
count <- BLOCK_SIZE * 2.5
result <- PresentTrials(count,
function(word){
"Word"
},
data)
trials <- result$Trials
stimuli <- result$Stimuli
expect_equal(nrow(trials), count)
expect_equal(length(stimuli$StimulusType[stimuli$StimulusType == "LearnedWord"]), 102)
})
# EOF