Related
I understand scrollY should constrain the height of the data table. I have a data table configured as below, but when I choose a page size of 100, the table just expands. I want the table to remain visible on the page, with the page navigation at the bottom always visible, and the user to have to scroll through the content.
output$search_results <- DT::renderDataTable(filtered_df(),
server=TRUE,
extensions = c('Buttons', 'ColReorder', 'FixedColumns','FixedHeader', 'KeyTable'),
options = list(
#dom = 'Blfrtip',
dom = 'Blptilp',
colReorder = TRUE,
buttons = c('copy', 'csv', 'excel'),
autoWidth = TRUE,
scrollX = TRUE,
scrollY = "500px",
fixedColumns = list(leftColumns = 2),
fixedHeader = TRUE,
keys=TRUE,
lengthMenu = c(5,10,20,50,100),
columnDefs = list(list(width = '500px', targets = c(0,1)))
)
)
I use DT::data.table in my shiny app, but the fixed colums can't match other cols.
It's my ui and server code:
Ui.R
DT::dataTableOutput("mytable2")
Server.R:
output$mytable2 <- DT::renderDT({
IDNAME <- soya.info$Names
names(IDNAME) <- soya.info$ID
IDNAMEsd <- IDNAME[colnames(serchSNP)[-c(1:7)]]
colnames(serchSNP)[-c(1:7)] <- paste0(colnames(serchSNP)[-c(1:7)], " (", IDNAMEsd, ")")
DT::datatable(
serchSNP,
selection = 'none', rownames = FALSE, escape = FALSE,
extensions = c("FixedColumns","Buttons"),
options = list(
buttons = list('pageLength',
list(extend = 'csv', filename = paste("snp", sep = "-")),
list(extend = 'excel', filename = paste("snp", sep = "-")),
'copy'),dom = 'Bfrtip',
pageLength = 15, columnDefs=list(list(targets="_all", class="dt-center")),
bSort = FALSE, scrollX = TRUE, fixedColumns = list(leftColumns = 6),
initComplete = DT::JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#676464', 'color': '#fff'});",
"}")
)
)
}, server = FALSE)
My app in https://venyao.xyz/SoybeanGDB/,
In page SNPs - Search
I am trying to build a shiny app with shinyMobile, and storing the results using shinyStore, I have been looking at several answers but I haven't been able to fix this. I think there might be an issue with the multiple option.
Here is the code:
library(shiny)
library(shinyMobile)
library(shinyStore)
Species_List <- structure(list(Scientific_name = c("Juncus alpinoarticulatus ssp. nodulosus",
"Diphasiastrum complanatum ssp. complana-tum", "Rubus macrophyllus",
"Equisetum scirpoides", "Trifolium hybridum ssp. hybridum", "Narthecium ossifragum",
"Peucedanum oreoselinum", "Sonchus oleraceus", "Juncus subnodulosus",
"Minuartia viscosa"), Danish_name = c("siv, stilk-", "ulvefod, flad",
"brombær, storbladet", "padderok, tråd-", "kløver, alsike-",
"benbræk", "svovlrod, bakke-", "svinemælk, almindelig", "siv, butblomstret",
"norel, klæbrig")), row.names = c(NA, -10L), class = "data.frame")
shinyApp(
ui = f7Page(
title = "Species app",
f7SingleLayout(
navbar = f7Navbar(
title = "Select Species",
hairline = TRUE,
shadow = TRUE
),
toolbar = f7Toolbar(
position = "bottom",
f7Link(label = "Link 1", href = "https://www.google.com"),
f7Link(label = "Link 2", href = "https://www.google.com")
),
initStore("store", "shinyStore-ex1"),
# A button to save current input to local storage
actionButton("save", "Save", icon("save")),
# A button to clear the input values and local storage
actionButton("clear", "Clear", icon("stop")),
# main content
f7Shadow(
intensity = 16,
hover = TRUE,
f7SmartSelect(inputId = "SpeciesListSc",
label = "Select all species",
multiple = TRUE,
choices = unique(Species_List$Scientific_name),
virtualList = T,
openIn = "sheet")
)
)
),
server = function(input, output, session) {
observe({
if (input$save <= 0){
updateF7SmartSelect(session, inputId = "SpeciesListSc", selected = isolate(input$store)$SpeciesListSc, choices = unique(Species_List$Scientific_name), multiple = TRUE)
}
})
observe({
if (input$save > 0){
updateStore(session, name = "SpeciesListSc", isolate(input$SpeciesListSc))
}
})
}
)
output$plot <- renderImage({
outfile <- tempfile(fileext = '.png')
png(outfile, width = 400, height = 300)
venn.diagram(
x = list(
T = T,
I = I
),
main = "Venn Diagram ",
filename =outfile, output=TRUE,
lwd = 2,na = "remove",
fill = c("orange", "blue"),
alpha = c(0.5,0.5),
label.col = "black",
cex=1.5,
fontface = "plain",
cat.col = c("cornflowerblue", "pink"),
cat.cex = 1.5,
cat.fontfamily = "serif",
cat.fontface = "plain",
cat.dist = c(0.05, 0.05),
cat.pos = c(-20, 14),
cat.default.pos = "text",
scaled = FALSE
)
dev.off()
list(src = outfile,
contentType = 'image/png',
width = 400,
height = 300,
alt = "This is alternate text")
}, deleteFile = TRUE)
I was trying plot a venn diagram using this code. But it only displays This is alternate text and not outputting any image on the app, Any Idea ?
Try to create a reactive graph as shown below
output$plot <- renderImage({
vennd <- reactive({venn.diagram(
x = list(
T = T,
I = I
),
main = "Venn Diagram ",
filename =outfile, output=TRUE,
lwd = 2,na = "remove",
fill = c("orange", "blue"),
alpha = c(0.5,0.5),
label.col = "black",
cex=1.5,
fontface = "plain",
cat.col = c("cornflowerblue", "pink"),
cat.cex = 1.5,
cat.fontfamily = "serif",
cat.fontface = "plain",
cat.dist = c(0.05, 0.05),
cat.pos = c(-20, 14),
cat.default.pos = "text",
scaled = FALSE
)
})
outfile <- tempfile(fileext = '.png')
png(outfile, width = 400, height = 300)
vennd()
dev.off()
list(src = outfile,
contentType = 'image/png',
width = 400,
height = 300,
alt = "This is alternate text")
}, deleteFile = TRUE)
output$plot <- renderImage({
vennd <- reactive({venn.diagram(
x = list(
T = T,
I = I
),
main = "",
filename =outfile, output=TRUE,
lwd = 2,na = "remove",imagetype="png",
fill = c("orange", "blue"),
alpha = c(0.5,0.5),
label.col = "black",
cex=1.5,
fontface = "plain",
cat.col = c("cornflowerblue", "pink"),
cat.cex = 1.5,
cat.fontfamily = "serif",
cat.fontface = "plain",
cat.dist = c(0.05, 0.05),
cat.pos = c(-20, 14),
cat.default.pos = "text",
scaled = FALSE
)
})
outfile <- tempfile(fileext = '.png')
png(outfile, width = 500, height = 500,type="cairo")
vennd()
dev.off()
list(src = outfile,
contentType = 'image/png',
width = 500,
height = 500,
alt = "This is alternate text")
}, deleteFile = TRUE)
Need to add imagetype="png" and type="cairo" thank you #YBS
I am trying to convert cells in a DT:datatable into clickable buttons, which action is append a new tab on my shiny app.
I have been using this post R Shiny: Handle Action Buttons in Data Table as reference but in my case the buttons shows up like this:
My app is a bit more complicated but I will try to re-create the part that does not work
This is an shorter version of my data.frame
mut_genes <- structure(list(acc_num = c("BM0042985", "BM0393251", "BM0673028"), disease = c("Sucrase isomaltase deficiency", "Metachromatic leukodystrophy", "Fatal surfactant deficiency"), gene = c("SI", "ARSA", "ABCA3"), chrom = c("3q25.2-q26.2", "22q13.31-qter", "16p13.3"), genename = c("Sucrase-isomaltase", "arylsulfatase A", "ATP binding cassette subfamily A member 3"), gdbid = c("120377", "119007", "3770735"), omimid = c("609845", "607574", "601615"), amino = c("Leu-Pro", "Glu-Lys", "Met-Ile"), deletion = c(NA_character_, NA_character_, NA_character_), insertion = c(NA_character_, NA_character_, NA_character_), codon = c(341L, 331L, 1L), codonAff = c(341L, 331L, 1L), hgvs = c("1022T>C", "991G>A", "3G>C"), hgvsAll = c("1022TtoC | L341P", "991GtoA | E331K", "3GtoC | M1I"), dbsnp = c("rs267607049", NA, NA), chromosome = c("3", "22", "16"), startCoord = c(165060026L, 50626052L, 2326464L), endCoord = c(165060026L, 50626052L, 2326464L), inheritance = c("AR", "AR", "AR"), gnomad_AC = c(NA_integer_, NA_integer_, NA_integer_), gnomad_AF = c(NA_real_, NA_real_, NA_real_), gnomad_AN = c(NA_integer_, NA_integer_, NA_integer_), mutype = c("missense", "missense", "initiation"), pmid = c("10903344", "12809637", "16641205"), pmidAll = c(NA, NA, "24871971"), base = c("M", "M", "M"), clinvarID = c("1413", NA, NA), clinvar_clnsig = c("Pathogenic", NA, NA), gene_id = c("2073", "190", "10")), row.names = c(NA, -3L), class = c("tbl_df", "tbl", "data.frame"))
library(shiny)
library(shinyjs)
library(tidyverse)
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(
column(12,dataTableOutput("tablafilt_paste_genes"))
)
)
)
)
)
)
ui <- dashboardPage(header, sidebar, body)
And Here is the server part
server <- function(input, output, session) {
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_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")
)
if(input$search=="General"){
menu = my_general
} else if (input$search=="Gene"){
menu = my_gene
}
sidebarMenu(menu)
})
filtrado <- reactive({
dataset <- input$submit3
glist <- isolate(input$search_exact_symbol)
datos <- filter(mut_genes, gene %in% glist)
shinyInput <- 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=shinyInput(
FUN = actionButton,
len = nrow(datos),
id = 'button_',
label = "Mutacion",
onclick = 'Shiny.onInputChange(\"select_button\", this.id)')
)
return(datos)
})
output$tablafilt_paste_genes <- DT::renderDataTable({
if(is.null(filtrado()))
return()
datos <- filtrado()
DT::datatable(datos, escape = FALSE,
rownames = FALSE,
style = 'bootstrap',
class = 'compact cell-border stripe hover',
filter = list(position = 'top', clear = 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 = 1:ncol(datos)-1L,
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;",
"}")
)
),
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")
})
}
runApp(shinyApp(ui, server))
My ideal situation is recreate the acc_num column and make it a buttom clickable, but when I have tried with
shinyInput <- function(FUN, len, id, label,...) {
inputs <- character(len)
for (i in seq_len(len)) {
label <- datos$acc_num[i]
inputs[i] <- as.character(FUN(paste0(id, i), label=label, ...))
}
inputs
}
It happens the same, I still see the <button id => even when I set the datatable option escape to false
That's because of the quotes. Your render function generates <span title="<button id = "xxx" ...... and this causes the issue.
You don't want to apply the span to the buttons, so add the regex test !(/button/).test(data) in the conditions:
render = JS("function(data, type, row, meta) {",
"return type === 'display' && typeof data === 'string' && data.length > 10 && !(/button/).test(data) ? ",
"'<span title=\"' + data + '\">' + data.substr(0, 10) + '...</span>' : data;",
"}")