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
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.