R/LSbinomialtesting.R

Defines functions .plotsSimpleBinomial2LS .testsBinomialLS LSbinomialtesting

#
# Copyright (C) 2019 University of Amsterdam
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#

LSbinomialtesting   <- function(jaspResults, dataset, options, state = NULL){
  
  # a vector of two, first for data, second for hypotheses
  ready <- .readyBinomialLS(options)
  
  # introductory text
  if (options[["introText"]]).introductoryTextLS(jaspResults, options, "bin_test")
  
  # evaluate the expressions in priors
  if (ready[2])options[["priors"]] <- .evaluate_priors(options[["priors"]])
  # scale the prior probabilities
  if (ready[2])options[["priors"]] <- .scale_priors(options[["priors"]])
  
  # load, check, transform and process data
  if (ready[1])data <- .readDataBinomialLS(dataset, options)
  
  # data summary table ifrequested (but not ifthe data counts were added directly)
  .summaryBinomialLS(jaspResults, data, options, "bin_test")
  
  ### inference
  # summary table
  .testsBinomialLS(jaspResults, data, ready, options)
  
  # prior parameter
  if (options[["plotsPrior"]]){
    if (options[["plotsPriorType"]] != "conditional").plotsSimpleBinomial2LS(jaspResults, data, ready, options, type = "Prior")
    if (options[["plotsPriorType"]] == "conditional").plotsIndividualBinomial2LS(jaspResults, data, ready, options, type = "Prior")
  }
  
  # prior predictive
  if (options[["plotsPredictions"]]){
    if (options[["plotsPredictionType"]] != "conditional").plotsPredictionsBinomial2LS(jaspResults, data, ready, options, type = "Prior")
    if (options[["plotsPredictionType"]] == "conditional").plotsPredictionsIndividualBinomial2LS(jaspResults, data, ready, options, type = "Prior")
  }
  
  # predictive accuracy
  if (options[["plotsPredictiveAccuracy"]]).plotsPredAccuracyBinomial2LS(jaspResults, data, ready, options)
  
  # posterior parameter
  if (options[["plotsPosterior"]]){
    if (options[["plotsPosteriorType"]] != "conditional").plotsSimpleBinomial2LS(jaspResults, data, ready, options, type = "Posterior")
    if (options[["plotsPosteriorType"]] == "conditional").plotsIndividualBinomial2LS(jaspResults, data, ready, options, type = "Posterior")
  }
  
  # prior and posterior
  if (options[["plotsBoth"]]){
    if (options[["plotsBothType"]] != "conditional").plotsBothBinomialLS2(jaspResults, data, ready, options)
    if (options[["plotsBothType"]] == "conditional").plotsBothIndividualBinomial2LS(jaspResults, data, ready, options)
  }
  
  
  ### sequential analysis
  if (options[["plotsIterative"]]).plotsIterativeOverlyingBinomial2LS(jaspResults, data, ready, options)
  if (options[["plotsIterative"]] && options[["plotsIterativeUpdatingTable"]]).tableIterativeBinomial2LS(jaspResults, data, ready, options)
  
  
  ### posterior predictive
  if (options[["predictionTable"]]).tablePredictionsBinomialLS2(jaspResults, data, ready, options)
  if (options[["plotsPredictionsPost"]]){
    if (options[["plotsPredictionPostType"]] != "conditional").plotsPredictionsBinomial2LS(jaspResults, data, ready, options, type = "Posterior")
    if (options[["plotsPredictionPostType"]] == "conditional").plotsPredictionsIndividualBinomial2LS(jaspResults, data, ready, options, type = "Posterior")
    if (options[["predictionPostPlotTable"]]).tablePosteriorPredictions(jaspResults, data, ready, options)
  }
  
  return()
}

.testsBinomialLS              <- function(jaspResults, data, ready, options){
  
  if (is.null(jaspResults[["testsContainer"]])){
    testsContainer <- createJaspContainer("Hypotheses")
    testsContainer$position <- 2
    jaspResults[["testsContainer"]] <- testsContainer 
  } else
    testsContainer <- jaspResults[["testsContainer"]]
  
  
  if (options[["introText"]] && is.null(testsContainer[['introText']])){
    
    introText <- createJaspHtml()
    introText$dependOn("introText")
    introText$position <- 1
    
    introText[['text']] <- .explanatoryTextLS("tests", options, "bin_test")
    
    testsContainer[['introText']] <- introText    
  }
  
  
  if (is.null(testsContainer[['testsTable']])){
    
    testsTable <- createJaspTable(title = gettext("Testing Summary"))
    
    testsTable$position <- 2
    testsTable$dependOn(c(.BinomialLS_data_dependencies, "bfType", "bfTypevsName", "bayesFactorType"))
    
    bfType_name <- switch(
      options[["bayesFactorType"]],
      "BF10"    = gettextf("BF%s",     "\u2081\u2080"),
      "BF01"    = gettextf("BF%s",     "\u2080\u2081"),
      "LogBF10" = gettextf("log(BF%s)","\u2081\u2080")
    )
    
    testsTable$addColumnInfo(name = "hypothesis",   title = gettext("Hypothesis"),          type = "string")
    testsTable$addColumnInfo(name = "prior",        title = gettext("P(H)"),                type = "number")
    testsTable$addColumnInfo(name = "log_lik",      title = gettext("log(likelihood)"),     type = "number")
    testsTable$addColumnInfo(name = "posterior",    title = gettext("P(H|data)"),           type = "number")
    testsTable$addColumnInfo(name = "bf",           title = bfType_name,                    type = "number")
    
    testsTable$setExpectedSize(length(options[["priors"]]))
    
    testsContainer[["testsTable"]] <- testsTable
    
    if (ready[1] && !ready[2])
      return()
    else if (!ready[1])
      testsTable$setError(gettext("Please specify successes and failures."))
    else if (ready[2]){
      
      temp_results <- .testBinomialLS(data, options[["priors"]])
      
      for(i in 1:length(options[["priors"]])){
        
        temp_row <- list(
          hypothesis  = options[["priors"]][[i]]$name,
          prior       = temp_results$prior[i],
          log_lik     = temp_results$log_lik[i], 
          posterior   = temp_results$posterior[i])
        
        if (options[["bfType"]] == "inclusion")
          temp_bf <- (temp_results$posterior[i] / (1-temp_results$posterior[i])) / (temp_results$prior[i] / (1-temp_results$prior[i]))
        else if (options[["bfType"]] == "best")
          temp_bf <- exp(temp_results$log_lik[i]) / exp(temp_results$log_lik[which.max(temp_results$log_lik)])
        else if (options[["bfType"]] == "vs")
          temp_bf <- exp(temp_results$log_lik[i]) / exp(temp_results$log_lik[sapply(options[["priors"]], function(p)p$name) == options[["bfTypevsName"]]])
        
        if (options[["bayesFactorType"]] == "BF10")
          temp_row$bf <- temp_bf
        else if (options[["bayesFactorType"]] == "BF01")
          temp_row$bf <- 1/temp_bf          
        else if (options[["bayesFactorType"]] == "LogBF10")
          temp_row$bf <- log(temp_bf)
        
        testsTable$addRows(temp_row)
      }
      
      # add footnote clarifying what dataset was used
      testsTable$addFootnote(gettextf(
        "These results are based on %i %s and %i %s.",
        data$nSuccesses, ifelse(data$nSuccesses == 1, gettext("success"), gettext("successes")),
        data$nFailures,  ifelse(data$nFailures  == 1, gettext("failure"), gettext("failures"))
      ))
      
    }
    
  }
  
  return()
}
.plotsSimpleBinomial2LS       <- function(jaspResults, data, ready, options, type = c("Prior", "Posterior")){
  
  containerPlots <- .containerPlots2LS(jaspResults, options, "bin_test", type)
  
  if (is.null(containerPlots[[paste0("plots",type)]])){
    
    plotsSimple <- createJaspPlot(width = 530, height = 400, aspectRatio = 0.7)
    
    plotsSimple$position <- 2
    plotsSimple$dependOn(c(.BinomialLS_data_dependencies,
                           ifelse(type == "Prior", "plotsPriorJointType",            "plotsPosteriorJointType"),
                           ifelse(type == "Prior", "plotsPriorMarginalCI",           "plotsPosteriorMarginalCI"),
                           ifelse(type == "Prior", "plotsPriorMarginalType",         "plotsPosteriorMarginalType"),
                           ifelse(type == "Prior", "plotsPriorMarginalCoverage",     "plotsPosteriorMarginalCoverage"),
                           ifelse(type == "Prior", "plotsPriorMarginalLower",        "plotsPosteriorMarginalLower"),
                           ifelse(type == "Prior", "plotsPriorMarginalUpper",        "plotsPosteriorMarginalUpper"),
                           ifelse(type == "Prior", "plotsPriorMarginalEstimate",     "plotsPosteriorMarginalEstimate"),
                           ifelse(type == "Prior", "plotsPriorMarginalEstimateType", "plotsPosteriorMarginalEstimateType"),
                           if (type == "Posterior") "plotsPosteriorObserved",
                           "colorPalette", "scaleSpikes"))
    
    
    containerPlots[[paste0("plots",type)]] <- plotsSimple
    
    if (!all(ready))return()
    
    all_lines    <- c()
    all_arrows   <- c()
    legend       <- NULL
    temp_results <- .testBinomialLS(data, options[["priors"]])
    
    if (any(is.nan(temp_results$posterior))){
      plotsSimple$setError(gettext("The plot could not be created because the posterior model probabilities are not defined."))
      return()
    }
    
    for(i in 1:length(options[["priors"]])){
      
      if (options[["priors"]][[i]]$type == "spike"){
        
        dfArrowPP       <- .dataArrowBinomialLS(options[["priors"]][[i]])
        dfArrowPP$y_end <- exp(log(dfArrowPP$y_end)+log(temp_results[i, tolower(type)]))
        dfArrowPP$g     <- options[["priors"]][[i]]$name
        
        all_arrows      <- c(all_arrows, list(dfArrowPP))
        legend          <- rbind(legend, c(options[["priors"]][[i]]$type, options[["priors"]][[i]]$name))
        
      } else if (options[["priors"]][[i]]$type == "beta"){
        
        dfLinesPP   <- .dataLinesBinomialLS(data, options[["priors"]][[i]])
        dfLinesPP   <- dfLinesPP[dfLinesPP$g == type,]
        dfLinesPP$y <- exp(log(dfLinesPP$y)+log(temp_results[i, tolower(type)]))
        dfLinesPP$g <- options[["priors"]][[i]]$name
        
        all_lines   <- c(all_lines, list(dfLinesPP))
        legend      <- rbind(legend, c(options[["priors"]][[i]]$type, options[["priors"]][[i]]$name))
        
      }
    }
    
    if (type == "Posterior" && options[["plotsPosteriorObserved"]]){
      dfPoints <- data.frame(
        x = data$nSuccesses/(data$nSuccesses + data$nFailures),
        y = 0,
        g = "Observed"
      )
    } else
      dfPoints <- NULL
    
    xName  <- bquote(.(gettext("Population proportion"))~theta)
    
    if (options[[ifelse(type == "Prior", "plotsPriorType", "plotsPosteriorType")]] == "joint"){
      
      if (options[[ifelse(type == "Prior", "plotsPriorJointType", "plotsPosteriorJointType")]] == "overlying")
        p <- .plotOverlyingLS(all_lines, all_arrows, dfPoints, xName = xName, palette = options[["colorPalette"]])  
      else if (options[[ifelse(type == "Prior", "plotsPriorJointType", "plotsPosteriorJointType")]] == "stacked")
        p <- .plotStackedLS(all_lines, all_arrows, legend, dfPoints, xName = xName)
      
    } else if (options[[ifelse(type == "Prior", "plotsPriorType", "plotsPosteriorType")]] == "marginal"){
      
      all_lines_new <- c()
      all_spikes    <- list()
      if (length(all_lines) > 0){
        
        for(i in 1:length(all_lines)){
          
          if (i == 1)
            all_lines_new[[1]] <- all_lines[[i]]
          else
            all_lines_new[[1]]$y <- all_lines_new[[1]]$y + all_lines[[i]]$y
          
        }
        all_lines_new[[1]]$g <- "__marginal"
      }
      
      if (length(all_arrows) > 0){
        for(i in 1:length(all_arrows)){
          all_arrows[[i]]$g <- "__marginal"
        }
      }
      
      if (type == "Prior"){
        for(i in 1:length(options[["priors"]])){
          if (options[["priors"]][[i]]$type == "spike"){
            all_spikes <- c(
              all_spikes, 
              list(data.frame(y = options[["priors"]][[i]]$PH, x = options[["priors"]][[i]]$parPoint, g = "__marginal"))
            )
          }
        }
      } else {
        temp_results <- .testBinomialLS(data, options[["priors"]])
        for(i in 1:length(options[["priors"]])){
          if (options[["priors"]][[i]]$type == "spike"){
            all_spikes <- c(
              all_spikes, 
              list(data.frame(y = temp_results$posterior[i], x = options[["priors"]][[i]]$parPoint, g = "__marginal"))
            )
          }
        }
        
      }
      
      if (options[[ifelse(type == "Prior", "plotsPriorMarginalCI", "plotsPosteriorMarginalCI")]]){
        
        if (options[[ifelse(type == "Prior", "plotsPriorMarginalType", "plotsPosteriorMarginalType")]] == "central"){
          
          dfCI <- .marginalCentralBinomialLS(all_lines_new[[1]], all_spikes, 
                                             options[[ifelse(type == "Prior", "plotsPriorMarginalCoverage", "plotsPosteriorMarginalCoverage")]])
          
        } else if (options[[ifelse(type == "Prior", "plotsPriorMarginalType", "plotsPosteriorMarginalType")]] == "HPD"){
          
          dfCI <- .marginalHPDBinomialLS(all_lines_new[[1]], all_spikes,
                                         options[[ifelse(type == "Prior", "plotsPriorMarginalCoverage", "plotsPosteriorMarginalCoverage")]])    
          
        } else if (options[[ifelse(type == "Prior", "plotsPriorMarginalType", "plotsPosteriorMarginalType")]] == "custom"){
          
          dfCI <- .marginalCustomBinomialLS(all_lines_new[[1]], all_spikes,
                                            lCI = options[[ifelse(type == "Prior", "plotsPriorMarginalLower", "plotsPosteriorMarginalLower")]],
                                            uCI = options[[ifelse(type == "Prior", "plotsPriorMarginalUpper", "plotsPosteriorMarginalUpper")]])
          
        } else if (options[[ifelse(type == "Prior", "plotsPriorMarginalType", "plotsPosteriorMarginalType")]] == "support"){
          
          dfCI <- .marginalSupportBinomialLS(data, options[["priors"]], all_lines_new[[1]], all_spikes, options[["plotsPosteriorMarginalBF"]])
          
        }
        
      } else
        dfCI <- NULL
      
      if (options[[ifelse(type == "Prior", "plotsPriorMarginalEstimate", "plotsPosteriorMarginalEstimate")]]){
        
        dfPointEstimate <- .dataPointMarginalBinomial(if (type == "Prior") NULL else data, options, all_lines_new[[1]], all_spikes, N = NULL,
                                                      type = "parameter", type2 = type,
                                                      estimate = options[[ifelse(type == "Prior", "plotsPriorMarginalEstimateType", "plotsPosteriorMarginalEstimateType")]])
      } else
        dfPointEstimate <- NULL
      
      p <- .plotOverlyingLS(all_lines_new, all_arrows, dfPoints, dfPointEstimate, CI = dfCI, xName = xName, no_legend = T)
      
    }
    
    plotsSimple$plotObject <- p
  }
  
  return()
}
.plotsIndividualBinomial2LS   <- function(jaspResults, data, ready, options, type = c("Prior", "Posterior")){
  
  containerPlots <- .containerPlots2LS(jaspResults, options, "bin_test", type)
  
  if (is.null(containerPlots[[paste0("plots",type)]])){
    
    plotsIndividual <- createJaspContainer()
    
    plotsIndividual$position <- 2
    plotsIndividual$dependOn(c(.BinomialLS_data_dependencies,
                               ifelse(type == "Prior", "plotsPriorEstimate",     "plotsPosteriorEstimate"),
                               ifelse(type == "Prior", "plotsPriorEstimateType", "plotsPosteriorEstimateType"),
                               ifelse(type == "Prior", "plotsPriorCI",           "plotsPosteriorCI"),
                               ifelse(type == "Prior", "plotsPriorTypeCI",       "plotsPosteriorTypeCI"),
                               ifelse(type == "Prior", "plotsPriorCoverage",     "plotsPosteriorCoverage"),
                               ifelse(type == "Prior", "plotsPriorLower",        "plotsPosteriorLower"),
                               ifelse(type == "Prior", "plotsPriorUpper",        "plotsPosteriorUpper"),
                               if (type == "Posterior") "plotsPosteriorObserved",
                               "scaleSpikes"))
    
    containerPlots[[paste0("plots",type)]] <- plotsIndividual
    
    
    if (all(!ready) || (ready[1] && !ready[2])){
      
      plotsIndividual[[""]] <- createJaspPlot(title = "", width = 530, height = 400, aspectRatio = 0.7)
      return()
      
    } else if (!ready[1] && ready[2]){
      
      for(i in 1:length(options[["priors"]])){
        plotsIndividual[[options[["priors"]][[i]]$name]] <- createJaspPlot(title = options[["priors"]][[i]]$name,
                                                                           width = 530, height = 400, aspectRatio = 0.7)
      }
      return()
      
    } else {
      
      if (type == "Prior"){
        temp_data <- list(
          nSuccesses = 0,
          nFailures = 0
        )
      } else
        temp_data <- data
      
      temp_results <- .testBinomialLS(data, options[["priors"]])
      
      if (type == "Posterior" && options[["plotsPosteriorObserved"]]){
        dfPoints <- data.frame(
          x = data$nSuccesses/(data$nSuccesses + data$nFailures),
          y = 0,
          g = "Observed"
        )
      } else
        dfPoints <- NULL
      
      for(i in 1:length(options[["priors"]])){
        
        temp_plot <- createJaspPlot(title = options[["priors"]][[i]]$name, width = 530, height = 400, aspectRatio = 0.7)
        
        plotsIndividual[[options[["priors"]][[i]]$name]] <- temp_plot
        
        xName  <- bquote(.(gettext("Population proportion"))~theta)
        
        dfArrowPP   <- NULL
        dfLinesPP   <- NULL
        dfCI        <- NULL
        dfCILinesPP <- NULL
        
        if (options[[ifelse(type == "Prior", "plotsPriorCI", "plotsPosteriorCI")]]){
          
          if (options[[ifelse(type == "Prior", "plotsPriorTypeCI", "plotsPosteriorTypeCI")]] == "central")
            dfCI <- .dataCentralBinomialLS(temp_data, options[["priors"]][[i]], options[[ifelse(type == "Prior", "plotsPriorCoverage", "plotsPosteriorCoverage")]], type = "parameter")
          else if (options[[ifelse(type == "Prior", "plotsPriorTypeCI", "plotsPosteriorTypeCI")]] == "HPD")
            dfCI <- .dataHPDBinomialLS(temp_data, options[["priors"]][[i]], options[[ifelse(type == "Prior", "plotsPriorCoverage", "plotsPosteriorCoverage")]], type = "parameter")
          else if (options[[ifelse(type == "Prior", "plotsPriorTypeCI", "plotsPosteriorTypeCI")]] == "custom")
            dfCI <- .dataCustomBinomialLS(temp_data, options[["priors"]][[i]], options[[ifelse(type == "Prior", "plotsPriorLower", "plotsPosteriorLower")]],
                                          options[[ifelse(type == "Prior", "plotsPriorUpper", "plotsPosteriorUpper")]], type = "parameter")  
          else if (options[[ifelse(type == "Prior", "plotsPriorTypeCI", "plotsPosteriorTypeCI")]] == "support")
            dfCI <- .dataSupportBinomialLS(temp_data, options[["priors"]][[i]], options[["plotsPosteriorBF"]])  
          
        }
        
        if (options[["priors"]][[i]]$type == "spike")
          dfArrowPP  <- .dataArrowBinomialLS(options[["priors"]][[i]])
        else if (options[["priors"]][[i]]$type == "beta"){
          
          dfLinesPP   <- .dataLinesBinomialLS(data, options[["priors"]][[i]])
          dfLinesPP   <- dfLinesPP[dfLinesPP$g == type,]
          dfLinesPP$y <- dfLinesPP$y
          
          if (!is.null(dfCI)){
            for(r in 1:nrow(dfCI)){
              temp_CILinesPP   <- dfLinesPP[dfLinesPP$x >= dfCI$x_start[r] & dfLinesPP$x <= dfCI$x_end[r],]
              temp_CILinesPP$g <- paste(c(as.character(dfCI$g), r), collapse = "")
              temp_CILinesPP   <- rbind.data.frame(
                data.frame(x = dfCI$x_start[r], y = 0, g = temp_CILinesPP$g[1]),
                temp_CILinesPP,
                data.frame(x = dfCI$x_end[r], y = 0, g = temp_CILinesPP$g[1])
              )
              dfCILinesPP <- rbind.data.frame(dfCILinesPP, temp_CILinesPP)
            }
          }
          
        }
        
        if (options[[ifelse(type == "Prior", "plotsPriorEstimate", "plotsPosteriorEstimate")]]){
          dfPointEstimate <- .estimateDataPointBinomial(temp_data, options[["priors"]][[i]], N = NULL, type = "parameter",
                                                        estimate = options[[ifelse(type == "Prior", "plotsPriorEstimateType", "plotsPosteriorEstimateType")]])
        } else
          dfPointEstimate <- NULL
        
        p <- .plotIndividualLS(dfLinesPP, dfArrowPP, dfPointEstimate, dfCI, dfCILinesPP, dfPoints, c(0,1), xName, nRound = 3)
        temp_plot$plotObject <- p
      }
      
    }
  }
  
  return()
}
.plotsPredictionsBinomial2LS  <- function(jaspResults, data, ready, options, type = c("Prior", "Posterior")){
  
  containerPlots <- .containerPrediction2PlotsLS(jaspResults, options, "bin_test", type)
  
  if (is.null(containerPlots[[paste0("plotsPredictions",type)]])){
    
    plotsPredictions <- createJaspPlot(width = 530, height = 400, aspectRatio = 0.7)
    
    plotsPredictions$position <- 2
    plotsPredictions$dependOn(c(.BinomialLS_data_dependencies,
                                ifelse(type == "Prior", "plotsPredictionMarginalEstimate",     "plotsPredictionPostMarginalEstimate"),
                                ifelse(type == "Prior", "plotsPredictionMarginalEstimateType", "plotsPredictionPostMarginalEstimateType"),
                                ifelse(type == "Prior", "plotsPredictionMarginalCI",           "plotsPredictionPostMarginalCI"),
                                ifelse(type == "Prior", "plotsPredictionMarginalTypeCI",       "plotsPredictionPostMarginalTypeCI"),
                                ifelse(type == "Prior", "plotsPredictionMarginalCoverage",     "plotsPredictionPostMarginalCoverage"),
                                ifelse(type == "Prior", "plotsPredictionMarginalLower",        "plotsPredictionPostMarginalLower"),
                                ifelse(type == "Prior", "plotsPredictionMarginalUpper",        "plotsPredictionPostMarginalUpper"),
                                ifelse(type == "Prior", "plotsPredictionJointType",            "plotsPredictionPostJointType"),
                                ifelse(type == "Prior", "plotsPredictionsObserved",            "predictionPostPlotProp"),
                                ifelse(type == "Prior", "colorPalette",                        "colorPalettePrediction")
    ))
    
    containerPlots[[paste0("plotsPredictions",type)]] <- plotsPredictions
    
    
    if (!all(ready) || (data$nSuccesses == 0 && data$nFailures == 0))
      return()
    else {
      
      if (type == "Prior"){
        predictionN  <- data$nSuccesses + data$nFailures
        temp_results <- .testBinomialLS(data, options[["priors"]])
        temp_data    <- data.frame(
          nSuccesses = 0,
          nFailures  = 0
        )
      } else if (type == "Posterior"){
        predictionN  <- options[["predictionN"]]
        temp_results <- .testBinomialLS(data, options[["priors"]])
        temp_data    <- data
        
        if (any(is.nan(temp_results$posterior))){
          plotsPredictions$setError(gettext("The plot could not be created because the posterior model probabilities are not defined."))
          return()
        }
      }
      
      if (type == "Posterior" && options[["predictionPostPlotProp"]]){
        xName  <- gettext("Sample proportions")
        yName  <- gettext("Density")
        xRange <- c(-.5/predictionN, 1 + .5/predictionN)
        proportions <- options[["predictionPostPlotProp"]]
        nRound <- 3
      } else {
        xName  <- gettext("Number of successes")
        yName  <- gettext("Probability")
        xRange <- c(-.5, predictionN + .5)
        nRound <- 0
        proportions <- FALSE
      }
      
      
      all_lines  <- c()
      legend     <- NULL
      
      for(i in 1:length(options[["priors"]])){
        
        dfHist   <- .dataHistBinomialLS2(temp_data, options[["priors"]][[i]], predictionN)
        dfHist$g <- options[["priors"]][[i]]$name
        dfHist$y <- dfHist$y*temp_results[i,ifelse(type == "Prior","prior","posterior")]
        
        if (type == "Posterior" && options[["predictionPostPlotProp"]])
          dfHist$x <- dfHist$x/predictionN
        
        # it's not beta, but I'm lazzy to rewrite a function I wanna use
        legend   <- rbind(legend, c("beta", options[["priors"]][[i]]$name))
        all_lines<- c(all_lines, list(dfHist))
      }
      
      if (type == "Prior"){
        if (options[["plotsPredictionsObserved"]])
          dfPoint <- data.frame(x = data$nSuccesses, y = 0)
        else
          dfPoint <- NULL
      } else
        dfPoint <- NULL
      
      if (options[[ifelse(type == "Prior","plotsPredictionType", "plotsPredictionPostType")]] == "joint"){
        
        if (options[[ifelse(type == "Prior", "plotsPredictionJointType", "plotsPredictionPostJointType")]] == "overlying"){
          p <- .plotOverlyingLS(all_lines, NULL, dfPoints = dfPoint, xName = xName, yName = yName, xRange = xRange,
                                palette = options[[ifelse(type == "Prior", "colorPalette","colorPalettePrediction")]], nRound = nRound,
                                discrete = TRUE, proportions = proportions)
        } else if (options[[ifelse(type == "Prior", "plotsPredictionJointType", "plotsPredictionPostJointType")]] == "stacked"){
          p <- .plotStackedLS(all_lines, NULL, legend, dfPoints = dfPoint, xName = xName, xRange = xRange,
                              proportions = proportions, discrete = TRUE)
        }
        
        
        
      } else if (options[[ifelse(type == "Prior","plotsPredictionType", "plotsPredictionPostType")]] == "marginal"){
        
        if (length(all_lines) > 0){
          
          for(i in 1:length(all_lines)){
            
            if (i == 1)
              all_lines_new <- all_lines[[i]]
            else
              all_lines_new$y <- all_lines_new$y + all_lines[[i]]$y
            
          }
          all_lines_new$g <- "__marginal"
        }
        
        all_lines_new   <- all_lines_new[seq(1,nrow(all_lines_new),2),]
        if (type == "Posterior" && options[["predictionPostPlotProp"]])
          all_lines_new$x <- all_lines_new$x + .5/predictionN
        else
          all_lines_new$x <- all_lines_new$x + .5
        
        if (type == "Prior"){
          if (options[["plotsPredictionsObserved"]])
            xBlacked <- data$nSuccesses
          else
            xBlacked <- NULL
        } else
          xBlacked <- NULL
        
        if (options[[ifelse(type == "Prior", "plotsPredictionMarginalCI", "plotsPredictionPostMarginalCI")]]){
          
          if (options[[ifelse(type == "Prior", "plotsPredictionMarginalTypeCI", "plotsPredictionPostMarginalTypeCI")]] == "central"){
            
            dfCI <- .marginalCentralBinomialLS(all_lines_new, NULL, options[["plotsPredictionMarginalCoverage"]], 0, predictionN, TRUE)        
            
          } else if (options[[ifelse(type == "Prior", "plotsPredictionMarginalTypeCI", "plotsPredictionPostMarginalTypeCI")]] == "HPD"){
            
            dfCI <- .marginalHPDBinomialLS(all_lines_new, list(),
                                           options[[ifelse(type == "Prior", "plotsPredictionMarginalCoverage", "plotsPredictionPostMarginalCoverage")]],
                                           0, predictionN, TRUE)    
            
          } else if (options[[ifelse(type == "Prior", "plotsPredictionMarginalTypeCI", "plotsPredictionPostMarginalTypeCI")]] == "custom"){
            
            dfCI <- .marginalCustomBinomialLS(all_lines_new, list(),
                                              lCI = options[[ifelse(type == "Prior", "plotsPredictionMarginalLower", "plotsPredictionPostMarginalLower")]],
                                              uCI = options[[ifelse(type == "Prior", "plotsPredictionMarginalUpper", "plotsPredictionPostMarginalUpper")]],
                                              TRUE)
            
            if (options[[ifelse(type == "Prior", "plotsPredictionMarginalUpper", "plotsPredictionPostMarginalUpper")]]
                > predictionN){
              
              plotsPredictions$setError("The upper CI limit is higher than the number of future 
                                       observations. Please change the value of the upper CI limit 
                                       in the settings panel.")
              
              return()
            }
            if (options[[ifelse(type == "Prior", "plotsPredictionMarginalLower", "plotsPredictionPostMarginalLower")]]
                > predictionN){
              
              plotsPredictions$setError("The lower CI limit is higher than the number of future 
                                       observations. Please change the value of the lower CI limit 
                                       in the settings panel.")
              
              return()
            }
            if (options[[ifelse(type == "Prior", "plotsPredictionMarginalLower", "plotsPredictionPostMarginalLower")]] > 
                options[[ifelse(type == "Prior", "plotsPredictionMarginalUpper", "plotsPredictionPostMarginalUpper")]]){
              
              plotsPredictions$setError("The lower CI limit is higher than the upper CI limit.
                                       Please change the value of the CI limits 
                                       in the settings panel.")
              
              return()
            }
            
          }
        } else
          dfCI <- NULL
        
        if (type == "Posterior" && options[["predictionPostPlotProp"]])
          xRange <- c(-.5/predictionN, 1 + .5/predictionN)
        else
          xRange <- c(0, predictionN)
        
        if (options[[ifelse(type == "Prior", "plotsPredictionMarginalEstimate", "plotsPredictionPostMarginalEstimate")]]){
          
          dfPointEstimate <- .dataPointMarginalBinomial(if (type == "Prior") NULL else data, options, all_lines_new, NULL, N = predictionN,
                                                        type = "prediction", type2 = type,
                                                        estimate = options[[ifelse(type == "Prior", "plotsPredictionMarginalEstimateType", "plotsPredictionPostMarginalEstimateType")]],
                                                        prop = if (type == "Posterior") options[["predictionPostPlotProp"]] else FALSE)
        } else
          dfPointEstimate <- NULL
        
        p <- .plotPredictionLS(all_lines_new, dfPointEstimate, dfCI, xRange = xRange, xName = xName, yName = yName, nRound = nRound, xBlacked = xBlacked,
                               proportions = proportions, predictionN = predictionN)
        
      } else
        p <- .plotStackedLS(all_lines, NULL, legend, dfPoints = dfPoint, xName = xName, xRange = xRange, proportions = proportions)
      
      plotsPredictions$plotObject <- p
    }
  }
  
  return()
}
.plotsPredictionsIndividualBinomial2LS  <- function(jaspResults, data, ready, options, type = c("Prior", "Posterior")){
  
  containerPlots <- .containerPrediction2PlotsLS(jaspResults, options, "bin_test", type)
  
  if (is.null(containerPlots[[paste0("plotsPredictions",type)]])){
    
    plotsPredictionsIndividual <- createJaspContainer()
    
    plotsPredictionsIndividual$position <- 2
    plotsPredictionsIndividual$dependOn(c(.BinomialLS_data_dependencies,
                                          ifelse(type == "Prior", "plotsPredictionEstimate",     "plotsPredictionPostEstimate"),
                                          ifelse(type == "Prior", "plotsPredictionEstimateType", "plotsPredictionPostEstimateType"),
                                          ifelse(type == "Prior", "plotsPredictionCI",           "plotsPredictionPostCI"),
                                          ifelse(type == "Prior", "plotsPredictionTypeCI",       "plotsPredictionPostTypeCI"),
                                          ifelse(type == "Prior", "plotsPredictionCoverage",     "plotsPredictionPostCoverage"),
                                          ifelse(type == "Prior", "plotsPredictionLower",        "plotsPredictionPostLower"),
                                          ifelse(type == "Prior", "plotsPredictionUpper",        "plotsPredictionPostUpper"),
                                          ifelse(type == "Prior", "colorPalette",                "colorPalettePrediction"),
                                          ifelse(type == "Prior", "plotsPredictionsObserved",    "predictionPostPlotProp")
    ))
    
    
    containerPlots[[paste0("plotsPredictions",type)]] <- plotsPredictionsIndividual
    
    
    if (all(!ready) || (ready[1] && !ready[2])){
      
      plotsPredictionsIndividual[[""]] <- createJaspPlot(title = "", width = 530, height = 400, aspectRatio = 0.7)
      return()
      
    } else if ((!ready[1] && ready[2]) || (data$nSuccesses == 0 & data$nFailures == 0)){
      
      for(i in 1:length(options[["priors"]])){
        plotsPredictionsIndividual[[options[["priors"]][[i]]$name]] <- createJaspPlot(title = options[["priors"]][[i]]$name,
                                                                                      width = 530, height = 400, aspectRatio = 0.7)
      }
      return()
      
    } else {
      
      if (type == "Prior"){
        predictionN  <- data$nSuccesses + data$nFailures
        temp_results <- .testBinomialLS(data, options[["priors"]])
        temp_data    <- data.frame(
          nSuccesses = 0,
          nFailures  = 0
        )
      } else if (type == "Posterior"){
        predictionN  <- options[["predictionN"]]
        temp_results <- .testBinomialLS(data, options[["priors"]])
        temp_data    <- data
      }
      
      for(i in 1:length(options[["priors"]])){
        
        temp_plot <- createJaspPlot(title = options[["priors"]][[i]]$name, width = 530, height = 400, aspectRatio = 0.7)
        
        plotsPredictionsIndividual[[options[["priors"]][[i]]$name]] <- temp_plot
        
        if (type == "Posterior" && options[["predictionPostPlotProp"]]){
          xName  <- gettext("Sample proportions")
          yName  <- gettext("Density")
          xRange <- c(-.5/predictionN, 1 + .5/predictionN)
          proportions <- options[["predictionPostPlotProp"]]
        } else {
          xName  <- gettext("Number of successes")
          yName  <- gettext("Probability")
          xRange <- c(0, predictionN)
          proportions <- FALSE
        }
        
        
        dfCI   <- NULL
        dfHist <- NULL
        
        if (options[[ifelse(type == "Prior","plotsPredictionCI","plotsPredictionPostCI")]]){
          
          if (options[[ifelse(type == "Prior","plotsPredictionTypeCI","plotsPredictionPostTypeCI")]] == "central"){
            
            dfCI <- .dataCentralBinomialLS(data, options[["priors"]][[i]],
                                           options[[ifelse(type == "Prior","plotsPredictionCoverage","plotsPredictionPostCoverage")]],
                                           n = predictionN,type = "prediction")
            
          } else if (options[[ifelse(type == "Prior","plotsPredictionTypeCI","plotsPredictionPostTypeCI")]] == "HPD"){
            
            dfCI <- .dataHPDBinomialLS(data, options[["priors"]][[i]],
                                       options[[ifelse(type == "Prior","plotsPredictionCoverage","plotsPredictionPostCoverage")]],
                                       n = predictionN, type = "prediction")
            
          } else if (options[[ifelse(type == "Prior","plotsPredictionTypeCI","plotsPredictionPostTypeCI")]] == "custom"){
            
            dfCI <- .dataCustomBinomialLS(data, options[["priors"]][[i]],
                                          options[[ifelse(type == "Prior","plotsPredictionLower","plotsPredictionPostLower")]],
                                          options[[ifelse(type == "Prior","plotsPredictionUpper","plotsPredictionPostUpper")]],
                                          n = predictionN, type = "prediction")
            
            if (options[[ifelse(type == "Prior","plotsPredictionUpper","plotsPredictionPostUpper")]] > predictionN){
              
              plotsPredictionsIndividual[[options[["priors"]][[i]]$name]]$setError(gettext(
                "The upper CI limit is higher than the number of future observations. Please, change the value of the upper CI limit in the settings panel."))
              
              return()
            }
            if (options[[ifelse(type == "Prior","plotsPredictionLower","plotsPredictionPostLower")]]  > predictionN){
              
              plotsPredictionsIndividual[[options[["priors"]][[i]]$name]]$setError(gettext(
                "The lower CI limit is higher than the number of future observations. Please, change the value of the lower CI limit in the settings panel."))
              
              return()
            }
            if (options[[ifelse(type == "Prior","plotsPredictionLower","plotsPredictionPostLower")]] 
                > options[[ifelse(type == "Prior","plotsPredictionUpper","plotsPredictionPostUpper")]]){
              
              plotsPredictionsIndividual[[options[["priors"]][[i]]$name]]$setError(gettext(
                "The lower CI limit is higher than the upper CI limit. Please, change the value of the CI limits in the settings panel."))
              
              return()
            }
            
          }
        }
        
        dfHist  <- .dataHistBinomialLS(temp_data, options[["priors"]][[i]], predictionN)
        
        if (type == "Prior"){
          if (options[["plotsPredictionsObserved"]])
            xBlacked <- data$nSuccesses
          else
            xBlacked <- NULL
        } else
          xBlacked <- NULL
        
        if (type == "Posterior" && options[["predictionPostPlotProp"]]){
          dfHist$x <- dfHist$x/predictionN
          if (options[["plotsPredictionPostCI"]]){
            dfCI$x_start <- dfCI$x_start/predictionN
            dfCI$x_end   <- dfCI$x_end  /predictionN
          }
          nRound <- 3
        } else
          nRound <- 0
        
        if (options[[ifelse(type == "Prior", "plotsPredictionEstimate", "plotsPredictionPostEstimate")]]){
          dfPointEstimate <- .estimateDataPointBinomial(temp_data, options[["priors"]][[i]], N = predictionN, type = "prediction",
                                                        estimate = options[[ifelse(type == "Prior", "plotsPredictionEstimateType", "plotsPredictionPostEstimateType")]],
                                                        prop = ifelse(type == "Prior", FALSE, options[["predictionPostPlotProp"]])
          )
        } else
          dfPointEstimate <- NULL
        
        p <- .plotPredictionLS(dfHist, dfPointEstimate, dfCI, xRange, xName, yName, nRound = nRound, xBlacked = xBlacked,
                               proportions = proportions, predictionN = predictionN)
        temp_plot$plotObject <- p
      }
    }
  }
  
  return()
}
.tablePosteriorPredictions              <- function(jaspResults, data, ready, options){
  
  containerPlots <- .containerPrediction2PlotsLS(jaspResults, options, "bin_test", "Posterior")
  
  if (is.null(containerPlots[["tablePredictions"]])){
    
    tablePredictions <- createJaspTable()
    
    tablePredictions$position <- 3
    tablePredictions$dependOn(.BinomialLS_data_dependencies)
    containerPlots[["tablePredictions"]] <- tablePredictions
    
    
    if (options[["predictionPostPlotProp"]]){
      tablePredictions$addColumnInfo(name = "successes", title = gettext("Proportion of Successes"), type = "number")
      tablePredictions$addColumns(c(0:options[["predictionN"]])/options[["predictionN"]])
    } else {
      tablePredictions$addColumnInfo(name = "successes", title = gettext("Successes"), type = "integer")
      tablePredictions$addColumns(0:options[["predictionN"]])
    }
    
    if (options[["plotsPredictionPostType"]] %in% c("joint", "conditional")){
      for(i in 1:length(options[["priors"]])){
        tablePredictions$addColumnInfo(name = paste0("hyp_", i), title = gettextf("P(Successes|%s)", options[["priors"]][[i]]$name), type = "number")
      }
    } else if (options[["plotsPredictionPostType"]] == "marginal")
      tablePredictions$addColumnInfo(name = "marginal", title = gettextf("P(Successes)"), type = "number")
    
    temp_results <- .testBinomialLS(data, options[["priors"]])
    temp_prob    <- NULL
    
    for(i in 1:length(options[["priors"]])){
      temp_prob <- cbind(temp_prob, .predictBinomialValuesLS(data, options[["priors"]][[i]], options[["predictionN"]]))
    }
    
    if (options[["plotsPredictionPostType"]] == "conditional"){
      for(i in 1:length(options[["priors"]])){
        tablePredictions$addColumns(temp_prob[,i])
      }
    } else if (options[["plotsPredictionPostType"]] == "joint"){
      for(i in 1:length(options[["priors"]])){
        tablePredictions$addColumns(temp_prob[,i]*temp_results[i,"posterior"])
      }
    } else if (options[["plotsPredictionPostType"]] == "marginal"){
      tablePredictions$addColumns(apply(temp_prob*matrix(temp_results[,"posterior"], byrow = T, ncol = length(options[["priors"]]), nrow = options[["predictionN"]] + 1), 1, sum))
    }
    
  }
  return()
}
.plotsPredAccuracyBinomial2LS <- function(jaspResults, data, ready, options){
  
  containerPredictiveAccuracy <- .containerPredictiveAccuracyLS(jaspResults, options, "bin_test")
  
  if (is.null(containerPredictiveAccuracy[["plotsPredAccuracy"]])){
    
    plotsPredAccuracy <- createJaspPlot(width = 530, height = 400, aspectRatio = 0.7)
    
    plotsPredAccuracy$position <- 2
    plotsPredAccuracy$dependOn(c(.BinomialLS_data_dependencies, "colorPalette"))
    
    containerPredictiveAccuracy[["plotsPredAccuracy"]] <- plotsPredAccuracy
    
    
    if (!all(ready) || (data$nSuccesses == 0 && data$nFailures == 0))
      return()
    else {
      
      predictionN  <- data$nSuccesses + data$nFailures
      temp_results <- .testBinomialLS(data, options[["priors"]])
      
      dfHist_all   <- NULL
      xRange       <- c(0, predictionN)
      xName        <- gettext("Hypothesis")
      yName        <- gettext("Probability")
      
      if (options[["plotsPredictiveAccuracyType"]] == "conditional")
        temp_y <- exp(temp_results[,"log_lik"])
      else if (options[["plotsPredictiveAccuracyType"]] == "joint")
        temp_y <- exp(temp_results[,"log_lik"])*temp_results[,"prior"]       
      else if (options[["plotsPredictiveAccuracyType"]] == "marginal")
        temp_y <- temp_results[,"posterior"]
      
      dfHist_all <- data.frame(
        "x" = 1:length(options[["priors"]]),
        "y" = temp_y,
        "g" = sapply(options[["priors"]],function(x)x$name))
      
      if (any(is.nan(dfHist_all$y))){
        plotsPredAccuracy$setError(gettext("The plot could not be created because the posterior model probabilities are not defined."))
        return()
      }
      
      p <- .plotAccuracyLS(dfHist_all, xName = xName, yName = yName)
      plotsPredAccuracy$plotObject <- p
      
    }
  }
  
  return()
}
.plotsIterativeOverlyingBinomial2LS <- function(jaspResults, data, ready, options){
  
  containerSequentialTests <- .containerSequentialTestsLS(jaspResults, options, "bin_test")
  
  if (is.null(containerSequentialTests[["plotsIterative"]])){
    
    plotsIterative <- createJaspPlot(width = 530, height = 400, aspectRatio = 0.7)
    
    plotsIterative$position <- 2
    plotsIterative$dependOn(c(.BinomialLS_data_dependencies, "colorPalette",
                              "bfTypeSequential", "bayesFactorTypeSequential", "bfTypevsNameSequential"))
    containerSequentialTests[["plotsIterative"]] <- plotsIterative
    
    if (length(data$y) == 0)
      return()
    if (!all(ready))
      return()
    
    if (options[["plotsIterativeType"]] == "BF"){
      if (options[["bfTypeSequential"]] == "vs" &&  options[["bfTypevsNameSequential"]] == ""){
        plotsIterative$setError(gettext("Please specify a hypothesis for comparison."))
        return()
      }
      if (length(options[["priors"]]) < 2){
        plotsIterative$setError("At least 2 hypotheses need to be specified.")
        return()
      }
      if (options[["bfTypeSequential"]] == "best")
        theBest <- which.max(.testBinomialLS(data, options[["priors"]])$log_lik)
    }
    
    results <- NULL
    if (length(data$y) == 1)
      iter_seq <- c(1, 1.1)
    else
      iter_seq <- 1:length(data$y)
    
    for(i in iter_seq){
      
      temp_data    <- list(
        nSuccesses = sum(data$y[0:i] == 1),
        nFailures  = sum(data$y[0:i] == 0)
      )
      
      temp_results <- .testBinomialLS(temp_data, options[["priors"]])
      
      if (options[["plotsIterativeType"]] == "conditional"){
        yName  <- gettext("Conditional probability")
        temp_y <- exp(temp_results[,"log_lik"])
      } else if (options[["plotsIterativeType"]] == "joint"){
        yName  <- gettext("Joint probability")
        temp_y <- exp(temp_results[,"log_lik"])*temp_results[,"prior"]       
      } else if (options[["plotsIterativeType"]] == "marginal"){
        yName  <- gettext("Posterior probability")
        temp_y <- temp_results[,"posterior"]
      } else if (options[["plotsIterativeType"]] == "BF"){
        
        if (options[["bfTypeSequential"]] == "inclusion"){
          temp_bf <- sapply(1:nrow(temp_results), function(h)
            (temp_results$posterior[h] / (1-temp_results$posterior[h])) / (temp_results$prior[h] / (1-temp_results$prior[h]))
          )
        } else if (options[["bfTypeSequential"]] == "best"){
          temp_bf <- sapply(1:nrow(temp_results), function(h)
            exp(temp_results$log_lik[h]) / exp(temp_results$log_lik[theBest])
          )
        } else if (options[["bfTypeSequential"]] == "vs"){
          temp_bf <- sapply(1:nrow(temp_results), function(h)
            exp(temp_results$log_lik[h]) / exp(temp_results$log_lik[sapply(options[["priors"]], function(p)p$name) == options[["bfTypevsNameSequential"]]])
          )
        }
        
        if (options[["bayesFactorTypeSequential"]] == "BF10")
          temp_y <- temp_bf
        else if (options[["bayesFactorTypeSequential"]] == "BF01")
          temp_y <- 1/temp_bf          
        else if (options[["bayesFactorTypeSequential"]] == "LogBF10")
          temp_y <- log(temp_bf)
        
        yName <- switch(
          options[["bayesFactorTypeSequential"]],
          "BF10"    = bquote("BF"["10"]),
          "BF01"    = bquote("BF"["01"]),
          "LogBF10" = bquote(italic("log")*"(BF)"["10"])
        )
      }
      
      results <- rbind.data.frame(results, temp_y)
      
    }
    
    
    plot_data_lines <- list()
    for(h in 1:length(options[["priors"]])){
      if (options[["plotsIterativeType"]] == "BF" && options[["bfTypeSequential"]] == "vs"){
        if (options[["bfTypevsNameSequential"]] == options[["priors"]][[h]]$name)next
      }
      
      temp_lines   <- NULL
      temp_lines   <- rbind(temp_lines, data.frame(
        x    = iter_seq,
        y    = results[,h],
        name = options[["priors"]][[h]]$name
      ))
      plot_data_lines <- c(plot_data_lines, list(temp_lines))
      
    }
    
    xName  <- gettext("Observation")
    
    if (options[["plotsIterativeType"]] == "BF")
      BF_log <- options[["bayesFactorTypeSequential"]] == "LogBF10"
    else
      BF_log <- NULL
    
    p <- .plotIterativeLS(plot_data_lines, NULL, xName = xName, yName = yName, x_start = 1, palette = options[["colorPalette"]], BF_log = BF_log)
    
    plotsIterative$plotObject <- p
  }
  
  return()
}
.tableIterativeBinomial2LS <- function(jaspResults, data, ready, options){
  
  containerSequentialTests <- .containerSequentialTestsLS(jaspResults, options, "bin_test")
  
  if (is.null(containerSequentialTests[["tableIterative"]])){
    
    tableIterative <- createJaspTable()
    
    tableIterative$position <- 3
    tableIterative$dependOn(c(.BinomialLS_data_dependencies, "plotsIterativeUpdatingTable"))
    containerSequentialTests[["tableIterative"]] <- tableIterative
    
    tableIterative$addColumnInfo(name = "iteration", title = gettext("Observations"), type = "integer")
    if (ready[2]){
      for(i in 1:length(options[["priors"]])){
        tableIterative$addColumnInfo(
          name  = options[["priors"]][[i]]$name,  
          title = options[["priors"]][[i]]$name,
          type = "number")
      }
    }
    
    
    if (!all(ready))
      return()
    
    if (options[["plotsIterativeType"]] == "BF"){
      if (options[["bfTypeSequential"]] == "vs" &&  options[["bfTypevsNameSequential"]] == ""){
        tableIterative$setError(gettext("Please specify a hypothesis for comparison."))
        return()
      }
      if (length(options[["priors"]]) < 2){
        tableIterative$setError(gettext("At least 2 hypotheses need to be specified."))
        return()
      }
      if (options[["bfTypeSequential"]] == "best")
        theBest <- which.max(.testBinomialLS(data, options[["priors"]])$log_lik)
    }
    
    
    results <- NULL
    
    if (length(data$y) > 1)
      iter_seq <- 1:length(data$y)
    else
      iter_seq <- 1
    
    for(i in iter_seq){
      
      temp_row     <- list() 
      temp_row[["iteration"]] <- i
      
      temp_data    <- list(
        nSuccesses = sum(data$y[0:i] == 1),
        nFailures  = sum(data$y[0:i] == 0)
      )
      temp_results <- .testBinomialLS(temp_data, options[["priors"]])
      
      if (options[["plotsIterativeType"]] == "conditional")
        temp_y <- exp(temp_results[,"log_lik"])
      else if (options[["plotsIterativeType"]] == "joint")
        temp_y <- exp(temp_results[,"log_lik"])*temp_results[,"prior"]       
      else if (options[["plotsIterativeType"]] == "marginal")
        temp_y <- temp_results[,"posterior"]
      else if (options[["plotsIterativeType"]] == "BF"){
        
        if (options[["bfTypeSequential"]] == "inclusion"){
          temp_bf <- sapply(1:nrow(temp_results), function(h)
            (temp_results$posterior[h] / (1-temp_results$posterior[h])) / (temp_results$prior[h] / (1-temp_results$prior[h]))
          )
        } else if (options[["bfTypeSequential"]] == "best"){
          temp_bf <- sapply(1:nrow(temp_results), function(h)
            exp(temp_results$log_lik[h]) / exp(temp_results$log_lik[theBest])
          )
        } else if (options[["bfTypeSequential"]] == "vs"){
          temp_bf <- sapply(1:nrow(temp_results), function(h)
            exp(temp_results$log_lik[h]) / exp(temp_results$log_lik[sapply(options[["priors"]], function(p)p$name) == options[["bfTypevsNameSequential"]]])
          )
        }
        
        temp_y <- switch(
          options[["bayesFactorTypeSequential"]],
          "BF10"    = temp_bf,
          "BF01"    = 1/temp_bf,
          "LogBF10" = log(temp_bf)
        )
        
      }
      
      for(h in 1:length(options[["priors"]])){
        temp_row[[options[["priors"]][[h]]$name]] <- temp_y[h]
      }
      
      tableIterative$addRows(temp_row)
    }
  }
  
  return()
}
.plotsBothBinomialLS2      <- function(jaspResults, data, ready, options){
  
  containerBoth <- .containerPlotsBoth2LS(jaspResults, options, "bin_test")
  
  if (is.null(containerBoth[["plotsBoth"]])){
    
    plotsBoth <- createJaspContainer()
    
    plotsBoth$position <- 2
    plotsBoth$dependOn(c(.BinomialLS_data_dependencies, "plotsBothSampleProportion"))
    
    containerBoth[["plotsBoth"]] <- plotsBoth
    
    
    if (!all(ready))
      return()
    
    all_lines    <- c()
    all_arrows   <- c()
    legend       <- NULL
    temp_results <- .testBinomialLS(data, options[["priors"]])
    
    if (any(is.nan(temp_results$posterior))){
      plotsBoth_error <- createJaspPlot(width = 530, height = 400, aspectRatio = 0.7)
      plotsBoth[["plotsBoth_error"]] <- plotsBoth_error
      plotsBoth_error$setError(gettext("The plot could not be created because the posterior model probabilities are not defined."))
      return()
    }
    
    for(i in 1:length(options[["priors"]])){
      
      if (options[["priors"]][[i]]$type == "spike"){
        
        dfArrowPP_prior       <- .dataArrowBinomialLS(options[["priors"]][[i]])
        dfArrowPP_posterior   <- .dataArrowBinomialLS(options[["priors"]][[i]])
        dfArrowPP_prior$g     <- "Prior"
        dfArrowPP_posterior$g <- "Posterior"
        dfArrowPP_prior$y_end     <- exp(log(dfArrowPP_prior$y_end)     + log(temp_results[i, "prior"]))
        dfArrowPP_posterior$y_end <- exp(log(dfArrowPP_posterior$y_end) + log(temp_results[i, "posterior"]))
        
        all_arrows      <- c(all_arrows, list(rbind(dfArrowPP_posterior, dfArrowPP_prior)))
        
      } else if (options[["priors"]][[i]]$type == "beta"){
        
        dfLinesPP   <- .dataLinesBinomialLS(data, options[["priors"]][[i]])
        dfLinesPP$y[dfLinesPP$g == "prior"]     <- exp(log(dfLinesPP$y[dfLinesPP$g == "prior"])+log(temp_results[i, "prior"]))
        dfLinesPP$y[dfLinesPP$g == "posterior"] <- exp(log(dfLinesPP$y[dfLinesPP$g == "posterior"])+log(temp_results[i, "posterior"]))
        
        all_lines   <- c(all_lines, list(dfLinesPP))
      }
    }
    
    if (options[["plotsBothSampleProportion"]]){
      dfPointsPP <- .dataProportionBinomialLS(data)
      if (is.nan(dfPointsPP$x))dfPointsPP <- NULL
    } else
      dfPointsPP <- NULL
    
    xName  <- bquote(.(gettext("Population proportion"))~theta)
    
    if (options[["plotsBothType"]] == "joint"){
      
      spikes_i <- 1
      betas_i  <- 1
      
      for(i in 1:length(options[["priors"]])){
        temp_plotsBoth <- createJaspPlot(title = options[["priors"]][[i]]$name, width = 530, height = 400, aspectRatio = 0.7)
        plotsBoth[[paste0("plotsBoth_",i)]] <- temp_plotsBoth
        
        if (options[["priors"]][[i]]$type == "spike"){
          temp_p   <- .plotPriorPosteriorLS(NULL, all_arrows[spikes_i], dfPoints = dfPointsPP, xName = xName)
          spikes_i <- spikes_i + 1
        } else if (options[["priors"]][[i]]$type == "beta"){
          temp_p   <- .plotPriorPosteriorLS(all_lines[betas_i], NULL, dfPoints = dfPointsPP, xName = xName)
          betas_i  <- betas_i + 1        
        }
        
        temp_plotsBoth$plotObject <- temp_p
      }
      
      
    } else if (options[["plotsBothType"]] == "marginal"){
      
      plotsBoth_plot <- createJaspPlot(width = 530, height = 400, aspectRatio = 0.7)
      plotsBoth[["plotsBoth_plot"]] <- plotsBoth_plot
      
      all_lines_new <- c()
      
      if (length(all_lines) > 0){
        
        for(i in 1:length(all_lines)){
          
          if (i == 1){
            all_lines_new[[1]] <- all_lines[[i]]
          } else {
            all_lines_new[[1]]$y <- all_lines_new[[1]]$y + all_lines[[i]]$y
          }
          
        }
      }
      
      p <- .plotPriorPosteriorLS(all_lines_new, all_arrows, dfPoints = dfPointsPP, xName = xName)
      plotsBoth_plot$plotObject <- p
      
    }
  }
  
  return()
}
.plotsBothIndividualBinomial2LS <- function(jaspResults, data, ready, options){
  
  containerBoth <- .containerPlotsBoth2LS(jaspResults, options, "bin_test")
  
  if (is.null(containerBoth[["plotsBoth"]])){
    
    plotsBoth <- createJaspContainer()
    
    plotsBoth$position <- 2
    plotsBoth$dependOn(c(.BinomialLS_data_dependencies, "plotsBothSampleProportion"))
    
    containerBoth[["plotsBoth"]] <- plotsBoth
    
    
    if (all(!ready) || (ready[1] && !ready[2])){
      
      plotsBoth[[""]] <- createJaspPlot(title = "", width = 530, height = 400, aspectRatio = 0.7)
      return()
      
    } else if (!ready[1] && ready[2]){
      
      for(i in 1:length(options[["priors"]])){
        plotsBoth[[options[["priors"]][[i]]$name]] <- createJaspPlot(title = options[["priors"]][[i]]$name,
                                                                     width = 530, height = 400, aspectRatio = 0.7)
      }
      return()
      
    } else {
      
      for(i in 1:length(options[["priors"]])){
        
        temp_plot <- createJaspPlot(title = options[["priors"]][[i]]$name, width = 530, height = 400, aspectRatio = 0.7)
        
        plotsBoth[[options[["priors"]][[i]]$name]] <- temp_plot
        
        dfArrowPP <- NULL
        dfLinesPP <- NULL
        
        xName  <- bquote(.(gettext("Population proportion"))~theta)
        
        if (options[["priors"]][[i]]$type == "spike")
          dfArrowPP  <- .dataArrowBinomialLS(options[["priors"]][[i]])
        else if (options[["priors"]][[i]]$type == "beta"){
          dfLinesPP  <- .dataLinesBinomialLS(data, options[["priors"]][[i]])
          
          if (all(dfLinesPP$y[dfLinesPP$g == "Prior"] == dfLinesPP$y[dfLinesPP$g == "Posterior"])){
            dfLinesPP   <- dfLinesPP[dfLinesPP$g == "Posterior",]
            dfLinesPP$g <- "Prior = Posterior"
          }
          
        }
        
        if (options[["plotsBothSampleProportion"]]){
          dfPointsPP <- .dataProportionBinomialLS(data)
          if (is.nan(dfPointsPP$x))dfPointsPP <- NULL
        } else
          dfPointsPP <- NULL 
        
        p <- .plotPriorPosteriorLS(list(dfLinesPP), list(dfArrowPP), dfPoints = dfPointsPP, xName = xName)
        temp_plot$plotObject <- p
      }
    }
  }
  
  return()
}
.tablePredictionsBinomialLS2    <- function(jaspResults, data, ready, options){
  
  containerPredictions <- .containerPredictionsLS(jaspResults, options, "bin_test")
  
  if (is.null(containerPredictions[["predictionsTable"]])){
    
    predictionsTable <- createJaspTable()
    
    predictionsTable$position <- 2
    predictionsTable$dependOn(c(.BinomialLS_data_dependencies, "predictionN", "predictionTableEstimate"))
    
    estimateText <- .estimateTextLS(options[["predictionTableEstimate"]])
    
    predictionsTable$addColumnInfo(name = "hypothesis",    title = gettext("Model"),                         type = "string")
    predictionsTable$addColumnInfo(name = "posterior",     title = gettextf("Posterior (%s)", "\u03B8"),     type = "string")
    predictionsTable$addColumnInfo(name = "prob",          title = gettext("P(H|data)"),                     type = "number")
    predictionsTable$addColumnInfo(name = "posteriorEst",  title = gettextf("Posterior %s", estimateText),   type = "number")
    predictionsTable$addColumnInfo(name = "predictive",    title = gettextf("Prediction (Successes)"),       type = "string")
    predictionsTable$addColumnInfo(name = "predictiveEst", title = gettextf("Prediction %s", estimateText),  type = "number")
    
    predictionsTable$setExpectedSize(length(options[["priors"]]))
    
    containerPredictions[["predictionsTable"]] <- predictionsTable
    
    if (!ready[2])
      return()
    else {
      
      temp_tests <- .testBinomialLS(data, options[["priors"]])
      temp_means <- NULL
      marg_est   <- .predictionTableEstimate(data, options, options[["predictionTableEstimate"]])
      # add rows for each hypothesis
      for(i in 1:length(options[["priors"]])){
        
        temp_results    <- .estimateBinomialLS(data, options[["priors"]][[i]])
        temp_prediction <- .predictBinomialLS(data, options[["priors"]][[i]], options)
        
        temp_row <- list(
          hypothesis      = options[["priors"]][[i]][["name"]],
          posterior       = temp_results[["distribution"]],
          prob            = temp_tests[i, "posterior"],
          posteriorEst    = temp_results[[options[["predictionTableEstimate"]]]],
          predictive      = temp_prediction[["distribution"]],
          predictiveEst   = temp_prediction[[options[["predictionTableEstimate"]]]]
        )
        
        predictionsTable$addRows(temp_row)
      }
      
      predictionsTable$addRows(list(
        hypothesis     = "Marginal",
        posteriorEst   = marg_est[["posteriorEst"]],
        predictiveEst  = marg_est[["predictionEst"]]
      ))
      
      # add footnote clarifying what dataset was used
      predictionsTable$addFootnote(gettextf(
        "The prediction for %s %s is based on %s %s and %s %s.",
        options[["predictionN"]], ifelse(options[["predictionN"]] == 1, gettext("observation"), gettext("observations")),
        data$nSuccesses, ifelse(data$nSuccesses == 1, gettext("success"), gettext("successes")),
        data$nFailures, ifelse(data$nFailures == 1, gettext("failure"), gettext("failures"))
      ))
      
    }
  }
  
  return()  
}
.predictionTableEstimate <- function(data, options, estimate){
  
  ### posterior estimate
  all_lines    <- c()
  all_arrows   <- c()
  legend       <- NULL
  temp_results <- .testBinomialLS(data, options[["priors"]])
  for(i in 1:length(options[["priors"]])){
    
    if (options[["priors"]][[i]]$type == "spike"){
      
      dfArrowPP       <- .dataArrowBinomialLS(options[["priors"]][[i]])
      dfArrowPP$y_end <- exp(log(dfArrowPP$y_end)+log(temp_results[i, "posterior"]))
      dfArrowPP$g     <- options[["priors"]][[i]]$name
      
      all_arrows      <- c(all_arrows, list(dfArrowPP))
      legend          <- rbind(legend, c(options[["priors"]][[i]]$type, options[["priors"]][[i]]$name))
      
    } else if (options[["priors"]][[i]]$type == "beta"){
      
      dfLinesPP   <- .dataLinesBinomialLS(data, options[["priors"]][[i]])
      dfLinesPP   <- dfLinesPP[dfLinesPP$g == "Posterior",]
      dfLinesPP$y <- exp(log(dfLinesPP$y)+log(temp_results[i, "posterior"]))
      dfLinesPP$g <- options[["priors"]][[i]]$name
      
      all_lines   <- c(all_lines, list(dfLinesPP))
      legend      <- rbind(legend, c(options[["priors"]][[i]]$type, options[["priors"]][[i]]$name))
      
    }
  }
  
  all_lines_new <- c()
  all_spikes    <- list()
  if (length(all_lines) > 0){
    
    for(i in 1:length(all_lines)){
      
      if (i == 1){
        all_lines_new[[1]] <- all_lines[[i]]
      } else {
        all_lines_new[[1]]$y <- all_lines_new[[1]]$y + all_lines[[i]]$y
      }
      
    }
    all_lines_new[[1]]$g <- "__marginal"
  }
  
  if (length(all_arrows) > 0){
    for(i in 1:length(all_arrows)){
      all_arrows[[i]]$g <- "__marginal"
    }
  }
  
  temp_results <- .testBinomialLS(data, options[["priors"]])
  for(i in 1:length(options[["priors"]])){
    if (options[["priors"]][[i]]$type == "spike"){
      all_spikes <- c(
        all_spikes, 
        list(data.frame(y = temp_results$posterior[i], x = options[["priors"]][[i]]$parPoint, g = "__marginal"))
      )
    }
  }
  
  posteriorEst <- .dataPointMarginalBinomial(data, options, all_lines_new[[1]], all_spikes, N = options[["predictionN"]],
                                             type = "parameter", type2 = "Posterior",
                                             estimate = estimate)$x
  
  ### prediction estimate
  temp_results <- .testBinomialLS(data, options[["priors"]])
  all_lines  <- c()
  legend     <- NULL
  
  for(i in 1:length(options[["priors"]])){
    
    dfHist   <- .dataHistBinomialLS2(data, options[["priors"]][[i]], options[["predictionN"]])
    dfHist$g <- options[["priors"]][[i]]$name
    dfHist$y <- dfHist$y*temp_results[i,"posterior"]
    
    
    # it's not beta, but I'm lazzy to rewrite a function I wanna use
    legend   <- rbind(legend, c("beta", options[["priors"]][[i]]$name))
    all_lines<- c(all_lines, list(dfHist))
  }
  
  if (length(all_lines) > 0){
    
    for(i in 1:length(all_lines)){
      
      if (i == 1){
        all_lines_new <- all_lines[[i]]
      } else {
        all_lines_new$y <- all_lines_new$y + all_lines[[i]]$y
      }
      
    }
    all_lines_new$g <- "__marginal"
  }
  
  all_lines_new   <- all_lines_new[seq(1,nrow(all_lines_new),2),]
  all_lines_new$x <- all_lines_new$x + .5
  
  predictionEst <- .dataPointMarginalBinomial(data, options, all_lines_new, NULL, N = options[["predictionN"]],
                                              type = "prediction", type2 = "Posterior",
                                              estimate = estimate)$x
  
  return(list(
    posteriorEst  = posteriorEst,
    predictionEst = predictionEst
  ))  
}
FBartos/JASP-TeachingStats documentation built on Sept. 5, 2020, 5:55 p.m.