inst/shinyapp/server.R

In rnabioco/clustifyr: Classifier for Single-cell RNA-seq Using Cell Clusters

# Define server logic to read selected file ----
server <- function(input, output, session) {
  # parse url to direct tab
  observe({
    query <- parseQueryString(session$clientData$url_search)
  
    if (!is.null(query[['tab']])) {
      updateTabItems(session, "tabs", query[['tab']])
    }
  })
  
  # reactive file location to make interactivity easier
  rv <- reactiveValues()
  rv$matrixloc <- NULL
  rv$metaloc <- NULL
  rv$step <- 0
  rv$clustifym <- "clustifyr not yet run"
  rv$lastgeo <- "GSE151974" #GSE113049"
  rv$ref <- NULL
  rv$ref_visited <- 0
  rv$ref_link <- NULL
  rv$res_visited <- 0
  rv$obj <- NULL
  rv$links2 <- data.frame()

  # hide some elements
  hide("header")
  hide("sepMat")
  hide("sepMeta")
  hide("dispMat")
  hide("dispMeta")
  hide("matrixPopup")
  hide("metadataPopup")

  # waiter checkpoints
  w1 <- Waiter$new(
    id = "contents1",
    html = tagList(
      spin_flower(),
      h4("Matrix loading..."),
      h4("")
    )
  )
  
  w2 <- Waiter$new(
    id = "contents2",
    html = tagList(
      spin_flower(),
      h4("Metadata loading..."),
      h4("")
    )
  )
  
  w3 <- Waiter$new(
    id = "reference",
    html = tagList(
      spin_flower(),
      h4("Reference building..."),
      h4("")
    )
  )
  
  w4 <- Waiter$new(
    id = "clustify",
    html = tagList(
      spin_flower(),
      h4("Clustifyr running..."),
      h4("")
    )
  )
  
  w5 <- Waiter$new(
    id = "hmap",
    html = tagList(
      spin_flower(),
      h4("Heatmap drawing..."),
      h4("")
    )
  )

  w6 <- Waiter$new(id = "modalgeo",
                   html = tagList(
                     spin_flower(),
                     h4("Info fetching..."),
                     h4("")
                   ))

  w7 <- Waiter$new(id = "modalfiles",
                   html = tagList(
                     spin_flower(),
                     h4("File previewing..."),
                     h4("")
                   ))

  w8 <- Waiter$new(
    id = "contents3",
    html = tagList(
      spin_flower(),
      h4("Reference loading..."),
      h4("")
    )
  )
  
  w9 <- Waiter$new(
    id = "someta",
    html = tagList(
      spin_flower(),
      h4("Preview loading..."),
      h4("")
    )
  )

  data1 <- reactive({
    
    # input$file1 will be NULL initially. After the user selects
    # and uploads a file, head of that data file by default,
    # or all rows if selected, will be shown.

    if (!is.null(input$file1) | !is.null(rv$matrixloc)) {
      if (!is.null(input$file1)) {
        rv$matrixloc <- input$file1
      }
      file <- rv$matrixloc

      if (!is.null(file)) {
        w1$show()
        message(file)
      }
      
      fileTypeFile1 <- tools::file_ext(file$datapath)
      req(file)
      if (str_to_lower(fileTypeFile1) == "rds") {
        df1 <- readRDS(file$datapath) 
        if (any(class(df1) %in% c("SingleCellExperiment", "Seurat"))) {
          rv$obj <- df1
          df1 <- object_data(rv$obj, "data")
        }
      } else if (str_to_lower(fileTypeFile1) == "rdata" | str_to_lower(fileTypeFile1) == "rda") {
        df1 <- load_rdata(file$datapath)
        if (any(class(df1) %in% c("SingleCellExperiment", "Seurat"))) {
          rv$obj <- df1
          df1 <- object_data(df1, "data")
        }
      } else {
        df1 <- fread(file$datapath)
      }
    } else if (!is.null(rv$obj)) {
      df1 <- object_data(rv$obj, "data")
    } else {
      return(NULL)
    }
    
    if ((!is_local) & (object.size(df1) > 3e9)) {
      message("Potential memory issue due to file size")
      showModal(modalDialog(
        h2("File size over 3Gb, online version may be unstable"),
        easyClose = TRUE,
        fade = FALSE,
        footer = NULL
      ))
    }
    
    df1 <- df1 %>% as.data.frame()
    if (!has_rownames(df1) & length(unique(df1[, 1])) == nrow(df1)) {
      rownames(df1) <- df1[, 1]
      df1[, 1] <- NULL
    }
    
    w1$hide()
    df1
  })
  
  data2 <- reactive({
    if (!is.null(input$file2) | !is.null(rv$metaloc)) {
      if (!is.null(input$file2)) {
        rv$metaloc <- input$file2
      }
      file <- rv$metaloc
      
      if (!is.null(file)) {
        w2$show()
        message(file)
      }
      
      fileTypeFile2 <- tools::file_ext(file$datapath)
      req(file)
      if (str_to_lower(fileTypeFile2) == "rds") {
        df2 <- readRDS(file$datapath)
        if (any(class(df2) %in% c("SingleCellExperiment", "Seurat"))) {
          rv$obj <- df2
          df2 <- object_data(df2, "meta.data")
        }
      } else if (str_to_lower(fileTypeFile2) == "rdata" | str_to_lower(fileTypeFile2) == "rda") {
        df2 <- load_rdata(file$datapath)
        if (any(class(df2) %in% c("SingleCellExperiment", "Seurat"))) {
          rv$obj <- df2
          df2 <- object_data(rv$obj, "meta.data")
        }
      } else {
        df2 <- fread(file$datapath)
      }
    } else if (!is.null(rv$obj)) {
      df2 <- object_data(rv$obj, "meta.data")
    } else {
      return(NULL)
    }

    if ((!is_local) & (object.size(df2) > 3e9)) {
      message("Potential memory issue due to file size")
      showModal(modalDialog(
        h2("File size over 3Gb, online version may be unstable"),
        easyClose = TRUE,
        fade = FALSE,
        footer = NULL
      ))
    }
    
    df2 <- df2 %>% as.data.frame()
    if (!has_rownames(df2) & length(unique(df2[, 1])) == nrow(df2)) {
      rownames(df2) <- df2[, 1]
      df2[, 1] <- NULL
    }

    w2$hide()
    df2
  })
  
  data3a <- reactive({
    if (!is.null(input$file3)) {
      rv$ref <- input$file3
    }
    if (rv$ref == "built-in") {
      return(NULL)
    }
    file <- rv$ref

    if (!is.null(file)) {
      w8$show()
      message(file)
    }

    fileTypeFile3 <- tools::file_ext(file$datapath)
    req(file)

    if (str_to_lower(fileTypeFile3) == "rds") {
      df3 <- readRDS(file$datapath) %>% as.data.frame()
    } else if (str_to_lower(fileTypeFile3) == "rdata" | str_to_lower(fileTypeFile3) == "rda") {
      df3 <- load_rdata(file$datapath) %>% as.data.frame()
    } else {
      df3 <- fread(file$datapath) %>% # , header = input$header, sep = input$sepMat) %>%
        as.data.frame()
    }

    if ((!is_local) & (object.size(df3) > 3e9)) {
      message("Potential memory issue due to file size")
      showModal(modalDialog(
        h2("File size over 3Gb, online version may be unstable"),
        easyClose = TRUE,
        fade = FALSE,
        footer = NULL
      ))
    }
    
    if (!has_rownames(df3) & length(unique(df3[, 1])) == nrow(df3)) {
      rownames(df3) <- df3[, 1]
      df3[, 1] <- NULL
    }

    w8$hide()
    df3
  })

  output$contents1 <- DT::renderDataTable({
    if (is.null(rv$matrixloc) & is.null(rv$obj)) {
      return(df1 <- data.frame(`nodata` = rep("", 6)))
    } else {
      df1 <- data1()
    }

    # file 1
    if (input$dispMat == "head") {
      cols <- ncol(df1)
      df1 <- df1[, 1:min(cols, 5)]
      return(head(df1))
    }
    else {
      return(df1)
    }
  })
  
  output$contents2 <- DT::renderDataTable({
    if (is.null(rv$metaloc) & is.null(rv$obj)) {
      return(df2 <- data.frame(`nodata` = rep("", 6)))
    } else {
      df2 <- data2()
    }
    
    updateSelectInput(session, "metadataCellType",
                      choices = c("", colnames(df2)),
                      selected = ""
    )

    # file 2
    if (input$dispMeta == "head") {
      return(head(df2))
    }
    else {
      return(df2)
    }

  },
  callback = DT::JS(js),
  selection = list(target = 'column', mode = "single"))

  output$colclicked <- renderUI({
    if (is.null(input[["column_clicked"]])) {
      "please select cluster column in drop-down menu, or click in the table"
    } else {
      input$metadataCellType
    }
  })

  observeEvent(input[["column_clicked"]], {
    updateSelectInput(session, "metadataCellType", 
                      selected = input[["column_clicked"]]                   
    )
  })

  output$ref_summary <- renderUI({
    HTML(paste0("<b>", "cell types: ", ncol(data3()),
                "<br>",
                "genes: ", nrow(data3()),
                "<b>"))
  })

  data3b <- reactive({
    w8$show()
    rv$ref <- "built-in"
    ref <- refs[[ref_dict[input$dataHubReference]]]
    rv$ref_link <- refs_meta[ref_dict[input$dataHubReference], ] %>% pull(sourceurl)
    w8$show()

    ref
  })

  data3 <- reactive({
    b <- data3b()
    a <- data3a()
    if (is.null(rv$ref)) {
      return(data.frame(`nodata` = rep("", 6)))
    } else if (rv$ref == "built-in") {
      df3 <- b
    } else {
      df3 <- a
    }
    df3
  })

  output$contents3 <- DT::renderDataTable({
    df3 <- data3()

    # file 3
    if (input$dispMat == "head") {
      return(head(df3))
    }
    else {
      return(df3)
    }
  })
  
  observeEvent(input$matrixPopup, {
    showModal(modalDialog(
      tags$caption("Matrix table"),
      DT::renderDataTable({
        matrixRender <- head(data1())
        DT::datatable(matrixRender)
      }),
      easyClose = TRUE
    ))
  })
  
  observeEvent(input$metadataPopup, {
    showModal(modalDialog(
      tags$caption("Metadata table"),
      DT::renderDataTable({
        matrixRender <- head(data2())
        DT::datatable(matrixRender)
      }),
      easyClose = TRUE
    ))
  })

  data_avg <- reactive({
    if (input$metadataCellType == "") {
      return(NULL)
    }
    w3$show()
    reference_matrix <- average_clusters(mat = data1(), metadata = data2()[[input$metadataCellType]], if_log = FALSE)
    w3$hide()
    reference_matrix
  })
  
  dataClustify <- reactive({
    if (input$metadataCellType == "") {
      return(NULL)
    }
    w4$show()
    benchmarkRef <- data3()
    
    if (!is.null(rv$obj)) {
      message("Single cell object detected")
      matrixSeuratObject <- rv$obj
      if (any(class(matrixSeuratObject) == "SingleCellExperiment")) {
        matrixSeuratObject <- as.Seurat(matrixSeuratObject)
      }
    } else {
      UMIMatrix <- data1()
      matrixSeuratObject <- CreateSeuratObject(counts = UMIMatrix, project = "Seurat object matrix", min.cells = 0, min.features = 0)
    }
    if (VariableFeatures(matrixSeuratObject) %>% length() == 0) {
      matrixSeuratObject <- FindVariableFeatures(matrixSeuratObject, selection.method = "vst", nfeatures = 2000)
    } else {
      message("Using variable genes in object")
    }

    metadataCol <- data2()[[input$metadataCellType]]
    # use for classification of cell types
    messages <<- capture.output(
      res <- clustify(
        input = object_data(matrixSeuratObject, "data"),
        metadata = metadataCol,
        ref_mat = benchmarkRef,
        query_genes = VariableFeatures(matrixSeuratObject),
        verbose = TRUE
      ),
      type = "message"
    )
    rv$clustifym <<- messages
    
    w4$hide()
    res
  })

  output$reference <- DT::renderDataTable({
    if (rv$res_visited == 1) {
      return(df1 <- data.frame(`nodata` = rep("", 6)))
    }
    reference_matrix <- data_avg()
    rownames_to_column(as.data.frame(reference_matrix), input$metadataCellType)
  })
  
  output$clustify <- DT::renderDataTable({
    if (rv$res_visited == 1) {
      return(df1 <- data.frame(`nodata` = rep("", 6)))
    }
    res <- dataClustify()
    rownames_to_column(as.data.frame(res), input$metadataCellType)
  })
  
  corToCall <- reactive({
    res <- dataClustify()
    cor_to_call(cor_mat = res, cluster_col = input$metadataCellType)
  })
  
  output$corToCall <- DT::renderDataTable({
    corToCall()
  })
  
  # Make plots such as heat maps to compare benchmarking with clustify with actual cell types
  
  output$hmap <- renderPlot({
    if (input$metadataCellType == "") {
      return(NULL)
    }
    tmp_mat <- dataClustify()
    # could expose as an option
    cutoff_to_display <- 0.5

    if (!is.null(tmp_mat)) {
      w5$show()
    }
    tmp_mat <- tmp_mat[, colSums(tmp_mat > 0.5) > 1]
    plot_hmap(tmp_mat)
  })
  
  referenceDownload <- reactive({
    avgMatrix <- data_avg()
  })
  
  clustifyDownload <- reactive({
    clustifyMatrix <- dataClustify()
  })
  
  output$downloadReference <- downloadHandler(
    filename = function() {
      paste("reference-", Sys.Date(), ".csv", sep = "")
    },
    content = function(file) {
      write.csv(referenceDownload(), file, quote = FALSE)
    }
  )
  output$downloadClustify <- downloadHandler(
    filename = function() {
      paste("clustify-", Sys.Date(), ".xlsx", sep = "")
    },
    content = function(file) {
      write.xlsx(list(corToCall(), clustifyDownload()), file, quote = FALSE, rowNames = TRUE)
    }
  )
  
  # load example data
  observeEvent(
    input$example,
    {
      message("loading prepackaged data")
      rv$matrixloc <- list(datapath = "data/example-input/matrix.csv.gz")
      rv$metaloc <- list(datapath = "data/example-input/meta-data.csv.gz")
      updateTabItems(session, "tabs", "metadataLoad")
    }
  )

  output$clustifym <- renderUI(
    HTML(paste0(c(rv$clustifym, ""), collapse = "<br/><br/>"))
  )

  # modal for GEO id
  observeEvent(
    input$geo1 | input$geo2,
    showModal(modalDialog(
      div(id = "modalgeo",
          textInput("geoid", "query GEO id", value = rv$lastgeo),
          actionButton("geogo", "Fetch file info", icon = icon("eye"))
      ),
      easyClose = TRUE,
      fade = FALSE,
      footer = NULL
    )),
    ignoreInit = TRUE
  )

  observeEvent(
    input$geogo,
    {
      w6$show()
      rv$lastgeo <- input$geoid
      rv$links <- list_geo(rv$lastgeo)
      message(rv$links)
      if (rv$links != "error_get") {
        rv$links2 <- rv$links %>% mutate(size = map(link, get_file_size)) %>% select(-link)
        links2 <- cbind(rv$links2,
                        button = sapply(1:nrow(rv$links), make_button("tbl1")),
                        stringsAsFactors = FALSE) %>%
          data.table::data.table()
        links2 <- links2 %>%
          DT::datatable(options = list(
            dom = "ftp",
            searchHighlight = TRUE,
            paging = TRUE,
            pageLength = 5,
            scrollY = FALSE),
            escape = ncol(links2) - 1, fillContainer = TRUE)
        
      } else {
        links2 <- data.frame(rv$links)
      }
      
      url <- str_c("https://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?acc=", input$geoid)
      w6$hide()
      showModal(modalDialog(
        size = "l",
        div(id = "modalfiles",
            DT::renderDataTable(links2)
        ),
        easyClose = TRUE,
        fade = FALSE,
        footer = tagList(
          actionButton("geopage", label = "Go to GEO page",
                       onclick = paste0('window.open("',
                                        url,
                                        '", "_blank")'),
                       icon = icon("link")),
          actionButton("email", label = "Email author for missing data",
                       onclick = paste0('location.href="',
                                        prep_email(rv$lastgeo),
                                        '"'),
                       icon = icon("envelope-open-text")),
          actionButton("sheet", label = "Spot check for someta", 
                       icon = icon("feather-alt"))
        )
      ))
    }
  )

  observeEvent(input[["button"]], {
    w7$show()
    splitID <- strsplit(input[["button"]], "_")[[1]]
    tbl <- splitID[2]
    row <- splitID[3]
    rv$loadinglink <<- rv$links$link[as.numeric(row)]

    # if tar, read a file list
    if (str_detect(rv$links$link[as.numeric(row)], "/GSE[0-9]+_RAW.tar")) {
      fullb <- FALSE
      previewdata <- preview_link(get_tar(rv$links$link[as.numeric(row)]))
    } else {
      fullb <- TRUE
      previewdata <- preview_link(rv$links$link[as.numeric(row)])
    }

    if (is.null(previewdata)) {
      fullb <- FALSE
      previewdata <- data.frame(unreadable = rep("", 4))
    } else {
      cols <- ncol(previewdata)
      previewdata <- previewdata[, 1:min(cols, 100)]
    }

    if (input[["activeTab"]] == "someta") {
      fullb <- FALSE
    }
    
    w7$hide()
    showModal(modalDialog(
      size = "l",
      div(id = "modalback",
          title = "preview",
          DT::renderDataTable(previewdata),
          if (fullb) {
            actionButton("full", "Start full loading", icon = icon("running"))
          } else {
            disabled(actionButton("full", "Start full loading", icon = icon("running")))
          },
          actionButton("back", "Back to file list", icon = icon("step-backward"))
      ),
      easyClose = TRUE,
      fade = FALSE,
      footer = NULL
    ))
  })

  observeEvent(input$full, {
    message(rv$loadinglink)
    if (input[["activeTab"]] == "matrixLoad") {
      rv$matrixloc <- list(datapath = rv$loadinglink)
    } else if (input[["activeTab"]] == "metadataLoad") {
      rv$metaloc <- list(datapath = rv$loadinglink)
    }
    removeModal()
  })
  
  observeEvent(input$sheet, {
    showModal(modalDialog(
      size = "l",
      div(id = "modalsheet",
          title = "Please fill out",
          renderUI(h2(rv$lastgeo)),
          hr(),
          strong(materialSwitch(
            "issc",
            "   is single cell data",
            value = TRUE,
            status = "success",
            right = TRUE,
            inline = FALSE,
            width = NULL
          )),
          strong(materialSwitch(
            "hasmeta",
            "   has metadata",
            value = TRUE,
            status = "success",
            right = TRUE,
            inline = FALSE,
            width = NULL
          )),
          strong(materialSwitch(
            "hascellcol",
            "   has cell type column in metadata",
            value = TRUE,
            status = "success",
            right = TRUE,
            inline = FALSE,
            width = NULL
          )),
          textInput("comment", "", placeholder = "Additional comments")
      ),
      easyClose = TRUE,
      fade = FALSE,
      footer = actionButton("submit", "Submit", icon = icon("feather-alt"))
    ))
  })
  observeEvent(input$back, {
    links2 <- cbind(rv$links2,
                    button = sapply(1:nrow(rv$links), make_button("tbl1")),
                    stringsAsFactors = FALSE) %>%
      data.table::data.table()
    links2 <- links2 %>%
      DT::datatable(options = list(
        dom = "ftp",
        searchHighlight = TRUE,
        paging = TRUE,
        pageLength = 5,
        scrollY = FALSE),
        escape = ncol(links2)-1, fillContainer = TRUE)
    url <- str_c("https://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?acc=", input$geoid)
    showModal(modalDialog(
      size = "l",
      div(id = "modalfiles",
          DT::renderDataTable(links2)
      ),
      easyClose = TRUE,
      fade = FALSE,
      footer = tagList(
        actionButton("geopage", label = "Go to GEO page",
                     onclick = paste0('window.open("',
                                      url,
                                      '", "_blank")'),
                     icon = icon("link")),
        actionButton("email", label = "Email author for missing data",
                     onclick = paste0('location.href="',
                                      prep_email(rv$lastgeo),
                                      '"'),
                     icon = icon("envelope-open-text")),
        actionButton("sheet", label = "Spot check for someta", 
                     icon = icon("feather-alt"))
      )
    ))
  })
  
  # upload to google sheet
  observeEvent(input$submit, {
    sheet_append(sheetid, data.frame(id = rv$lastgeo,
                                     issc = input$issc,
                                     hasmeta = input$hasmeta,
                                     hascellcol = input$hascellcol,
                                     comment = input$comment))
    # print(read_sheet(sheetid, 1))
    
    showModal(modalDialog(
      div(id = "modaldone",
          h2("Results uploaded, thank you!")
      ),
      easyClose = TRUE,
      fade = FALSE,
      footer = NULL
    ))
  })

  # disable menu at load
  addCssClass(selector = "a[data-value='clustifyres']", class = "inactiveLink")
  addCssClass(selector = "ul li:eq(4)", class = "inactiveLink")
  
  addCssClass(selector = "a[data-value='blank']", class = "inactiveLink")
  addCssClass(selector = "ul li:eq(5)", class = "inactiveLink")

  # check if data is loaded
  observeEvent((!is.null(data1())) + (!is.null(data2())) + (!is.null(data3())) +
                 (!is.null(input$metadataCellType)) +
                 (input$metadataCellType != ""), {
                   if ((!is.null(data1())) + (!is.null(data2())) + (!is.null(data3())) + 
                       (!is.null(input$metadataCellType)) + 
                       (input$metadataCellType != "") == 5) {
                     removeCssClass(selector = "a[data-value='clustifyres']", class = "inactiveLink")
                     removeClass(selector = "ul li:eq(4)", class = "inactiveLink")
                   }
                 })
  observeEvent(data1(), {
    if (!is.null(data1())) {
      addCssClass(selector = "a[data-value='matrixLoad']", class = "doneLink")
      addClass(selector = "ul li:eq(1)", class = "doneLink")
    }
  })

  observeEvent(input$metadataCellType, {
    if (input$metadataCellType != "") {
      addCssClass(selector = "a[data-value='metadataLoad']", class = "doneLink")
      addClass(selector = "ul li:eq(2)", class = "doneLink")
    }
  })

  observeEvent(input[["activeTab"]], {
    if (input[["activeTab"]] == "clusterRef") {
      rv$ref_visited <<- 1
    } else if (input[["activeTab"]] == "clustifyres") {
      if (rv$res_visited == 0)
        rv$res_visited <<- 1
    }
  })

  observeEvent(rv$ref_visited, {
    if (rv$ref_visited == 1 & !is.null(data3())) {
      addCssClass(selector = "a[data-value='clusterRef']", class = "doneLink")
      addClass(selector = "ul li:eq(3)", class = "doneLink")
    }
  })

  observeEvent(rv$res_visited, {
    if (rv$res_visited == 1) {
      rv$res_visited <- 2
    }
  }, ignoreInit = FALSE)

  observeEvent(rv$ref_link, {
    runjs(paste0("document.getElementById('ref_linkgo').onclick = function() {
           window.open('", rv$ref_link, "', '_blank');};"))
  })
  
  output$someta <- DT::renderDataTable({
    as.data.table(someta %>% select(-geo, -pubmed, -pubmed_id), rownames = FALSE)
  }, filter = "top", selection=list(mode="single", target="row"),
  rownames = FALSE, options = list(autoWidth = TRUE,
                                                      columnDefs = list(
    list(width = '200px', targets = c(0:6)), list(
    targets = c(3, 4,5),
    render = JS(
      "function(data, type, row, meta) {",
      "return type === 'display' && data.length > 100 ?",
      "'<span title=\"' + data + '\">' + data.substr(0, 100) + '...</span>' : data;",
      "}")
  ))))
  
  observeEvent(input$someta_cell_clicked, {
    if (length(input$someta_cell_clicked) != 0) {
      sel <- input$someta_cell_clicked
      rv$lastgeo <- someta$id[sel$row]
      w9$show()
      rv$links <- list_geo(rv$lastgeo)
      message(rv$links)
      if (rv$links != "error_get") {
        rv$links2 <- rv$links %>% mutate(size = map(link, get_file_size)) %>% select(-link)
        links2 <- cbind(rv$links2,
                        button = sapply(1:nrow(rv$links), make_button("tbl1")),
                        stringsAsFactors = FALSE) %>%
          data.table::data.table()
        links2 <- links2 %>%
          DT::datatable(options = list(
            dom = "ftp",
            searchHighlight = TRUE,
            paging = TRUE,
            pageLength = 5,
            scrollY = FALSE),
            escape = ncol(links2) - 1, fillContainer = TRUE)
        
      } else {
        links2 <- data.frame(rv$links)
      }
      
      url <- str_c("https://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?acc=", rv$lastgeo)
      w9$hide()
      showModal(modalDialog(
        size = "l",
        div(id = "modalfiles",
            DT::renderDataTable(links2)
        ),
        easyClose = TRUE,
        fade = FALSE,
        footer = tagList(
          actionButton("geopage", label = "Go to GEO page",
                       onclick = paste0('window.open("',
                                        url,
                                        '", "_blank")'),
                       icon = icon("link")),
          actionButton("email", label = "Email author for missing data",
                       onclick = paste0('location.href="',
                                        prep_email(rv$lastgeo),
                                        '"'),
                       icon = icon("envelope-open-text")),
          actionButton("sheet", label = "Spot check for someta", 
                       icon = icon("feather-alt"))
        )
      ))
    }
  })
}