-
SOCR Interactive Probability Distribution Calculator [Version: V.0.9]
- The SOCR RShiny probability distribution calculators provide interactive vizualizations of probability densities,
- mass functions, and cumulative distributions, e.g., bivariate normal distribution.
-
-
Acknowledgments
-
- This work is supported in part by NIH grants P20 NR015331, UL1TR002240, P30 DK089503, UL1TR002240,
- and NSF grants 1916425, 1734853, 1636840, 1416953, 0716055 and 1023115. Students, trainees, scholars,
- and researchers from SOCR, BDDS, MIDAS, MICHR, and the broad R-statistical computing community have contributed ideas,
- code, and support.
-
- Developers
- Jared (Tianyi) Chai (chtianyi@umich.edu)
- Shihang Li (shihangl@umich.edu)
- Yongxiang Zhao (zyxleo@umich.edu)
- Bole Li (boleli@umich.edu)
- Joonseop Kim (joonkim@umich.edu)
- Ivo Dinov (dinov@med.umich.edu).
-
- "),
- easyClose = TRUE
- ))
- })
- # ----------------------- Render Metadata Information from xml Database ----------------------- #
- output$MetaData <- renderPrint({
- distType <- input$Distribution
- distType <- tolower(str_replace_all(distType, "[^[:alnum:]]", ""))
- counter <- 0
- for (i in 1:xml_len) {
- j <- 1
- while (distributions_meta[[j, i * 2 - 1]] == "name") {
- if (tolower(str_replace_all(distributions_meta[[1, i * 2]], "[^[:alnum:]]", "")) == distType) {
- counter <- i
- break
- } else {
- j <- j + 1
- }
- }
- }
- outputstring <- ""
- if (counter != 0) {
- row <- 1
- while (distributions_meta[[row, counter * 2 - 1]] != "" && row < xml_wid) {
- outputstring <- paste(outputstring, "
", distributions_meta[[row, counter * 2 - 1]], ": ", distributions_meta[[row, counter * 2]], "\n", sep = "")
- row <- row + 1
- }
- }
- withMathJax(helpText(HTML(outputstring)))
- })
- # ----------------------- Render Main Plot ----------------------- #
- renderMainPlot(input, output, session, dataset)
- # ----------------------- Render Implementing Message ----------------------- #
- output$Implementing <- renderText({
- if (input$Distribution %in% distToImpl) {
- paste("The ", input$Distribution, " is still being implemented.", sep = "")
- }
- })
- # ----------------------- Calculate and Render Probability ----------------------- #
- renderProbability(input, output, session)
-
-
- # Imputation of categorical variables using Mode
- getmode <- function(v) {
- v <- v[nchar(as.character(v)) > 0]
- uniqv <- unique(v)
- uniqv[which.max(tabulate(match(v, uniqv)))]
- }
-
- # Render the DataTable dynamically based on the reactive dataset
- output$tbl <- DT::renderDataTable({
- # Use isolate to prevent invalidation of the reactive expression on initial render
- DT::datatable(datasetShown(), options = list(lengthChange = FALSE))
- })
-
- # Regression output
- output$summary <- renderPrint({
- fit <- lm(unlist(dataset[, input$outcome]) ~ unlist(dataset[, input$indepvar]))
- names(fit$coefficients) <- c("Intercept", input$var2)
- fitCurrent <- fit
- summary(fit)
- })
-
- # Scatterplot output
- output$scatterplot <- renderPlotly({
- plot_ly(
- x = ~ unlist(dataset[, input$indepvar]), y = ~ unlist(dataset[, input$outcome]),
- type = "scatter", mode = "markers", name = "Data"
- ) %>%
- add_lines(
- x = ~ unlist(dataset[, input$indepvar]),
- y = ~ (lm(unlist(dataset[, input$outcome]) ~ unlist(dataset[, input$indepvar]))$fitted.values),
- mode = "lines", name = "Linear Model"
- ) %>%
- add_lines(
- x = ~ lowess(unlist(dataset[, input$indepvar]), unlist(dataset[, input$outcome]))$x,
- y = ~ lowess(unlist(dataset[, input$indepvar]), unlist(dataset[, input$outcome]))$y,
- mode = "lines", name = "LOESS"
- ) %>%
- add_markers(
- x = mean(unlist(dataset[, input$indepvar])), y = mean(unlist(dataset[, input$outcome])),
- name = "Center Point", marker = list(size = 20, color = "green", line = list(color = "yellow", width = 2))
- ) %>%
- layout(
- title = paste0(
- "lm(", input$outcome, " ~ ", input$indepvar,
- "), Cor(", input$indepvar, ",", input$outcome, ") = ",
- round(cor(unlist(dataset[, input$indepvar]), unlist(dataset[, input$outcome])), 3)
- ),
- xaxis = list(title = input$indepvar), yaxis = list(title = input$outcome)
- )
- })
- }
-)
+# SOCR Probability Distribution Calculator
+# Version 0.9
+# Updated December 8th by Bole Li and Joonseop Kim at the University of Michigan -SOCR
+# Orginally created by Jared(Tianyi) Chai
+
+# This is a SOCR Interactive Graphical Probability Distribution Calculator
+# You can run the application by clicking
+# the 'Run App' button above.
+
+# ----------------------- Server.R ----------------------- #
+# For backend calculations
+library(xml2)
+library(shinyjs)
+library(flexsurv)
+library(vcdExtra)
+library(evd)
+library(DescTools)
+library(shiny)
+library(triangle)
+library(plotly)
+library(stringr)
+library(VGAM)
+library(BayesTools)
+library(extraDistr)
+library(statmod)
+library(truncnorm)
+library(tolerance)
+library(chi)
+library(Rlab)
+library(shinyWidgets)
+library(circular)
+library(mnormt)
+library(ExtDist)
+library(VaRES)
+library(shinyjs)
+library(benford.analysis)
+shinyjs::useShinyjs()
+source("renderMainPlot.R")
+source("renderProbability.R")
+
+shinyServer(
+ function(input, output, session) {
+ datasetShown <- reactiveVal(iris)
+ # ----------------------- Update Distribution Type and Function Type according to URL handle ----------------------- #
+ observe({
+ query <- parseQueryString(session$clientData$url_search)
+ if (!is.null(query[["d"]])) {
+ updateSelectInput(session, "Distribution", selected = distributions[as.numeric(query[["d"]])])
+ updateSelectInput(session, "FunctionType", selected = "PDF/PMF")
+ if (!is.null(query[["t"]])) {
+ updateSelectInput(session, "FunctionType", selected = query[["t"]])
+ }
+ }
+ # ----------------------- Update Range of Probability Calculation according to Range of X ----------------------- #
+ updateSliderInput(session,
+ "probrange",
+ value = 0,
+ min = input$plotrange[1],
+ max = input$plotrange[2],
+ step = 0.01
+ )
+ updateNumericInput(session,
+ "probrangeNumMin",
+ value = 0,
+ min = input$plotrangeNumMin,
+ max = input$plotrangeNumMax
+ )
+ updateNumericInput(session,
+ "probrangeNumMax",
+ value = 0,
+ min = input$plotrangeNumMin,
+ max = input$plotrangeNumMax
+ )
+ })
+
+ observeEvent(input$fitParams, {
+ updateTextInput(session, "FunctionType", value = "PDF/PMF")
+ distributionInfo <- distributionInfoList[[input$Distribution]]
+ if (input$Distribution == "Bernoulli Distribution") {
+ if (is.null(dataset)) {
+ showNotification("Dataset is not specified.", type = "error", duration = 2)
+ } else if (!all(dataset[, input$outcome] %in% c(0, 1))) {
+ # Show a warning if the dataset is not binary
+ showNotification("Dataset must be binary for the Bernoulli distribution.", type = "error", duration = 4)
+ }
+ }
+ # Check if fitting is supported for other distributions
+
+
+ if (is.null(dataset)) {
+ showNotification("Dataset is not specified.", type = "error", duration = 2)
+ } else if (is.null((distributionInfo$fitFunc))) {
+ showNotification("Fitting this distribution is not supported yet.", type = "error", duration = 2)
+ } else {
+ fit_result <- distributionInfo$fitFunc(dataset[, input$outcome])
+ #if (input$Distribution == "Circle Distribution") {
+ # selected_data <- dataset[, c(input$outcome, input$indepvar)]
+ # fit_result <- distributionInfo$fitFunc(selected_data)
+ #}
+ for (i in 1:length(fit_result$estimate)) {
+ inputName <- distributionInfo$inputNames[[i]]
+ fitted_parameter <- round(fit_result$estimate[[i]], digits = 4)
+ updateTextInput(session, inputName, value = fitted_parameter)
+ session$sendCustomMessage("highlightTextInput", inputName)
+ }
+ if (distributionInfo$isWithSD) {
+ # update the plot range, make it centered at the mean
+ oldPlotRange <- input$plotrange
+ halfLength <- (oldPlotRange[2] - oldPlotRange[1]) / 2
+ updateSliderInput(session,
+ "plotrange",
+ label = NULL,
+ value = c(fit_result$estimate[[1]] - halfLength, fit_result$estimate[[1]] + halfLength),
+ min = -1000,
+ max = 1000,
+ step = NULL,
+ timeFormat = NULL,
+ timezone = NULL
+ )
+ }
+ }
+ })
+
+ observe({
+ if (input$numericalValues == 0 && input$Distribution %in% distWithSD) {
+ shinyjs::enable("SDNum")
+ # FIXME: This is not working
+ # shinyjs::toggle("SDNumColumn", condition = TRUE)
+ } else {
+ shinyjs::disable("SDNum")
+ # FIXME: This is not working
+ # shinyjs::toggle("SDNumColumn", condition = FALSE)
+ }
+ })
+
+ # Generate text to display current parameters and their values
+ output$currentParameters <- renderUI(
+ HTML({
+ distributionInfo <- distributionInfoList[[input$Distribution]]
+ paramValues <- lapply(seq_along(distributionInfo$labels), function(i) {
+ label <- distributionInfo$labels[[i]]
+ inputName <- distributionInfo$inputNames[[i]]
+ paste("
", label, ":
", input[[inputName]], "")
+ })
+ # Combine the distribution name and parameter values into a single string
+ paste("Current Parameters:
", paste(paramValues, collapse = "
"))
+ })
+ )
+
+ observeEvent(input$CalcModelerTabsetPanel, {
+ if (input$CalcModelerTabsetPanel == "Modeler") {
+ updateTextInput(session, "FunctionType", value = "")
+ }
+ })
+
+ # Reactive function to read uploaded file and update dataset
+ observeEvent(input$file, {
+ req(input$file)
+ dataset <<- read.csv(input$file$datapath)
+ datasetShown(dataset)
+ # Update choices for selectInput widgets
+ updateSelectInput(session, "outcome", choices = namedListOfFeatures(), selected = NULL)
+ updateSelectInput(session, "indepvar", choices = namedListOfFeatures(), selected = NULL)
+ })
+
+ # ----------------------- HelpMe ----------------------- #
+ observeEvent(input$vh.readme, {
+ showModal(modalDialog(
+ title = "Help / ReadMe",
+ HTML("
+
SOCR Interactive Probability Distribution Calculator [Version: V.0.9]
+ The SOCR RShiny probability distribution calculators provide interactive vizualizations of probability densities,
+ mass functions, and cumulative distributions, e.g., bivariate normal distribution.
+
+
Acknowledgments
+
+ This work is supported in part by NIH grants P20 NR015331, UL1TR002240, P30 DK089503, UL1TR002240,
+ and NSF grants 1916425, 1734853, 1636840, 1416953, 0716055 and 1023115. Students, trainees, scholars,
+ and researchers from SOCR, BDDS, MIDAS, MICHR, and the broad R-statistical computing community have contributed ideas,
+ code, and support.
+
+ Developers
+ Jared (Tianyi) Chai (chtianyi@umich.edu)
+ Shihang Li (shihangl@umich.edu)
+ Yongxiang Zhao (zyxleo@umich.edu)
+ Bole Li (boleli@umich.edu)
+ Joonseop Kim (joonkim@umich.edu)
+ Ivo Dinov (dinov@med.umich.edu).
+
+ "),
+ easyClose = TRUE
+ ))
+ })
+ # ----------------------- Render Metadata Information from xml Database ----------------------- #
+ output$MetaData <- renderPrint({
+ distType <- input$Distribution
+ distType <- tolower(str_replace_all(distType, "[^[:alnum:]]", ""))
+ counter <- 0
+ for (i in 1:xml_len) {
+ j <- 1
+ while (distributions_meta[[j, i * 2 - 1]] == "name") {
+ if (tolower(str_replace_all(distributions_meta[[1, i * 2]], "[^[:alnum:]]", "")) == distType) {
+ counter <- i
+ break
+ } else {
+ j <- j + 1
+ }
+ }
+ }
+ outputstring <- ""
+ if (counter != 0) {
+ row <- 1
+ while (distributions_meta[[row, counter * 2 - 1]] != "" && row < xml_wid) {
+ outputstring <- paste(outputstring, "
", distributions_meta[[row, counter * 2 - 1]], ": ", distributions_meta[[row, counter * 2]], "\n", sep = "")
+ row <- row + 1
+ }
+ }
+ withMathJax(helpText(HTML(outputstring)))
+ })
+ # ----------------------- Render Main Plot ----------------------- #
+ renderMainPlot(input, output, session, dataset)
+ # ----------------------- Render Implementing Message ----------------------- #
+ output$Implementing <- renderText({
+ if (input$Distribution %in% distToImpl) {
+ paste("The ", input$Distribution, " is still being implemented.", sep = "")
+ }
+ })
+ # ----------------------- Calculate and Render Probability ----------------------- #
+ renderProbability(input, output, session)
+
+
+ # Imputation of categorical variables using Mode
+ getmode <- function(v) {
+ v <- v[nchar(as.character(v)) > 0]
+ uniqv <- unique(v)
+ uniqv[which.max(tabulate(match(v, uniqv)))]
+ }
+
+ # Render the DataTable dynamically based on the reactive dataset
+ output$tbl <- DT::renderDataTable({
+ # Use isolate to prevent invalidation of the reactive expression on initial render
+ DT::datatable(datasetShown(), options = list(lengthChange = FALSE))
+ })
+
+ # Regression output
+ output$summary <- renderPrint({
+ fit <- lm(unlist(dataset[, input$outcome]) ~ unlist(dataset[, input$indepvar]))
+ names(fit$coefficients) <- c("Intercept", input$var2)
+ fitCurrent <- fit
+ summary(fit)
+ })
+
+ # Scatterplot output
+ output$scatterplot <- renderPlotly({
+ plot_ly(
+ x = ~ unlist(dataset[, input$indepvar]), y = ~ unlist(dataset[, input$outcome]),
+ type = "scatter", mode = "markers", name = "Data"
+ ) %>%
+ add_lines(
+ x = ~ unlist(dataset[, input$indepvar]),
+ y = ~ (lm(unlist(dataset[, input$outcome]) ~ unlist(dataset[, input$indepvar]))$fitted.values),
+ mode = "lines", name = "Linear Model"
+ ) %>%
+ add_lines(
+ x = ~ lowess(unlist(dataset[, input$indepvar]), unlist(dataset[, input$outcome]))$x,
+ y = ~ lowess(unlist(dataset[, input$indepvar]), unlist(dataset[, input$outcome]))$y,
+ mode = "lines", name = "LOESS"
+ ) %>%
+ add_markers(
+ x = mean(unlist(dataset[, input$indepvar])), y = mean(unlist(dataset[, input$outcome])),
+ name = "Center Point", marker = list(size = 20, color = "green", line = list(color = "yellow", width = 2))
+ ) %>%
+ layout(
+ title = paste0(
+ "lm(", input$outcome, " ~ ", input$indepvar,
+ "), Cor(", input$indepvar, ",", input$outcome, ") = ",
+ round(cor(unlist(dataset[, input$indepvar]), unlist(dataset[, input$outcome])), 3)
+ ),
+ xaxis = list(title = input$indepvar), yaxis = list(title = input$outcome)
+ )
+ })
+ }
+)