diff --git a/R/informedbinomialtestbayesian.R b/R/informedbinomialtestbayesian.R index 5e8664b..c367468 100644 --- a/R/informedbinomialtestbayesian.R +++ b/R/informedbinomialtestbayesian.R @@ -100,13 +100,14 @@ InformedBinomialTestBayesianInternal <- function(jaspResults, dataset, options, frequencies <- table(individualDataFactor, individualDataSuccesses) sampleSize <- rowSums(frequencies) - dataset <- cbind.data.frame(factor(rownames(frequencies), levels = levels(dataset[[options[["factor"]]]])), frequencies[,2], sampleSize) - colnames(dataset) <- c(options[["factor"]], "__jaspComputedSuccesses", "__jaspComputedSampleSize") + dataset <- data.frame(factor(rownames(frequencies), levels = levels(dataset[[options[["factor"]]]]))) + colnames(dataset) <- options[["factor"]] attr(dataset, "individual") <- TRUE + attr(dataset, "successes") <- frequencies[,2] + attr(dataset, "sampleSize") <- sampleSize attr(dataset, "individualDataFactor") <- individualDataFactor attr(dataset, "individualDataSuccesses") <- individualDataSuccesses - } else { attr(dataset, "individual") <- FALSE } @@ -115,7 +116,7 @@ InformedBinomialTestBayesianInternal <- function(jaspResults, dataset, options, } .informedBinCheckErrors <- function(dataset, options) { - if (options[["factor"]] == "" || options[["successes"]] == "" || (options[["sampleSize"]] == "" && is.null(dataset[["__jaspComputedSampleSize"]]))) + if (options[["factor"]] == "" || options[["successes"]] == "" || (options[["sampleSize"]] == "" && is.null(attr(dataset, "sampleSize")))) return() customChecks <- list( @@ -155,7 +156,7 @@ InformedBinomialTestBayesianInternal <- function(jaspResults, dataset, options, return() # skip if the input is not specified - if (options[["factor"]] == "" || options[["successes"]] == "" || (options[["sampleSize"]] == "" && is.null(dataset[["__jaspComputedSampleSize"]]))) + if (options[["factor"]] == "" || options[["successes"]] == "" || (options[["sampleSize"]] == "" && is.null(attr(dataset, "sampleSize")))) return() models <- createJaspState() @@ -171,8 +172,8 @@ InformedBinomialTestBayesianInternal <- function(jaspResults, dataset, options, # fit an overall unrestricted model (for plotting the posterior) modelsList[[1]] <- list( "model" = try(multibridge::binom_bf_informed( - x = if (attr(dataset, "individual")) dataset[["__jaspComputedSuccesses"]] else dataset[[options[["successes"]]]], - n = if (attr(dataset, "individual")) dataset[["__jaspComputedSampleSize"]] else dataset[[options[["sampleSize"]]]], + x = .informedExtractSuccesses(dataset, options), + n = .informedExtractSampleSize(dataset, options), Hr = paste0(levels(dataset[[options[["factor"]]]]), collapse = ","), a = options[["priorCounts"]][[1]][["values"]], b = options[["priorCounts"]][[2]][["values"]], @@ -200,8 +201,8 @@ InformedBinomialTestBayesianInternal <- function(jaspResults, dataset, options, modelsList[[i+1]] <- list( "model" = try(multibridge::binom_bf_informed( - x = if (attr(dataset, "individual")) dataset[["__jaspComputedSuccesses"]] else dataset[[options[["successes"]]]], - n = if (attr(dataset, "individual")) dataset[["__jaspComputedSampleSize"]] else dataset[[options[["sampleSize"]]]], + x = .informedExtractSuccesses(dataset, options), + n = .informedExtractSampleSize(dataset, options), Hr = options[["models"]][[i]][["syntax"]], a = options[["priorCounts"]][[1]][["values"]], b = options[["priorCounts"]][[2]][["values"]], @@ -231,7 +232,7 @@ InformedBinomialTestBayesianInternal <- function(jaspResults, dataset, options, # skip if the input is not specified # skip if the input is not specified - if (options[["factor"]] == "" || options[["successes"]] == "" || (options[["sampleSize"]] == "" && is.null(dataset[["__jaspComputedSampleSize"]]))) + if (options[["factor"]] == "" || options[["successes"]] == "" || (options[["sampleSize"]] == "" && is.null(attr(dataset, "sampleSize")))) return() # skip if the data are only aggregated @@ -261,16 +262,16 @@ InformedBinomialTestBayesianInternal <- function(jaspResults, dataset, options, ### prepare data frequencies <- table(individualDataFactor[1:step], individualDataSuccesses[1:step]) - sampleSize <- apply(frequencies, 1, sum) - seqDataset <- cbind.data.frame(factor(rownames(frequencies), levels = levels(dataset[[options[["factor"]]]])), frequencies[,2], sampleSize) - colnames(seqDataset) <- c(options[["factor"]], "__jaspComputedSuccesses", "__jaspComputedSampleSize") + sampleSize <- rowSums(frequencies) + seqDataset <- data.frame(factor(rownames(frequencies), levels = levels(dataset[[options[["factor"]]]])), frequencies[,2], sampleSize) + colnames(seqDataset) <- c(options[["factor"]], "successes", "sampleSize") ### fit models & extract margliks # fit an overall unrestricted model (for plotting the posterior) model0 <- try(multibridge::binom_bf_informed( - x = seqDataset[["__jaspComputedSuccesses"]], - n = seqDataset[["__jaspComputedSampleSize"]], + x = seqDataset[["successes"]], + n = seqDataset[["sampleSize"]], Hr = paste0(levels(dataset[[options[["factor"]]]]), collapse = ","), a = options[["priorCounts"]][[1]][["values"]], b = options[["priorCounts"]][[2]][["values"]], @@ -314,8 +315,8 @@ InformedBinomialTestBayesianInternal <- function(jaspResults, dataset, options, } else { model1 <- try(multibridge::binom_bf_informed( - x = seqDataset[["__jaspComputedSuccesses"]], - n = seqDataset[["__jaspComputedSampleSize"]], + x = seqDataset[["successes"]], + n = seqDataset[["sampleSize"]], Hr = options[["models"]][[i]][["syntax"]], a = options[["priorCounts"]][[1]][["values"]], b = options[["priorCounts"]][[2]][["values"]], @@ -427,8 +428,8 @@ InformedBinomialTestBayesianInternal <- function(jaspResults, dataset, options, if (is.null(jaspResults[["models"]]) || jaspBase::isTryError(jaspResults[["models"]]$object[[1]]$model)) return() - successes <- if (attr(dataset, "individual")) dataset[["__jaspComputedSuccesses"]] else dataset[[options[["successes"]]]] - sampleSize <- if (attr(dataset, "individual")) dataset[["__jaspComputedSampleSize"]] else dataset[[options[["sampleSize"]]]] + successes <- .informedExtractSuccesses(dataset, options) + sampleSize <- .informedExtractSampleSize(dataset, options) priorAlpha <- options[["priorCounts"]][[1]][["values"]] priorBeta <- options[["priorCounts"]][[2]][["values"]] @@ -641,3 +642,18 @@ InformedBinomialTestBayesianInternal <- function(jaspResults, dataset, options, return(ciDf) } +.informedExtractColumn <- function(dataset, options, column) { + if (attr(dataset, "individual")) + return(attr(dataset, column)) + else + return(dataset[[options[[column]]]]) +} +.informedExtractSampleSize <- function(dataset, options) { + .informedExtractColumn(dataset, options, "sampleSize") +} +.informedExtractSuccesses <- function(dataset, options) { + .informedExtractColumn(dataset, options, "successes") +} +.informedExtractCount <- function(dataset, options) { + .informedExtractColumn(dataset, options, "count") +} diff --git a/R/informedmultinomialtestbayesian.R b/R/informedmultinomialtestbayesian.R index 45d7801..5d41a4d 100644 --- a/R/informedmultinomialtestbayesian.R +++ b/R/informedmultinomialtestbayesian.R @@ -81,10 +81,11 @@ InformedMultinomialTestBayesianInternal <- function(jaspResults, dataset, option individualData <- dataset[[options[["factor"]]]] frequencies <- table(individualData) - dataset <- cbind.data.frame(factor(names(frequencies), levels = levels(dataset[[options[["factor"]]]])), as.numeric(frequencies)) - colnames(dataset) <- c(options[["factor"]], "__jaspComputedCounts") + dataset <- data.frame(factor(names(frequencies), levels = levels(dataset[[options[["factor"]]]]))) + colnames(dataset) <- options[["factor"]] attr(dataset, "individual") <- TRUE + attr(dataset, "count") <- as.numeric(frequencies) attr(dataset, "individualData") <- individualData } else { @@ -100,7 +101,7 @@ InformedMultinomialTestBayesianInternal <- function(jaspResults, dataset, option return() # skip if the input is not specified - if (options[["factor"]] == "" || (options[["count"]] == "" && is.null(dataset[["__jaspComputedCounts"]]))) + if (options[["factor"]] == "" || (options[["count"]] == "" && is.null(attr(dataset, "count")))) return() models <- createJaspState() @@ -116,7 +117,7 @@ InformedMultinomialTestBayesianInternal <- function(jaspResults, dataset, option # fit an overall unrestricted model (for plotting the posterior) modelsList[[1]] <- list( "model" = try(multibridge::mult_bf_informed( - x = if(options[["count"]] != "") dataset[[options[["count"]]]] else dataset[["__jaspComputedCounts"]], + x = .informedExtractCount(dataset, options), Hr = paste0(levels(dataset[[options[["factor"]]]]), collapse = ","), a = options[["priorCounts"]][[1]][["values"]], factor_levels = dataset[[options[["factor"]]]], @@ -143,7 +144,7 @@ InformedMultinomialTestBayesianInternal <- function(jaspResults, dataset, option modelsList[[i+1]] <- list( "model" = try(multibridge::mult_bf_informed( - x = if(options[["count"]] != "") dataset[[options[["count"]]]] else dataset[["__jaspComputedCounts"]], + x = .informedExtractCount(dataset, options), Hr = options[["models"]][[i]][["syntax"]], a = options[["priorCounts"]][[1]][["values"]], factor_levels = dataset[[options[["factor"]]]], @@ -171,7 +172,7 @@ InformedMultinomialTestBayesianInternal <- function(jaspResults, dataset, option return() # skip if the input is not specified - if (options[["factor"]] == "" || (options[["count"]] == "" && is.null(dataset[["__jaspComputedCounts"]]))) + if (options[["factor"]] == "" || (options[["count"]] == "" && is.null(attr(dataset, "count")))) return() # skip if the data are only aggregated @@ -202,12 +203,12 @@ InformedMultinomialTestBayesianInternal <- function(jaspResults, dataset, option ### prepare data frequencies <- table(individualData[1:step]) seqDataset <- cbind.data.frame(factor(names(frequencies), levels = levels(dataset[[options[["factor"]]]])), as.numeric(frequencies)) - colnames(seqDataset) <- c(options[["factor"]], "__jaspComputedCounts") + colnames(seqDataset) <- c(options[["factor"]], "count") ### fit models & extract margliks # fit an overall unrestricted model (for plotting the posterior) model0 <- try(multibridge::mult_bf_informed( - x = seqDataset[["__jaspComputedCounts"]], + x = seqDataset[["count"]], Hr = paste0(levels(dataset[[options[["factor"]]]]), collapse = ","), a = options[["priorCounts"]][[1]][["values"]], factor_levels = seqDataset[[options[["factor"]]]], @@ -250,7 +251,7 @@ InformedMultinomialTestBayesianInternal <- function(jaspResults, dataset, option } else { model1 <- try(multibridge::mult_bf_informed( - x = seqDataset[["__jaspComputedCounts"]], + x = seqDataset[["count"]], Hr = options[["models"]][[i]][["syntax"]], a = options[["priorCounts"]][[1]][["values"]], factor_levels = seqDataset[[options[["factor"]]]], @@ -505,7 +506,7 @@ InformedMultinomialTestBayesianInternal <- function(jaspResults, dataset, option colnames(tempSummary) <- c("fact", "observed", "lowerCI", "upperCI") if (options[["display"]] == "counts") - tempSummary[,2:4] <- tempSummary[,2:4] * sum(if(options[["count"]] != "") dataset[[options[["count"]]]] else dataset[["__jaspComputedCounts"]]) + tempSummary[,2:4] <- tempSummary[,2:4] * sum(.informedExtractCount(dataset, options)) tempPlot <- createJaspPlot(title = models[[i]]$name, width = 480, height = 320) tempPlot$position <- i @@ -623,7 +624,7 @@ InformedMultinomialTestBayesianInternal <- function(jaspResults, dataset, option } .createInformedMultBayesDescriptivesData <- function(dataset, options, table = TRUE) { - counts <- if(options[["count"]] != "") dataset[[options[["count"]]]] else dataset[["__jaspComputedCounts"]] + counts <- .informedExtractCount(dataset, options) # Compute CI if (table && options[["descriptivesTableCi"]]) @@ -646,7 +647,7 @@ InformedMultinomialTestBayesianInternal <- function(jaspResults, dataset, option tempRow <- list(fact = dataset[i,options[["factor"]]]) # skip if the input is not specified - if (!(options[["count"]] != "" && is.null(dataset[["__jaspComputedCounts"]]))) { + if (!(options[["count"]] != "" && is.null(attr(dataset, "count")))) { tempRow[["observed"]] <- counts[i] / stdConst if (!is.null(tempCI)) { tempRow[["lowerCI"]] <- tempCI[i,"lowerCI"]