Hi,
I am trying to create buttons into a datable (DT package), and I have followed instructions from several posts, but I don't get them to work. They always show part of the code and even they are clickable, I cannot get info on the row clicked and I need this info to append a new tab.
This is my code for my whole app
> library(shinyjs)
> library(shiny)
> library(shinydashboard)
> library(dplyr)
> library(pool)
> library(DT)
>
>
> sidebar <- dashboardSidebar(
> selectInput("search", label = "Search Options:",
> choices = c("General", "Gene", "Mutation", "Reference", "Phenotype"), selected = "Gene"),
> sidebarMenu(id="siderbarmenu", sidebarMenuOutput("menu"))
> )
>
> header <- dashboardHeader()
>
> body <- dashboardBody(
> tags$style(type="text/css",
> ".shiny-output-error { visibility: hidden; }",
> ".shiny-output-error:before { visibility: hidden; }",
> ".shiny-output-error:after { visibility: hidden; }"),
>
>
> #ui
> shinyjs::useShinyjs(),
> tabItems(
> tabItem("search_general", h1("A was done")),
> tabItem(
> tabName = "search_exact_gene",
> tabsetPanel(
> id = "tabs",
> tabPanel(
> title = "Main Dashboard",
> value = "gene1",
> #fluidRow(DT::dataTableOutput('tablafilt') %>% withSpinner(color="#0dc5c1"))),
> fluidRow(
> column(12,dataTableOutput("tablafilt_paste_genes"))
> )
>
> )
>
> )
> ),
> tabItem('mutation', h1("A was done")),
> tabItem('references', h1("A was done")),
> tabItem('phenotype', h1("A was done"))
> )
> )
>
> ui <- dashboardPage(header, sidebar, body)
>
>
> # create pool connection
> # This connection is on my iMac pool
> pool <- dbPool(
> drv = RMySQL::MySQL(),
> dbname = "hgmd_pro",
> host = "localhost",
> username = "user",
> password = "password"
> )
>
>
> # list current datatables in database
> dbListTables(pool)
>
> allgenes <- pool %>% tbl("allgenes")
> allmut <- pool %>% tbl("allmut")
> extra_reff <- pool %>% tbl("extrarefs")
>
> mut_genes <- inner_join(allmut, allgenes, by="gene") %>% collect()
>
> mut_genes <- mut_genes[,-c(grep("\\.y", colnames(mut_genes)))]
> colnames(mut_genes) <- gsub("\\.x", "", colnames(mut_genes))
>
>
> server <- function(input, output, session) {
>
>
> # This function goes on the shiny app
> onStop(function() {
> poolClose(pool)
> })
> output$menu <- renderMenu({
>
> my_general = list(
> menuItem("Búsqueda general", tabName="search_general"),
> conditionalPanel("input.siderbarmenu == 'search_general'",
> textInput(inputId = "search_terms", label = "Search terms"),
> selectInput("search_fields", label="Search choices", choices=c("All Fields", "Gene symbol",
> "Gene description", "Chromosomal location", "HGNC/OMIM/GDB/Entrez ID", "RefSeq transcript",
> "Disease/phenotype", "Gene Ontology"), selected = "Gene symbol"),
> actionButton("submit", "Submit query")
> )
> )
>
> my_mutation = list(
> menuItem("Búsqueda por mutación", tabName="mutation"),
> conditionalPanel("input.siderbarmenu == 'mutation'",
> textInput(inputId = "search_mut", label = "Search mutations"),
> selectInput("search_fields", label="Search choices", choices=c("All Fields", "Gene symbol",
> "Gene description", "Chromosomal location", "HGNC/OMIM/GDB/Entrez ID", "RefSeq transcript",
> "Disease/phenotype", "Gene Ontology")),
> actionButton("submit2", "Submit query")
> )
> )
>
>
> my_gene = list(
> menuItem("Búsqueda por gene", tabName="search_exact_gene"),
> textInput(inputId = "search_exact_symbol", label = "Exact gene symbol only"),
> actionButton("submit3", "Submit query")
> )
>
> my_reference = list(
> menuItem("Busqueda por referencias", tabName="references", icon = icon("bar-chart-o")),
> conditionalPanel("input.siderbarmenu == 'references'",
> textInput(inputId = "pmid", label = "PMID"),
> textInput(inputId = "author", label = "Autor"),
> textInput(inputId = "publication", label = "Publicación"),
> textInput(inputId = "year", label = "Año de publicación"),
> actionButton("submit4", "Submit query")
> )
> )
>
> my_phenotype = list(
> menuItem("Busqueda por fenotipo", tabName="phenotype", icon = icon("bar-chart-o")),
> textInput(inputId = "phenotype", label = "Búsqueda por fenotipo")
> )
>
>
> if(input$search=="General"){
> menu = my_general
> } else if (input$search=="Gene"){
> menu = my_gene
> } else if (input$search=="Mutation"){
> menu = my_mutation
> } else if (input$search=="Reference") {
> menu = my_reference
> } else if (input$search=="Phenotype"){
> menu = my_phenotype
> }
>
>
> sidebarMenu(menu)
>
> })
> #}
>
> ########################################################
> # tabla filtrada with paste genes #
> ########################################################
>
> filtrado <- reactive({
> dataset <- input$submit3
> print (dataset)
> glist <- isolate(input$search_exact_symbol)
> print(glist)
>
> datos <- filter(mut_genes, gene %in% glist)
>
> buttonInput <- function(FUN, len, id, ...) {
> inputs <- character(len)
> for (i in seq_len(len)) {
> inputs[i] <- as.character(FUN(paste0(id, i), ...))
> }
> inputs
> }
>
>
> datos <- mutate(datos, Mutacion=buttonInput(
> FUN = actionButton,
> len = nrow(datos),
> id = 'button_',
> label = "Delete",
> onclick = 'Shiny.onInputChange(\"select_button\", this.id)'
> ))
>
> data <- select(datos, Mutacion, acc_num, disease, gene, chrom, genename, gdbid, omimid, amino,
> deletion, insertion, codon, codonAff, descr, refseq, hgvs,
> hgvsAll, dbsnp, chromosome, startCoord,endCoord,inheritance,
> gnomad_AC, gnomad_AF, gnomad_AN, tag, dmsupport,rankscore,
> mutype, author, title, fullname, allname, vol, page,
> year, pmid, pmidAll, reftag, comments, new_date,
> base, clinvarID, clinvar_clnsig, gene_id, altsymbol, altname,
> entrezID, hgncID, svar, mut, poly, ftv, go_terms_acc,
> go_terms_name, mut_total, new_mut_total, gene_date)
>
> data
>
> })
>
> output$tablafilt_paste_genes <- DT::renderDataTable({
> if(is.null(filtrado()))
> return()
> datos <- filtrado()
>
> cols <- c("Mutacion","disease", "gene", "chrom", "genename", "gdbid", "omimid", "amino",
> "deletion", "insertion", "codon", "codonAff", "descr", "refseq", "hgvs",
> "hgvsAll", "dbsnp", "chromosome", "startCoord","endCoord","inheritance",
> "gnomad_AC", "gnomad_AF", "gnomad_AN", "tag", "dmsupport","rankscore",
> "mutype", "author", "title", "fullname", "allname", "vol", "page",
> "year", "pmid", "pmidAll", "reftag", "comments", "acc_num", "new_date",
> "base", "clinvarID", "clinvar_clnsig", "gene_id", "altsymbol", "altname",
> "entrezID", "hgncID", "svar", "mut", "poly", "ftv", "go_terms_acc",
> "go_terms_name", "mut_total", "new_mut_total", "gene_date")
>
> columns2show <- c("acc_num", "Mutacion", "disease", "gene", "chrom", "genename", "gdbid", "omimid", "amino",
> "deletion", "insertion", "descr", "hgvs",
> "hgvsAll", "dbsnp", "chromosome", "startCoord","endCoord","inheritance",
> "rankscore", "mutype", "pmid", "pmidAll",
> "base", "clinvarID", "clinvar_clnsig")
>
>
> columns2hide <- colnames(datos)[!colnames(datos) %in% columns2show]
> cols_to_hide <- match(columns2hide, colnames(datos))-1L
> columns_all <- cols
> cols_to_all <- match(columns_all, colnames(datos))-1L
> cols_to_show <- match(columns2show, colnames(datos))-1L
> cols_to_show <- cols_to_show[!is.na(cols_to_show)]
>
> DT::datatable(datos,
> rownames = FALSE,
> style = 'bootstrap',
> class = 'compact cell-border stripe hover',
> filter = list(position = 'top', clear = FALSE),
> escape = FALSE,
> extensions = c('Buttons', "FixedHeader", "Scroller"),
> options = list(
> stateSave = FALSE,
> ordering = FALSE,
> autoWidth = TRUE,
> search = list(regex = TRUE, caseInsensitive = TRUE),
> columnDefs = list(
> list(
> className = 'dt-center',
> targets = cols_to_all,
> render = JS("function(data, type, row, meta) {",
> "return type === 'display' && typeof data === 'string' && data.length > 10 ?",
> "'<span title=\"' + data + '\">' + data.substr(0, 10) + '...</span>' : data;",
> "}")
> ),
> list(
> visible = FALSE,
> targets = cols_to_hide
> )
>
> ),
> initComplete = JS(
> "function(settings, json) {",
> "$(this.api().table().header()).css({'font-size': '12px'});",
> "}"),
> sDom = '<"top">Brtp<"bottom">i', # remove search general box and keep the top filters
> scrollX = TRUE,
> deferRender=TRUE,
> buttons = list('colvis'),
> FixedHeader = TRUE,
> pageLength = 25,
> lengthMenu = list(c(25, 50, 100, -1), list('25', '50', '100', 'All'))
> ),
> callback = JS('table.page(3).draw(false); "setTimeout(function() { table.draw(true); }, 300);"')) %>%
> formatStyle(columns = colnames(.$x$data), `font-size` = "15px")
> })
>
> tab_list <- NULL
>
> observeEvent(input$select_button,{
> print(as.numeric(strsplit(input$select_button, "_")[[1]][2]))
> fila <- as.numeric(strsplit(input$select_button, "_")[[1]][2])
>
> df2 <- filtrado()
> nombre <- df2$acc_num[fila]
> print(nombre)
> tab_title <- paste("Mutation", # tab_title is the tab's name and unique identifier
> "-", nombre )
>
> if(tab_title %in% tab_list == FALSE){ # Checks to see if the title already exists
> details <- mut_genes %>% # Reuses the db_flights dbplyr variable
> filter(acc_num == nombre, # Uses the [event.point.category] value for the filter
> ) # Matches the current airline filter
>
> str(details)
>
> #details <- details %>% # Select only the first 100 records
> # collect() # Brings the 100 records into the R environment
>
> appendTab(inputId = "tabs", # Starts a new Shiny tab inside the tabsetPanel named "tabs"
> tabPanel(
> tab_title, # Sets the name & ID
> DT::renderDataTable(details) # Renders the DataTable with the 100 newly collected rows
> ))
> tab_list <<- c(tab_list, tab_title) # Adds the new tab to the list, important to use <<-
> }
>
> # Switches over to a panel that matched the name in tab_title.
> # Notice that this function sits outside the if statement because
> # it still needs to run to select a previously created tab
> updateTabsetPanel(session, "tabs", selected = tab_title)
> })
>
>
>
> #})
> }
>
> runApp(shinyApp(ui, server)