inst/shinyapp/server/subsample.R

output$hs_select_for_subsample <- renderUI({
  hs_all <- names(hs$val)
  selected <- NULL
  if ("raw" %in% hs_all) {
    selected <- "raw"
  }
  selectInput("hs_selector_for_subsample", "Choose target",
              choices = hs_all, selected = selected)
})

# sabsample scrs on click of button
observeEvent(input$subsample, {
  withBusyIndicatorServer("subsample", {
    if (isolate(input$hs_selector_for_subsample) == "") {
      shinyalert("Oops!",
                 "Please first load your spectra data.", type = "error")
      return()
    } else {
      hs_cur <- hs$val[[isolate(input$hs_selector_for_subsample)]]
      total <- nrow(hs_cur)
      size <- floor(isolate(input$percentage) / 100.0 * total)
      tindex <- sample(hs_cur, index = TRUE)
      index <- tindex[1:max(size, 2)]
      sampled <- hs_cur[index]
      hs$val[["sampled"]] <- sampled
      toastr_success(paste0("Subsampled ", nrow(sampled), " spectra."),
                     position = "top-center")
    }
  })
})

observeEvent(hs$val[["sampled"]],
  {
    # req(hs$val[["sampled"]])
    sampled <- hs$val[["sampled"]]
    output$sampled_table <- renderDataTable({
      DT::datatable(
        if (is.null(sampled)) NULL else sampled@data %>%
          dplyr::select(!matches("spc")),
        escape = FALSE, selection = "single",
        extensions = list("Responsive", "Scroller"),
        options = list(searchHighlight = TRUE, scrollX = TRUE)
      )
    })
  },
  ignoreNULL = FALSE
)

observeEvent(input$sampled_table_rows_selected,
  {
    output$after_subsample_plot <- renderPlotly({
      validate(need(input$sampled_table_rows_selected, ""))
      index <- input$sampled_table_rows_selected
      item <- hs$val[["sampled"]][index]
      p <- qplotspc(item) +
        xlab(TeX("\\Delta \\tilde{\\nu }/c{{m}^{-1}}")) + ylab("I / a.u.")
      ggplotly(p) %>% config(mathjax = "cdn")
    })
  },
  ignoreNULL = FALSE
)
gongyh/RamanD2O documentation built on Dec. 13, 2024, 8:39 a.m.