library(testthat)

monkeydat = data.frame(Monkey=c("DAN", "ART", "CAU", "DOR", "VIO", "ARI"),
                       NumTrials=c(56689, 50985, 61142, 49608, 43041, 55407),
                       NumWordsLearned=c(308, 125, 112, 121, 81, 87),
                       NumNonwordsPresented=c(7832, 7832, 7832, 7832, 7832, 7832),
                       GeneralAccuracy=c(79.81, 73.41, 72.43, 73.15, 71.55, 71.14),
                       WordAccuracy=c(80.01, 74.83, 73.15, 79.26, 76.75, 75.38),
                       NonwordAccuracy=c(79.61, 72.00, 71.72, 67.06, 66.33, 66.90))
View(monkeydat)

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

MakeMonkey <- function(cueset, outcomeset=c("Word", "Nonword"), alpha=sqrt(0.001), beta=sqrt(0.001), lambda=1.0){
    weights <- matrix(0, length(cueset), length(outcomeset))
    rownames(weights) <- cueset
    colnames(weights) <- outcomeset

    learner <- function(stim, resp){
        cues <- unlist(strsplit(stim, "_"))
        print(cat("Cues: ", cues))
        print(cat("Outcome: ", resp))
        print("Weights: ",weights)
        print(outcomeset)
        print(weights[,outcomeset])
        totalActivation <- sum(weights[cues, outcomeset])
       
        print(str(cues))
        for (j in 1:length(cues)) {
               print("HIIIER")
            if (resp == "Nonword") {
                yesType <- "Nonword"
                noType <- "Word"
            } else if (resp == "Word") {
                yesType <- "Word"
                noType <- "Nonword"
            } else {
                stop("Unknown outcome", resp)
            }
            weights[cues[j],yesType] <<-  weigths[cues[j],yesType] +
                    alpha * beta * (lambda - totalActivation[yesType])
            weights[cues[j],noType] <<-  weights[cues[j],noType] +
                    alpha * beta * (0 - totalActivation[noType])
        }
    }

    list(
        Weights=weights,
        Learner=learner
    )
}

test_that("MakeMonkey",{
    cueset <- c("a","b","c")

    monkey <- MakeMonkey(cueset)
    print(str(monkey))
    monkey$Learner("a_a_b_c","Word")
    print(monkey$Weigths)
})
# EOF