Skip to content

Commit

Permalink
add attributes and rowSums
Browse files Browse the repository at this point in the history
  • Loading branch information
@FBartos
FBartos committed Feb 1, 2024
1 parent 442db8e commit c6a470f
Show file tree
Hide file tree
Showing 2 changed files with 48 additions and 31 deletions.
54 changes: 35 additions & 19 deletions R/informedbinomialtestbayesian.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
}
Expand All @@ -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(
Expand Down Expand Up @@ -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()
Expand All @@ -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"]],
Expand Down Expand Up @@ -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"]],
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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"]],
Expand Down Expand Up @@ -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"]],
Expand Down Expand Up @@ -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"]]

Expand Down Expand Up @@ -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")
}
25 changes: 13 additions & 12 deletions R/informedmultinomialtestbayesian.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 {
Expand All @@ -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()
Expand All @@ -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"]]]],
Expand All @@ -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"]]]],
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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"]]]],
Expand Down Expand Up @@ -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"]]]],
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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"]])
Expand All @@ -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"]
Expand Down

0 comments on commit c6a470f

Please sign in to comment.