inst/app/server.R

In avucoh/nPOD: What the Package Does (One Line, Title Case)

shinyServer(function(input, output, session) {

  # output$t_last <- renderUI({
  #   DIVE::valueBox(value = "--/--", subtitle = "most recent dataset", icon = icon("copy"), width = infobox_width, textcolor = "white", bgcolor = "MediumVioletRed")
  # })

  output$metrics <- renderUI({
    # calc    numbers
    n_curated <- length(unique(metadata$Source))
    n_openacess <- sum(visNetD$nodes$color != "#333333")
    n_datapoints <- paste0(trunc((sum(sapply(list(px1_t, px2_t, xm_t), function(x) prod(dim(x)))) + table(!is.na(cdata))["TRUE"])/1000), "K")
    n_measures <- sum(metadata$Dimensions == 1, na.rm = T)
    n_shared <- round(mean((visNetD$edges$weight)^2), 1)

    div(style = "display: inline-block;",
        shiny::span(icon("book-open", class = "icon-red"), n_curated, "curated sources", class = "stats-badge"),
        shiny::span(icon("lock-open", class = "icon-red"), n_openacess, "open data sources", class = "stats-badge"),
        shiny::span(icon("table", class = "icon-red"), n_datapoints, "data points", class = "stats-badge"), br(),
        shiny::span(icon("microscope", class = "icon-red"), n_measures, "low-throughput features", class = "stats-badge"),
        shiny::span(icon("share-alt", class = "icon-red"), n_shared, "mean shared cases", class = "stats-badge")
    )
  })

  # output$t_last <- renderUI({
  #   DIVE::valueBox(value = "--/--", subtitle = "most recent dataset", icon = icon("copy"), width = infobox_width, textcolor = "white", bgcolor = "MediumVioletRed")
  # })

  # -- bookmarks -----------------------------------------------------------------------------------------------------------------------#

  setBookmarkExclude(c("bookmark1", "bookmark2", "bookmark3"))

  observeEvent(input$bookmark1, {
    session$doBookmark()
  })

  observeEvent(input$bookmark2, {
    session$doBookmark()
  })

  observeEvent(input$bookmark3, {
    session$doBookmark()
  })


  # -- landing page ---------------------------------------------------------------------------------------------------------------------#
  callModule(DIVE::cellPack, "landing", json = cellpackjson)
    callModule(HPCGraph, "landing", nPOD::hpcg, colors = shared_config()$colors, txtcolor = "white", linecolor = "ghostwhite")

  output$studynetwork <- visNetwork::renderVisNetwork({
    studynetwork <- visNetwork::visNetwork(visNetD$nodes, visNetD$edges)
    studynetwork %>%
      visNetwork::visIgraphLayout(randomSeed = 98) %>%
      visNetwork::visInteraction(hover = T) %>%
      # visNetwork::visNodes(font = list(size = 20, face = "Helvetica", background = "white")) %>%
      visNetwork::visNodes(label = NULL) %>%
      #v visNetwork::visEdges(color = list(highlight = "#ff0000", hover = "#ff0000", inherit = F)) %>%
      visNetwork::visOptions(highlightNearest = list(enabled = TRUE, hover = T, degree = 1))
  })

  observeEvent(input$connections, {
    updateTabsetPanel(session, "main", selected = "matrix")
    updateQueryString(paste0("?Contributor=", input$connections), mode = "push")
  }, ignoreInit = T, ignoreNULL = T)

  # -- main modules ---------------------------------------------------------------------------------------------------------------------#
  callModule(DIVE::matrixMix, "nPOD-matrix",
             M = matrixMix_config()$M,
             N = matrixMix_config()$N,
             cdata = matrixMix_config()$cdata,
             metadata = matrixMix_config()$metadata,
             vkey = matrixMix_config()$vkey,
             factorx = matrixMix_config()$factorx,
             dcolors = matrixMix_config()$dcolors)

  callModule(DIVE::matchApp, "nPOD-match",
             subsets = matchApp_config()$subsets,
             refdata = matchApp_config()$refdata,
             datakey = matchApp_config()$datakey,
             xname = matchApp_config()$xname,
             refname = matchApp_config()$refname,
             HPCG = matchApp_config()$HPCG,
             colors = matchApp_config()$colors,
             vars = matchApp_config()$vars,
             subsetfeat = matchApp_config()$subsetfeat,
             factorx = matchApp_config()$factorx,
             appdata = matchApp_config()$appdata)

  callModule(DIVE::multiV, "nPOD-hd",
             hdata = multiV_config()$hdata,
             hcat = multiV_config()$hcat,
             cdata = multiV_config()$cdata,
             preselect = multiV_config()$preselect)

  callModule(DIVE::browse, "nPOD-browse",
             dt_id = browse_config()$dt_id,
             index1 = browse_config()$index1,
             index2 = browse_config()$index2,
             dt_var = browse_config()$dt_var,
             dt_var_index = browse_config()$dt_var_index,
             dt_var_ext = browse_config()$dt_var_ext)

  # -- demos- ---------------------------------------------------------------------------------------------------------------------#
  observeEvent(input$demoMatrix, {
    session$sendCustomMessage(type = "demoMatrix",
                              message = list(steps = jsonlite::toJSON(
                                fread("www/demo/data_exploration.txt", sep = "\t", header = T))))
  })

  observeEvent(input$demoCohortExchange, {
    session$sendCustomMessage(type = "demoCohortExchange",
                              message = list(steps = jsonlite::toJSON(
                                fread("www/demo/cohort_exchange.txt", sep = "\t", header = T))))
  })

})