diff --git a/DESCRIPTION b/DESCRIPTION index 029063c..65e6717 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -11,7 +11,7 @@ License: GPL (>= 2) Encoding: UTF-8 Imports: bootnet, - BDgraph, + easybgm, corpcor, dplyr, foreach, @@ -32,4 +32,4 @@ Remotes: jasp-stats/jaspBase, jasp-stats/jaspGraphs Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.1 +RoxygenNote: 7.3.2 diff --git a/NAMESPACE b/NAMESPACE index 5a38cb2..eff559d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,7 @@ # Generated by roxygen2: do not edit by hand -export(NetworkAnalysis) export(BayesianNetworkAnalysis) +export(NetworkAnalysis) importFrom(jaspBase,.extractErrorMessage) importFrom(jaspBase,.hasErrors) importFrom(jaspBase,.quitAnalysis) diff --git a/R/bayesiannetworkanalysis.R b/R/bayesiannetworkanalysis.R index 94e233f..2ebef00 100644 --- a/R/bayesiannetworkanalysis.R +++ b/R/bayesiannetworkanalysis.R @@ -20,7 +20,7 @@ BayesianNetworkAnalysis <- function(jaspResults, dataset, options) { # MissingValues needed for the .networkAnalysisReadData function in the frequentist network module: options[["missingValues"]] <- "listwise" # Unfortunately BDgraph does not work with pairwise missing values - dataset <- .networkAnalysisReadData(dataset, options) + dataset <- .networkAnalysisReadData(dataset, options) # from networkanalysis.R mainContainer <- .bayesianNetworkAnalysisSetupMainContainerAndTable(jaspResults, dataset, options) .bayesianNetworkAnalysisErrorCheck(mainContainer, dataset, options) @@ -40,8 +40,10 @@ BayesianNetworkAnalysis <- function(jaspResults, dataset, options) { mainContainer <- jaspResults[["mainContainer"]] if (is.null(mainContainer)) { - mainContainer <- createJaspContainer(dependencies = c("variables", "groupingVariable", "estimator", - "burnin", "iter", "gprior", "dfprior", "setSeed", "seed")) + mainContainer <- createJaspContainer(dependencies = c("variables", "groupingVariable", "model", + "burnin", "iter", "gPrior", "dfPrior", "initialConfiguration", + "edgePrior", "interactionScale", "betaAlpha", "betaBeta", + "dirichletAlpha", "thresholdAlpha", "thresholdBeta")) jaspResults[["mainContainer"]] <- mainContainer } .bayesianNetworkAnalysisMainTableMeta(mainContainer, dataset, options) @@ -61,6 +63,13 @@ BayesianNetworkAnalysis <- function(jaspResults, dataset, options) { tb$addColumnInfo(name = "nonZero", title = gettext("Number of non-zero edges"), type = "string") tb$addColumnInfo(name = "Sparsity", title = gettext("Sparsity"), type = "number") + + if (options[["model"]] == "omrf") { + + # add footnote + tb$addFootnote(gettext("The Ordinal Markov Random Field may require a substantial amount of time to complete. This time increases with the number of variables and the number of iterations.")) + } + mainContainer[["generalTable"]] <- tb } return() @@ -77,7 +86,7 @@ BayesianNetworkAnalysis <- function(jaspResults, dataset, options) { dataset <- Reduce(rbind.data.frame, dataset) if (options[["groupingVariable"]] != "") { - # these cannot be chained unfortunately + # these cannot be chained unfortunately - this will be changed to bgmCompare soon groupingVariableName <- options[["groupingVariable"]] dfGroup <- data.frame(groupingVariable) colnames(dfGroup) <- groupingVariableName @@ -104,12 +113,12 @@ BayesianNetworkAnalysis <- function(jaspResults, dataset, options) { # List that contains state or is empty: networkList <- list( - network = mainContainer[["networkState"]]$object, + network = mainContainer[["networkState"]]$object, # stores the results centrality = mainContainer[["centralityState"]]$object, layout = mainContainer[["layoutState"]]$object ) - if (length(options[["variables"]]) <= 2L) + if (length(options[["variables"]]) <= 2L) # returns an empty table if there are less than 3 variables return(networkList) if (is.null(networkList[["network"]])) @@ -155,7 +164,7 @@ BayesianNetworkAnalysis <- function(jaspResults, dataset, options) { centralitySamples <- centrality(network = network, options = options) # Compute centrality measures for each posterior sample: - nSamples <- nrow(network$samplesPosterior) + nSamples <- nrow(network$samplesPosterior[[1]]) # centralitySamples is in wide format, so to select all samples (without cols representing the variables) we need 3:(nSamples+2) posteriorMeans <- apply(centralitySamples[, 3:(nSamples+2)], MARGIN = 1, mean) @@ -193,67 +202,142 @@ BayesianNetworkAnalysis <- function(jaspResults, dataset, options) { networks <- vector("list", length(dataset)) - # For every dataset (given the splitting variable) estimate a network: for (nw in seq_along(dataset)) { - # When method = "gcgm" a vector with binary values is needed: - nonContVariables <- NULL - if (options[["estimator"]] == "gcgm") { + if (options[["model"]] == "ggm") { + # Estimate network + jaspBase::.setSeedJASP(options) + easybgmFit <- try(easybgm::easybgm(data = apply(dataset[[nw]], 2, as.numeric), + type = "continuous", + package = "BDgraph" , + iter = options[["iter"]], + save = TRUE, + centrality = FALSE, + burnin = options[["burnin"]], + g.start = options[["initialConfiguration"]], + df.prior = options[["dfPrior"]], + g.prior = options[["gPrior"]])) + + if (isTryError(easybgmFit)) { + message <- .extractErrorMessage(easybgmFit) + .quitAnalysis(gettextf("The analysis failed with the following error message:\n%s", message)) + } + + + + # Extract results + easybgmResult <- list() + + easybgmResult$graphWeights <- easybgmFit$graph_weights + easybgmResult$inclusionProbabilities <- easybgmFit$inc_probs + easybgmResult$BF <- easybgmFit$inc_BF + easybgmResult$structure <- easybgmFit$structure + easybgmResult$estimates <- as.matrix(easybgmFit$parameters) + easybgmResult$graph <- easybgmResult$estimates*easybgmResult$structure + easybgmResult$sampleGraphs <- easybgmFit$sample_graph + easybgmResult$samplesPosterior <- list(easybgmFit$samples_posterior) + + networks[[nw]] <- easybgmResult + + } + + # if model is gcgm + if (options[["model"]] == "gcgm") { nonContVariables <- c() for (var in options[["variables"]]) { # A 1 indicates noncontinuous variables: - if (length(levels(factor(dataset[[nw]][[var]]))) <= 8) { + if (is.factor(dataset[[nw]][[var]])) { nonContVariables <- c(nonContVariables, 1) } else { nonContVariables <- c(nonContVariables, 0) } } + # Estimate network + jaspBase::.setSeedJASP(options) + easybgmFit <- try(easybgm::easybgm(data = apply(dataset[[nw]], 2, as.numeric), + type = "mixed", + package = "BDgraph", + not_cont = nonContVariables, + iter = options[["iter"]], + save = TRUE, + centrality = FALSE, + burnin = options[["burnin"]], + g.start = options[["initialConfiguration"]], + df.prior = options[["dfPrior"]], + g.prior = options[["gPrior"]])) + + + if (isTryError(easybgmFit)) { + message <- .extractErrorMessage(easybgmFit) + .quitAnalysis(gettextf("The analysis failed with the following error message:\n%s", message)) + } + + + # Extract results + easybgmResult <- list() + + easybgmResult$graphWeights <- easybgmFit$graph_weights + easybgmResult$inclusionProbabilities <- easybgmFit$inc_probs + easybgmResult$BF <- easybgmFit$inc_BF + easybgmResult$structure <- easybgmFit$structure + easybgmResult$estimates <- as.matrix(easybgmFit$parameters) + easybgmResult$graph <- easybgmResult$estimates*easybgmResult$structure + easybgmResult$sampleGraphs <- easybgmFit$sample_graph + easybgmResult$samplesPosterior <- list(easybgmFit$samples_posterior) + + networks[[nw]] <- easybgmResult } - jaspBase::.setSeedJASP(options) - - # Estimate network: - bdgraphFit <- try(BDgraph::bdgraph(data = as.data.frame(dataset[[nw]]), - method = options[["estimator"]], - not.cont = nonContVariables, - algorithm = "rjmcmc", - iter = as.numeric(options[["iter"]]), - save = TRUE, - burnin = as.numeric(options[["burnin"]]), - g.start = options[["initialConfiguration"]], - df.prior = as.numeric(options[["dfprior"]]), - g.prior = as.numeric(options[["gprior"]]))) - - if (isTryError(bdgraphFit)) { - message <- .extractErrorMessage(bdgraphFit) - if (startsWith(message, "system is computationally singular")) { - .quitAnalysis(gettext("Could not invert the posterior rate matrix. Check if the covariance matrix of your data is singular. For example, check for any pairs of variables with extreme correlations (> .95).")) - } else { - .quitAnalysis(gettextf("BDgraph failed with the following error message:\n%s", message)) + + # if model is ordinal Markov random field + if (options[["model"]] == "omrf") { + for (var in options[["variables"]]) { + # Check if variables are binary or ordinal: + if (!is.factor(dataset[[nw]][[var]])) { + .quitAnalysis(gettext("Some of the variables you have entered for analysis are not binary or ordinal. Please make sure that all variables are binary or ordinal or change the model to gcgm.")) + } } - } + # Estimate network + jaspBase::.setSeedJASP(options) + easybgmFit <- try(easybgm::easybgm(data = dataset[[nw]], + type = "ordinal", + package = "bgms", + iter = options[["iter"]], + save = TRUE, + centrality = FALSE, + burnin = options[["burnin"]], + inclusion_probability = options[["gPrior"]], + interaction_scale = options[["interactionScale"]], + edge_prior = options[["edgePrior"]], + threshold_alpha = options[["thresholdAlpha"]], + threshold_beta = options[["thresholdBeta"]], + beta_bernoulli_alpha = options[["betaAlpha"]], + beta_bernoulli_beta = options[["betaBeta"]], + dirichlet_alpha = options[["dirichletAlpha"]])) + + + + if (isTryError(easybgmFit)) { + message <- .extractErrorMessage(easybgmFit) + .quitAnalysis(gettextf("The analysis failed with the following error message:\n%s", message)) + } + + + # Extract results + easybgmResult <- list() - # Extract results: - bdgraphResult <- list() - - bdgraphResult$graphWeights <- bdgraphFit$graph_weights - bdgraphResult$inclusionProbabilities <- as.matrix(BDgraph::plinks(bdgraphFit)) - bdgraphResult$inclusionProbabilities <- bdgraphResult$inclusionProbabilities + t(bdgraphResult$inclusionProbabilities) - bdgraphResult$BF <- bdgraphResult$inclusionProbabilities / (1 - bdgraphResult$inclusionProbabilities) / (as.numeric(options[["gprior"]]) / (1 - as.numeric(options[["gprior"]]))) - bdgraphResult$structure <- 1*(bdgraphResult$inclusionProbabilities > 0.5) - bdgraphResult$estimates <- pr2pc(bdgraphFit$K_hat); diag(bdgraphResult$estimates) <- 0 - bdgraphResult$graph <- bdgraphResult$estimates*bdgraphResult$structure - bdgraphResult$sampleGraphs <- bdgraphFit$sample_graphs - - # TODO: remove by default and place in the centrality function: - bdgraphResult$samplesPosterior <- extractposterior(bdgraphFit, - as.data.frame(dataset[[nw]]), - options[["estimator"]], - nonContVariables, - options)[[1]] - - networks[[nw]] <- bdgraphResult + easybgmResult$graphWeights <- easybgmFit$graph_weights + easybgmResult$inclusionProbabilities <- easybgmFit$inc_probs + easybgmResult$BF <- easybgmFit$inc_BF + easybgmResult$structure <- easybgmFit$structure + easybgmResult$estimates <- as.matrix(easybgmFit$parameters) + easybgmResult$graph <- easybgmResult$estimates*easybgmResult$structure + easybgmResult$sampleGraphs <- easybgmFit$sample_graph + easybgmResult$samplesPosterior <- list(easybgmFit$samples_posterior) + + networks[[nw]] <- easybgmResult + } } return(networks) @@ -327,7 +411,7 @@ BayesianNetworkAnalysis <- function(jaspResults, dataset, options) { if (is.null(plotContainer)) { plotContainer <- createJaspContainer(dependencies = c("labelAbbreviation", "labelAbbreviationLength", - "legend", "variableNamesShown")) # position = 5 + "legend", "variableNamesShown")) # position = 5 mainContainer[["plotContainer"]] <- plotContainer } @@ -509,13 +593,14 @@ BayesianNetworkAnalysis <- function(jaspResults, dataset, options) { ggplot2::labs(x = NULL, y = NULL, fill = NULL) if (options[["credibilityInterval"]]) { + g <- g + ggplot2::geom_errorbar(ggplot2::aes(x = posteriorMeans, xmin = lower, xmax = upper), size = .5, width = 0.4) } if (length(unique(centralitySummary$type)) > 1) { - g <- g + ggplot2::facet_grid(type ~ measure, scales = "free") + g <- g + ggplot2::facet_grid(type ~ measure, scales = "free") } else { - g <- g + ggplot2::facet_grid(~ measure, scales = "free") + g <- g + ggplot2::facet_grid(~ measure, scales = "free") } g <- g + ggplot2::theme_bw() @@ -569,11 +654,11 @@ BayesianNetworkAnalysis <- function(jaspResults, dataset, options) { dataComplexity <- dplyr::mutate(dataComplexity, complexityWeight = complexityWeight/sum(complexityWeight)) plot <- ggplot2::ggplot(dataComplexity, ggplot2::aes(x = complexity, y = complexityWeight)) + - jaspGraphs::geom_point() + - ggplot2::ylab("Posterior Probability") + - ggplot2::xlab("Number of edges") + - jaspGraphs::geom_rangeframe() + - jaspGraphs::themeJaspRaw(legend.position = c(.85, 0.25)) + jaspGraphs::geom_point() + + ggplot2::ylab("Posterior Probability") + + ggplot2::xlab("Number of edges") + + jaspGraphs::geom_rangeframe() + + jaspGraphs::themeJaspRaw(legend.position = c(.85, 0.25)) complexityPlotContainer[[v]]$plotObject <- plot @@ -595,12 +680,12 @@ BayesianNetworkAnalysis <- function(jaspResults, dataset, options) { title <- if (nGraphs == 1L) gettext("Structure Plot") else gettext("Structure Plots") structurePlotContainer <- createJaspContainer(title = title, dependencies = c("posteriorStructurePlot", - "layout", "layoutSpringRepulsion", "edgeSize", "nodeSize", "colorNodesBy", "cut", "showDetails", "nodePalette", - "legendSpecificPlotNumber", "estimator", - "labelScale", "labelSize", "labelAbbreviation", "labelAbbreviationLength", - "keepLayoutTheSame", "layoutX", "layoutY", - "manualColorGroups", "groupColors", "colorGroupVariables", "groupAssigned", "manualColor", - "legendToPlotRatio", "edgeLabels", "edgeLabelCex", "edgeLabelPosition" + "layout", "layoutSpringRepulsion", "edgeSize", "nodeSize", "colorNodesBy", "cut", "showDetails", "nodePalette", + "legendSpecificPlotNumber", "model", + "labelScale", "labelSize", "labelAbbreviation", "labelAbbreviationLength", + "keepLayoutTheSame", "layoutX", "layoutY", + "manualColorGroups", "groupColors", "colorGroupVariables", "groupAssigned", "manualColor", + "legendToPlotRatio", "edgeLabels", "edgeLabelCex", "edgeLabelPosition" )) plotContainer[["structurePlotContainer"]] <- structurePlotContainer @@ -737,12 +822,12 @@ BayesianNetworkAnalysis <- function(jaspResults, dataset, options) { title <- if (nGraphs == 1L) gettext("Edge Evidence Plot") else gettext("Edge Evidence Plots") evidencePlotContainer <- createJaspContainer(title = title, position = 3, dependencies = c("evidencePlot", - "layout", "layoutSpringRepulsion", "edgeSize", "nodeSize", "colorNodesBy", "cut", "showDetails", "nodePalette", - "legendSpecificPlotNumber", "edgeInclusion", "edgeExclusion", "edgeAbsence", - "labelScale", "labelSize", "labelAbbreviation", "labelAbbreviationLength", - "keepLayoutTheSame", "layoutX", "layoutY", "edgeInclusionCriteria", - "manualColorGroups", "groupColors", "colorGroupVariables", "groupAssigned", "manualColor", - "legendToPlotRatio" + "layout", "layoutSpringRepulsion", "edgeSize", "nodeSize", "colorNodesBy", "cut", "showDetails", "nodePalette", + "legendSpecificPlotNumber", "edgeInclusion", "edgeExclusion", "edgeAbsence", + "labelScale", "labelSize", "labelAbbreviation", "labelAbbreviationLength", + "keepLayoutTheSame", "layoutX", "layoutY", "edgeInclusionCriteria", + "manualColorGroups", "groupColors", "colorGroupVariables", "groupAssigned", "manualColor", + "legendToPlotRatio" )) plotContainer[["evidencePlotContainer"]] <- evidencePlotContainer @@ -1006,6 +1091,12 @@ BayesianNetworkAnalysis <- function(jaspResults, dataset, options) { } table$setData(TBcolumns) } + + # add footnote on the infinities only show this message of the evidence type is BF10 or BF01 + + if (options$evidenceType %in% c("BF10", "BF01")){ + table$addFootnote("Bayes factors with values of infinity indicate that the estimated posterior inclusion probability is either 1 or 0. Please see the help file for more information.") + } mainContainer[["edgeEvidenceTable"]] <- table } @@ -1144,10 +1235,10 @@ centrality <- function(network, measures = c("closeness", "betweenness", "streng if (options[["credibilityInterval"]]) { # Compute centrality for each posterior sample: - for (i in seq_len(nrow(network$samplesPosterior))) { + for (i in seq_len(nrow(network$samplesPosterior[[1]]))) { # TODO: this should call centralityTable rather than centralityPlot - graph <- qgraph::centralityPlot(vectorToMatrix(network$samplesPosterior[i, ], as.numeric(nrow(network$estimates)), bycolumn = TRUE), + graph <- qgraph::centralityPlot(vectorToMatrix(network$samplesPosterior[[1]][i, ], as.numeric(nrow(network$estimates)), bycolumn = TRUE), include = measures, verbose = FALSE, print = FALSE, @@ -1158,7 +1249,7 @@ centrality <- function(network, measures = c("closeness", "betweenness", "streng # see https://github.com/jasp-stats/jasp-test-release/issues/2298 if (nrow(graph$data) != nrow(centralityOutput) && "Strength" %in% measures && - all(abs(network$samplesPosterior[i, ]) <= .Machine$double.eps)) { + all(abs(network$samplesPosterior[[1]][i, ]) <= .Machine$double.eps)) { idx <- centralityOutput$measure %in% graph$data$measure value <- numeric(nrow(centralityOutput)) diff --git a/R/networkanalysis.R b/R/networkanalysis.R index a02aeff..fed9605 100644 --- a/R/networkanalysis.R +++ b/R/networkanalysis.R @@ -677,6 +677,14 @@ NetworkAnalysis <- function(jaspResults, dataset, options) { .networkAnalysisNetworkPlot <- function(plotContainer, network, options, method = "frequentist", dataset = NULL) { + + # Adjust options based on method + if (method == "frequentist") { + estimator <- options[["estimator"]] + } else if (method == "Bayesian") { + model <- options[["model"]] + } + if (!is.null(plotContainer[["networkPlotContainer"]]) || !options[["networkPlot"]]) return() @@ -753,7 +761,7 @@ NetworkAnalysis <- function(jaspResults, dataset, options) { # defaults shape <- "circle" edgeColor <- NULL - if (options[["estimator"]] == "mgm") { + if (method == "frequentist" && estimator == "mgm") { idx <- integer(length(options[["variables"]])) nms <- c("mgmContinuousVariables", "mgmCategoricalVariables", "mgmCountVariables") @@ -852,7 +860,7 @@ NetworkAnalysis <- function(jaspResults, dataset, options) { for (v in names(allNetworks)) { networkToPlot <- allNetworks[[v]] - if (options[["estimator"]] == "mgm") { + if (method == "frequentist" && estimator == "mgm") { edgeColor <- networkToPlot[["results"]][["edgecolor"]] if (is.null(edgeColor)) # compatability issues edgeColor <- networkToPlot[["results"]][["pairwise"]][["edgecolor"]] diff --git a/inst/qml/BayesianNetworkAnalysis.qml b/inst/qml/BayesianNetworkAnalysis.qml index bd06baa..01f75a3 100644 --- a/inst/qml/BayesianNetworkAnalysis.qml +++ b/inst/qml/BayesianNetworkAnalysis.qml @@ -24,22 +24,30 @@ import JASP.Widgets 1.0 Form { - VariablesForm +VariablesForm { AvailableVariablesList { name: "allVariablesList" } - AssignedVariablesList { name: "variables"; title: qsTr("Dependent Variables"); allowedColumns: ["scale"]; id: networkVariables} - AssignedVariablesList { name: "groupingVariable"; title: qsTr("Split"); singleVariable: true; allowedColumns: ["nominal"] } + AssignedVariablesList { name: "variables"; + title: qsTr("Dependent Variables"); + allowedColumns: ["ordinal", "scale"]; + allowTypeChange: true; + id: networkVariables} + AssignedVariablesList { name: "groupingVariable"; + title: qsTr("Split"); + singleVariable: true; + allowedColumns: ["nominal"] } } - + DropDown { - id: estimator - name: "estimator" - label: qsTr("Estimator") + id: model + name: "model" + label: qsTr("Model") Layout.columnSpan: 2 values: [ - { value: "ggm", label: "ggm" }, - { value: "gcgm", label: "gcgm" } + { value: "ggm", label: "ggm (continuous)" }, + { value: "gcgm", label: "gcgm (mixed)" }, + { value: "omrf", label: "omrf (binary/ordinal)" } ] } @@ -47,8 +55,8 @@ Form { title: qsTr("Plots") CheckBox { name: "networkPlot"; label: qsTr("Network plot") } - CheckBox { - name: "evidencePlot"; + CheckBox { + name: "evidencePlot"; label: qsTr("Edge evidence plot") IntegerField { name: "edgeInclusionCriteria"; @@ -61,21 +69,22 @@ Form CheckBox { name: "edgeExclusion"; label: qsTr("Evidence for exclusion"); checked: true } CheckBox { name: "edgeAbsence"; label: qsTr("Absence of evidence"); checked: true } } - CheckBox { - name: "centralityPlot"; id: centralityPlot; label: qsTr("Centrality plot") - CheckBox { - name: "credibilityInterval"; - label: qsTr("Credibility interval 95%"); - checked: false - } - } + CheckBox { + name: "centralityPlot"; id: centralityPlot; label: qsTr("Centrality plot") + CheckBox { + name: "credibilityInterval"; + label: qsTr("Credibility interval 95%"); + checked: false; + visible: model.currentValue === "omrf"; // Show only when model is "omrf" + } + } } Group { title: qsTr("Tables") CheckBox { name: "weightsMatrixTable"; label: qsTr("Weights matrix") } - CheckBox { + CheckBox { name: "edgeEvidenceTable"; label: qsTr("Edge evidence probability table") RadioButtonGroup { name: "evidenceType"; @@ -87,38 +96,154 @@ Form } CheckBox { name: "centralityTable"; label: qsTr("Centrality table") } } - - Section + + Section { title: qsTr("Sampling Options") Layout.columnSpan: 2 - IntegerField { name: "burnin"; label: qsTr("Burn in: "); value: "5000" ; min: 0; max: iter.value / 2; fieldWidth: 100; id: burnin } - IntegerField { name: "iter"; label: qsTr("Iterations: "); value: "10000" ; min: burnin.value * 2; fieldWidth: 100; id: iter } - + IntegerField { name: "burnin"; label: qsTr("Burn in: "); value: 1000 ; min: 0; max: iter.value / 2; fieldWidth: 100; id: burnin } + IntegerField { name: "iter"; label: qsTr("Iterations: "); value: 10000 ; min: burnin.value * 2; fieldWidth: 100; id: iter } + SetSeed{} } - Section - { - title: qsTr("Prior") - - FormulaField { name: "gprior"; label: qsTr("Prior edge inclusion (g prior): "); value: "0.5" ; min: 0.001; max: 1; Layout.columnSpan: 2 } - - DropDown - { - id: initialConfiguration - name: "initialConfiguration" - label: qsTr("Initial configuration prior edge inclusion (g start):") - Layout.columnSpan: 2 - values: [ - { value: "empty", label: "empty" }, - { value: "full", label: "full" } - ] - } - - IntegerField { name: "dfprior"; label: qsTr("Degrees of freedom of G-Wishart prior (df prior): "); value: "3" ; min: 3; Layout.columnSpan: 2 } + Section { + title: qsTr("Prior Specification") + Layout.fillWidth: true + Column { + spacing: 15 + anchors.fill: parent - } + Group { + title: qsTr("Network Structure (Edge) Priors") + Layout.fillWidth: true + + Column { + spacing: 10 + Layout.fillWidth: true + + DropDown { + id: edgePrior + name: "edgePrior" + label: qsTr("Edge prior:") + Layout.fillWidth: true + preferredWidth: 300 + values: [ + { value: "Bernoulli", label: "Bernoulli" }, + { value: "Beta-Bernoulli", label: "Beta-Bernoulli" }, + { value: "Stochastic-Block", label: "Stochastic Block" } + ] + visible: model.currentValue === "omrf" + } + + DoubleField { + name: "gPrior" + label: qsTr("Prior edge inclusion probability:") + value: 0.5 + min: 0.001 + max: 1 + Layout.fillWidth: true + preferredWidth: 300 + visible: (model.currentValue === "ggm" || model.currentValue === "gcgm") || (model.currentValue === "omrf" && edgePrior.currentValue === "Bernoulli") + } + + DoubleField { + name: "betaAlpha" + label: qsTr("Shape parameter 1:") + value: 1 + min: 0.001 + Layout.fillWidth: true + preferredWidth: 300 + visible: (model.currentValue === "omrf") && (edgePrior.currentValue === "Beta-Bernoulli" || edgePrior.currentValue === "Stochastic-Block") + } + + DoubleField { + name: "betaBeta" + label: qsTr("Shape parameter 2:") + value: 1 + min: 0.001 + Layout.fillWidth: true + preferredWidth: 300 + visible: (model.currentValue === "omrf") && (edgePrior.currentValue === "Beta-Bernoulli" || edgePrior.currentValue === "Stochastic-Block") + } + + DoubleField { + name: "dirichletAlpha" + label: qsTr("Concentration parameter:") + value: 1 + min: 0.001 + Layout.fillWidth: true + preferredWidth: 300 + visible: (model.currentValue === "omrf") && (edgePrior.currentValue === "Stochastic-Block") + } + + DropDown { + id: initialConfiguration + name: "initialConfiguration" + label: qsTr("Initial configuration prior edge inclusion:") + Layout.fillWidth: true + preferredWidth: 300 + values: [ + { value: "empty", label: "empty" }, + { value: "full", label: "full" } + ] + visible: model.currentValue === "ggm" || model.currentValue === "gcgm" + } + } + } + + Group { + title: qsTr("Parameter Priors") + Layout.fillWidth: true + + Column { + spacing: 10 + Layout.fillWidth: true + + IntegerField { + name: "dfPrior" + label: qsTr("Degrees of freedom of G-Wishart prior:") + value: 3 + min: 3 + Layout.fillWidth: true + preferredWidth: 300 + visible: model.currentValue === "ggm" || model.currentValue === "gcgm" + } + + DoubleField { + name: "interactionScale" + label: qsTr("Scale of the Cauchy distribution for the edge weights:") + value: 2.5 + min: 0.1 + Layout.fillWidth: true + preferredWidth: 300 + visible: model.currentValue === "omrf" + } + + + DoubleField { + name: "thresholdAlpha" + label: qsTr("Threshold shape parameter 1:") + value: 1 + min: 0.001 + Layout.fillWidth: true + preferredWidth: 300 + visible: model.currentValue === "omrf" + } + + DoubleField { + name: "thresholdBeta" + label: qsTr("Threshold shape parameter 2:") + value: 1 + min: 0.001 + Layout.fillWidth: true + preferredWidth: 300 + visible: model.currentValue === "omrf" + } + } + } + } +} Section @@ -246,7 +371,7 @@ Form RadioButton { value: "inNodes"; label: qsTr("In plot"); checked: true } RadioButton { value: "inLegend"; label: qsTr("In legend") } } - + RadioButtonGroup { name: "legend" @@ -292,7 +417,7 @@ Form CheckBox { name: "expectedInfluence"; label: qsTr("Expected influence"); checked: true } } } - + Section { title: qsTr("Network structure selection") diff --git a/renv.lock b/renv.lock index 450902e..eeba594 100644 --- a/renv.lock +++ b/renv.lock @@ -1,3 +1,4 @@ + { "R": { "Version": "4.4.2",