render app to html

docs/app.json

@@ -0,0 +1 @@
+[{"name":"app.R","content":"#' corGraph Shiny App\n#' \n#' Launches the corGraph Shiny App \n#'\n#' @importFrom shiny shinyApp\n#' @param ... arguments to pass to \\code{shinyApp}\n#' @export\ncorGraph <- function(...) {\n  shiny::shinyApp(ui, server, ...)\n}","type":"text"},{"name":"server.R","content":"readData <- function(file) {\n  if (is.null(file)) {\n    return(NULL)\n  }\n\n  fileExtension <- tools::file_ext(file$name)\n  if (fileExtension %in% c('tab','tsv')) {\n    matrixData <- utils::read.table(file$datapath, header = TRUE, sep = '\\t')\n  } else if (fileExtension == 'rds') {\n    matrixData <- readRDS(file$datapath)\n  } else {\n    stop('Unsupported file type')\n  }\n\n  return(matrixData)\n}\n\n#' @importFrom DT renderDT\n#' @importFrom utils read.table\n#' @importFrom Hmisc rcorr\n#' @importFrom data.table as.data.table\n#' @importFrom data.table melt\n#' @import ggplot2\nserver <- function(input, output, session) {\n  options(shiny.maxRequestSize=30*1024^2) # 30 MB\n\n  data1 <- shiny::reactiveValues(matrix = NULL)\n  data2 <- shiny::reactiveValues(matrix = NULL)\n  correlationMatrix <- shiny::reactiveValues(corr_matrix = NULL)\n  pValuesMatrix <- shiny::reactiveValues(p_values = NULL)\n  upload_state <- reactiveValues(file1 = NULL, file2 = NULL)\n  output$correlationNetwork <- shiny::renderUI({})\n  outputOptions(output, \"correlationNetwork\", suspendWhenHidden = FALSE)\n\n  output$file1 <- renderUI({\n    input$resetData ## Create a dependency with the reset button\n    shiny::fileInput(\"fileUpload\", shiny::strong(\"Upload Data Table\"), accept = c(\".tab\", \"tsv\",\".rds\"))\n  })\n\n  observeEvent(input$fileUpload, {\n    upload_state$file1 <- 'uploaded'\n  })\n\n  output$file2 <- renderUI({\n    input$resetData\n    shiny::fileInput(\"fileUpload2\", shiny::strong(\"Upload Second Data Table (optional)\"), accept = c(\".tab\", \"tsv\",\".rds\"))\n  })\n\n  observeEvent(input$fileUpload2, {\n    upload_state$file2 <- 'uploaded'\n  })\n\n  shiny::observeEvent(input$resetData, {\n    print(\"Resetting data...\")\n    data1$matrix <- NULL\n    data2$matrix <- NULL\n    correlationMatrix$corr_matrix <- NULL\n    pValuesMatrix$p_values <- NULL\n    upload_state$file1 <- \"reset\"\n    upload_state$file2 <- \"reset\"\n  })\n\n  listenForFileUploads <- reactive({\n    list(upload_state$file1, upload_state$file2)\n  })\n\n  shiny::observeEvent(listenForFileUploads(), {\n    if (is.null(input$fileUpload) && is.null(input$fileUpload2)) {\n      return(NULL)\n    }\n    if (upload_state$file1 == 'reset' && upload_state$file2 == 'reset') {\n      file1 <- NULL\n      file2 <- NULL\n    } else if (upload_state$file1 == 'uploaded' && (is.null(upload_state$file2) || upload_state$file2 == 'reset')) {\n      file1 <- input$fileUpload\n      file2 <- NULL\n    } else if (upload_state$file2 == 'uploaded' && (is.null(upload_state$file1) || upload_state$file1 == 'reset')) {\n      shiny::showNotification('Please upload the first file first.', type = 'error')\n    } else {\n      file1 <- input$fileUpload\n      file2 <- input$fileUpload2\n    }\n\n    tryCatch({\n      if (!is.null(file1)) {\n        data1$matrix <- readData(file1)\n        if (!is.null(file2)) {\n          data2$matrix <- readData(file2)\n        }\n      }\n\n    }, error = function(e) {\n      shiny::showNotification(paste('Error:', e$message), type = 'error')\n    })\n  })\n  \n  shiny::observeEvent({\n    data1$matrix\n    data2$matrix\n    input$correlationMethod\n  }, {\n    if (is.null(data1$matrix)) {\n      return(NULL)\n    }\n\n    if (is.null(data2$matrix)) {\n      corrResult <- Hmisc::rcorr(as.matrix(data1$matrix), type = input$correlationMethod)  \n    } else {   \n      corrResult <- Hmisc::rcorr(as.matrix(data1$matrix), as.matrix(data2$matrix), type = input$correlationMethod)    \n    }    \n\n    pValuesMatrix$p_values <- corrResult$P\n    correlationMatrix$corr_matrix <- corrResult$r\n  })\n\n  output$correlationHistogram <- renderPlot({\n    corValues <- req(edgeList()$value)\n    \n    ggplot2::ggplot(data.frame(cor_values = corValues), ggplot2::aes(x = cor_values)) +\n      ggplot2::geom_histogram(bins = 30, fill = 'steelblue') +\n      ggplot2::labs(title = \"Distribution of Correlation Coefficients\", x = 'Correlation Coefficient', y = 'Frequency') +\n      ggplot2::theme_minimal()\n  })\n\n  output$pValueHistogram <- renderPlot({\n    pVals <- req(edgeList()$p_value)\n    \n    ggplot2::ggplot(data.frame(p_values = pVals), ggplot2::aes(x = p_values)) +\n      ggplot2::geom_histogram(bins = 30, fill = 'steelblue') +\n      ggplot2::labs(title = \"Distribution of P-Values\", x = 'P-Value', y = 'Frequency') +\n      ggplot2::theme_minimal()\n  })\n\n  edgeList <- eventReactive({\n    correlationMatrix$corr_matrix\n    pValuesMatrix$p_values\n  },{\n    if (is.null(correlationMatrix$corr_matrix) || is.null(pValuesMatrix$p_values)) {\n      return(NULL)\n    }\n\n    if (is.null(data2$matrix)) {\n      # deduplicate\n      pVals <- pValuesMatrix$p_values\n      corrResult <- correlationMatrix$corr_matrix\n\n      edge_list <- expand.grid(source = row.names(corrResult),\n                               target = colnames(corrResult))\n    \n      deDupedEdges <- edge_list[as.vector(upper.tri(corrResult)),]\n      edge_list <- cbind(deDupedEdges, corrResult[upper.tri(corrResult)])\n      edge_list <- cbind(edge_list, pVals[upper.tri(pVals)])\n\n      colnames(edge_list) <- c(\"source\",\"target\",\"value\",\"p_value\")\n    } else {\n      lastData1ColIndex <- length(data1$matrix)\n      firstData2ColIndex <- length(data1$matrix) + 1\n\n      # this bc Hmisc::rcorr cbinds the two data.tables and runs the correlation\n      # so we need to extract only the relevant values\n      p_values <- pValuesMatrix$p_values[1:lastData1ColIndex, firstData2ColIndex:length(colnames(pValuesMatrix$p_values))]\n      corr_matrix <- correlationMatrix$corr_matrix[1:lastData1ColIndex, firstData2ColIndex:length(colnames(correlationMatrix$corr_matrix))]\n\n      corr_matrix <- data.table::as.data.table(corr_matrix, keep.rownames = TRUE)\n      p_values <- data.table::as.data.table(p_values, keep.rownames = TRUE)\n\n      if (is.null(corr_matrix) || is.null(p_values)) {\n        return(NULL)\n      }\n\n      meltedCorrResult <- data.table::melt(corr_matrix, id.vars=c('rn'))\n      meltedPVals <- data.table::melt(p_values, id.vars=c('rn'))\n      edge_list <- data.frame(\n        source = meltedCorrResult[['rn']],\n        target = meltedCorrResult[['variable']],\n        value = meltedCorrResult[['value']],\n        # should we do a merge just to be sure?\n        p_value = meltedPVals[['value']]\n      )\n    }\n\n    return(edge_list)\n  })\n\n  filteredEdgeList <- reactive({\n    edgeList <- req(edgeList())\n\n    if (is.null(edgeList)) {\n      return(NULL)\n    }\n\n    edgeList <- subset(edgeList, abs(edgeList$value) >= input$correlationFilter)\n    edgeList <- subset(edgeList, edgeList$p_value <= input$pValueFilter)\n\n    return(edgeList)\n  })\n\n  output$correlationMatrix <- DT::renderDT({\n    edgeList <- req(filteredEdgeList())\n    return(edgeList)\n  })\n\n  # eventually offer the option to show either bipartite or unipartite for any input data\n  output$correlationNetwork <- renderUI({\n    if (is.null(data1$matrix)) {\n      return(NULL)\n    } else {\n      if (is.null(data2$matrix)) {\n        unipartiteNetworkOutput(\"unipartiteNetwork\", width = '100%', height = '1000px')\n      } else {\n        height <- max(length(data1$matrix), length(data2$matrix))\n        height <- paste0(height * 50, 'px')\n        bipartiteNetworkOutput(\"bipartiteNetwork\", width = '100%', height = height)\n      }\n    }\n  })\n\n  output$unipartiteNetwork <- renderUnipartiteNetwork({\n    edgeList <- req(filteredEdgeList())\n\n    if (is.null(edgeList) || nrow(edgeList) == 0 || !is.null(data2$matrix)) {\n      return(NULL)\n    }\n\n    network <- unipartiteNetwork(edgeList)\n    return(network)\n  })\n\n  output$bipartiteNetwork <- renderBipartiteNetwork({\n    edgeList <- req(filteredEdgeList())\n\n    if (is.null(edgeList) || nrow(edgeList) == 0 || is.null(data2$matrix)) {\n      return(NULL)\n    }\n    \n    network <- bipartiteNetwork(edgeList)\n    return(network)\n  })\n\n}\n","type":"text"},{"name":"ui.R","content":"#' @importFrom shinyjs useShinyjs\n#' @import shiny\n#' @importFrom bslib bs_theme\n#' @importFrom DT DTOutput\n#' @importFrom shinyWidgets switchInput\n#' @include unipartiteNetwork.R\nui <- shiny::fluidPage(\n  theme = bslib::bs_theme(),\n  shiny::tags$head(\n    shiny::tags$style(\n      shiny::HTML(\".shiny-notification { position:fixed; top: calc(20%); left: calc(50%); }\"),\n      shiny::HTML(\"hr { margin-top: 10px; margin-bottom: 10px }\")\n    )\n  ),\n  shinyjs::useShinyjs(),\n  shiny::titlePanel(\"Correlation Matrix as Network Visualization\"),\n\n  shiny::fluidRow(\n    shiny::column(3, \n           shiny::wellPanel(\n             uiOutput('file1'),\n             uiOutput('file2'),\n             shiny::actionButton(\"resetData\", shiny::strong(\"Reset Data\")),\n             shiny::hr(),\n              selectInput(\"correlationMethod\", shiny::strong(\"Correlation Method:\"),\n                c(\"Spearman\" = \"spearman\",\n                  \"Pearson\" = \"pearson\")),\n             shiny::p(),\n             shiny::numericInput(\"correlationFilter\", shiny::strong(\"Correlation Coefficient Threshold:\"), 0, min = -1, max = 1),\n             shiny::plotOutput(\"correlationHistogram\", height = \"200px\"),\n             shiny::p(),\n             shiny::numericInput(\"pValueFilter\", shiny::strong(\"P-Value Threshold:\"), 0.05, min = 0, max = 1),\n             shiny::plotOutput(\"pValueHistogram\", height = \"200px\")\n           )\n    ),\n    shiny::column(9,\n           tabsetPanel(\n             type = \"tabs\",\n             tabPanel(\"Network\",\n               uiOutput(\"correlationNetwork\")\n             ),\n             tabPanel(\"Table\",\n               DT::DTOutput(\"correlationMatrix\") \n             )\n           )\n    )\n  )\n)\n","type":"text"},{"name":"bipartiteNetworkWidget.R","content":"#' bipartiteNetwork\n#' \n#' Create a bipartiteNetwork widget\n#' \n#' @param data a data frame with source, target, and value columns\n#' @param width the width of the widget\n#' @param height the height of the widget\n#' @param elementId the ID of the widget\n#' @import htmlwidgets\n#' @importFrom r2d3 html_dependencies_d3\n#' @import dplyr\n#' @export\nbipartiteNetwork <- function(data, width = NULL, height = NULL, elementId = NULL) {\n  if (!inherits(data, \"data.frame\") || !all(c(\"source\", \"target\", \"value\") %in% names(data))) {\n    stop(\"Data must be a data frame with source, target, and value columns.\")\n  }\n  \n  unique_sources <- unique(data$source)\n  unique_targets <- unique(data$target)\n  edge_data <- data %>% \n    filter(source %in% unique_sources & target %in% unique_targets) %>%\n    distinct(source, target, .keep_all = TRUE)\n\n  params <- list(data = list(links = edge_data, column1NodeIds = unique_sources, column2NodeIds = unique_targets))\n  attr(params, 'TOJSON_ARGS') <- list(dataframe = 'rows')\n  \n  network <- htmlwidgets::createWidget(\n    name = 'bipartitenetwork',\n    x = params,\n    width = width,\n    height = height,\n    package = 'corGraph',\n    elementId = elementId,\n    dependencies = r2d3::html_dependencies_d3(version = \"5\")\n  )\n\n  return(network)\n}\n\n#' Shiny bindings for bipartiteNetwork\n#' \n#' Output function for using bipartiteNetwork within Shiny apps\n#' \n#' @param outputId output variable to read from\n#' @param width,height Must be a valid CSS unit (like \\code{'100\\%'}, '400px', or 'auto')\n#' @export\nbipartiteNetworkOutput <- function(outputId, width = '100%', height = '400px'){\n  htmlwidgets::shinyWidgetOutput(outputId, 'bipartitenetwork', width, height, package = 'corGraph')\n}\n\n#' Shiny bindings for bipartiteNetwork\n#' \n#' Render function for using bipartiteNetwork within Shiny apps\n#' \n#' @param expr an expression that generates bipartiteNetwork\n#' @param env the environment in which to evaluate \\code{expr}\n#' @param quoted Is \\code{expr} a quoted expression (with \\code{quote()})? This\n#'   is useful if you want to save an expression in a variable\n#' @export\nrenderBipartiteNetwork <- function(expr, env = parent.frame(), quoted = FALSE) {\n  if (!quoted) { expr <- substitute(expr) } \n  htmlwidgets::shinyRenderWidget(expr, bipartiteNetworkOutput, env, quoted = TRUE)\n}\n","type":"text"},{"name":"unipartiteNetwork.R","content":"#' unipartiteNetwork\n#' \n#' Create a unipartiteNetwork widget\n#' \n#' @param data a data frame with source, target, and value columns\n#' @param width the width of the widget\n#' @param height the height of the widget\n#' @param elementId the ID of the widget\n#' @import htmlwidgets\n#' @importFrom r2d3 html_dependencies_d3\n#' @import dplyr\n#' @export\nunipartiteNetwork <- function(data, width = NULL, height = NULL, elementId = NULL) {\n  if (!inherits(data, \"data.frame\") || !all(c(\"source\", \"target\", \"value\") %in% names(data))) {\n    stop(\"Data must be a data frame with source, target, and value columns.\")\n  }\n  \n  unique_sources <- unique(data$source)\n  unique_targets <- unique(data$target)\n  edge_data <- data %>% \n    filter(source %in% unique_sources & target %in% unique_targets) %>%\n    distinct(source, target, .keep_all = TRUE)\n\n  params <- list(data = list(links = edge_data, nodes = data.frame(id = unique(c(unique_sources, unique_targets)))))\n  attr(params, 'TOJSON_ARGS') <- list(dataframe = 'rows')\n  \n  network <- htmlwidgets::createWidget(\n    name = 'unipartitenetwork',\n    x = params,\n    width = width,\n    height = height,\n    package = 'corGraph',\n    elementId = elementId,\n    dependencies = r2d3::html_dependencies_d3(version = \"5\")\n  )\n\n  return(network)\n}\n\n#' Shiny bindings for unipartiteNetwork\n#' \n#' Output function for using unipartiteNetwork within Shiny apps\n#' \n#' @param outputId output variable to read from\n#' @param width,height Must be a valid CSS unit (like \\code{'100\\%'}, '400px', or 'auto')\n#' @export\nunipartiteNetworkOutput <- function(outputId, width = '100%', height = '400px'){\n  htmlwidgets::shinyWidgetOutput(outputId, 'unipartitenetwork', width, height, package = 'corGraph')\n}\n\n#' Shiny bindings for unipartiteNetwork\n#' \n#' Render function for using unipartiteNetwork within Shiny apps\n#' \n#' @param expr an expression that generates unipartiteNetwork\n#' @param env the environment in which to evaluate \\code{expr}\n#' @param quoted Is \\code{expr} a quoted expression (with \\code{quote()})? This\n#'   is useful if you want to save an expression in a variable\n#' @export\nrenderUnipartiteNetwork <- function(expr, env = parent.frame(), quoted = FALSE) {\n  if (!quoted) { expr <- substitute(expr) } \n  htmlwidgets::shinyRenderWidget(expr, unipartiteNetworkOutput, env, quoted = TRUE)\n}\n","type":"text"}]

docs/edit/index.html

@@ -0,0 +1,34 @@
+<!DOCTYPE html>
+<html lang="en">
+  <head>
+    <meta charset="UTF-8" />
+    <meta name="viewport" content="width=device-width, initial-scale=1.0" />
+    <title>Shiny examples browser</title>
+    <script
+      src="../shinylive/load-shinylive-sw.js"
+      type="module"
+    ></script>
+    <script src="../shinylive/jquery.min.js"></script>
+    <script src="../shinylive/jquery.terminal/js/jquery.terminal.min.js"></script>
+    <link
+      href="../shinylive/jquery.terminal/css/jquery.terminal.min.css"
+      rel="stylesheet"
+    />
+    <script type="module">
+      import { runApp } from "../shinylive/shinylive.js";
+      const response = await fetch("../app.json");
+      if (!response.ok) {
+        throw new Error("HTTP error loading app.json: " + response.status);
+      }
+      const appFiles = await response.json();
+
+      const appRoot = document.getElementById("root");
+      runApp(appRoot, "editor-terminal-viewer", {startFiles: appFiles}, "r");
+    </script>
+    <link rel="stylesheet" href="../shinylive/style-resets.css" />
+    <link rel="stylesheet" href="../shinylive/shinylive.css" />
+  </head>
+  <body>
+    <div style="height: 100vh; width: 100vw" id="root"></div>
+  </body>
+</html>

docs/index.html

@@ -0,0 +1,28 @@
+<!DOCTYPE html>
+<html lang="en">
+  <head>
+    <meta charset="UTF-8" />
+    <meta name="viewport" content="width=device-width, initial-scale=1.0" />
+    <title>Shiny App</title>
+    <script
+      src="./shinylive/load-shinylive-sw.js"
+      type="module"
+    ></script>
+    <script type="module">
+      import { runApp } from "./shinylive/shinylive.js";
+      const response = await fetch("./app.json");
+      if (!response.ok) {
+        throw new Error("HTTP error loading app.json: " + response.status);
+      }
+      const appFiles = await response.json();
+
+      const appRoot = document.getElementById("root");
+      runApp(appRoot, "viewer", {startFiles: appFiles}, "r");
+    </script>
+    <link rel="stylesheet" href="./shinylive/style-resets.css" />
+    <link rel="stylesheet" href="./shinylive/shinylive.css" />
+  </head>
+  <body>
+    <div style="height: 100vh; width: 100vw" id="root"></div>
+  </body>
+</html>