Given following shiny app:
library(shiny)
library(tidyverse)
library(DT)
ui <- fluidPage(
br(),
DTOutput("DT")
)
server <- function(input, output) {
output$DT <- renderDataTable({
mtcars %>%
datatable(.,extensions = 'Buttons',
options = list(dom = 'Bfrtip',
exportOptions = list(header = ""),
buttons = c('copy', 'csv', 'excel', 'pdf')))
})
}
shinyApp(ui = ui, server = server)
one can copy the full table in the clipboard using the buttons on the top left of the datatable.
But when pasting the content into excel, notepad, or whatever there is a header, which I want to remove.
I'm pretty sure that the header can be deleted or changed using sth. similar to exportOptions = list(header = ""),. But not suprisingly this is not working. Perhaps one can find or translate a solution from here to R/Shiny.
That's the title option of the button:
library(shiny)
library(DT)
ui <- fluidPage(
br(),
DTOutput("DT")
)
server <- function(input, output) {
output$DT <- renderDT({
mtcars %>%
datatable(., extensions = 'Buttons',
options = list(
dom = 'Bfrtip',
buttons = list(
list(
extend = "copy",
text = "COPY",
title = NULL
)
)
)
)
})
}
shinyApp(ui = ui, server = server)
Related
I have a google form/survey that saves the responses into a google sheet.
Data from the google sheet is going into my flexdashboard/shiny app but if a response is saved while someone is using the app - the only way to see the response is by actually clicking refresh in the browser.
I would like to add a button that can rerun the application without the user clicking refresh? Is this possible?
Here is some code I have written - I have some code that I put together but it doesn't seem to work.
---
title: "Test "
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(shiny)
library(DT)
library(gsheet)
```
Inputs {.sidebar data-width=300}
-----------------------------------------------------------------------
```{r}
jscode <- "shinyjs.refresh = function() { history.go(0); }"
actionButton(jscode, "Refresh")
observeEvent(input$reset, {
})
```
Column
-------------------------------------
### Chart A
```{r}
data <- gsheet2tbl('https://docs.google.com/spreadsheets/d/1CB2IQHb3g5d8KsEr-_lJNXPKnTBn2nhz_-AzBjRyRK4/edit#gid=0')
datatable(data
,
editable = TRUE,
options = list(
columnDefs = list(list(className = 'dt-center', targets = "_all")))
)
```
We can use invalidateLater(10000) to fetch the data every 10 seconds if the reset button is not preferred.
app:
library(shiny)
library(shinyjs)
library(DT)
library(gsheet)
ui <- fluidPage(
useShinyjs(),
actionButton("reset", inputId = "Refresh"),
DTOutput("table")
)
server <- function(input, output, session) {
observeEvent(input$Refresh, {
refresh()
})
data <- reactive({
#invalidateLater(10000)
gsheet2tbl("https://docs.google.com/spreadsheets/d/1CB2IQHb3g5d8KsEr-_lJNXPKnTBn2nhz_-AzBjRyRK4/edit#gid=0")
})
output$table <- renderDataTable({
datatable(data(),
editable = TRUE,
options = list(
columnDefs = list(list(className = "dt-center", targets = "_all"))
)
)
})
}
shinyApp(ui, server)
A third alternative is to directly re-render the data when the button is pressed:
code:
library(shiny)
library(shinyjs)
library(DT)
library(gsheet)
data <- gsheet2tbl("https://docs.google.com/spreadsheets/d/1CB2IQHb3g5d8KsEr-_lJNXPKnTBn2nhz_-AzBjRyRK4/edit#gid=0")
ui <- fluidPage(
useShinyjs(),
actionButton("reset", inputId = "Refresh"),
DTOutput("table")
)
server <- function(input, output, session) {
observeEvent(input$Refresh, {
df <- gsheet2tbl("https://docs.google.com/spreadsheets/d/1CB2IQHb3g5d8KsEr-_lJNXPKnTBn2nhz_-AzBjRyRK4/edit#gid=0")
output$table <- renderDT({
datatable(df,
editable = TRUE,
options = list(
columnDefs = list(list(className = "dt-center", targets = "_all"))
)
)})
})
#this will render once at the start of the app
output$table <- renderDataTable({
datatable(data,
editable = TRUE,
options = list(
columnDefs = list(list(className = "dt-center", targets = "_all"))
)
)
})
}
shinyApp(ui, server)
IS there a way to get datatable when the user clicks on the row. Basically when the user clicks on any row, the last 4 columns of that specific row should be displayed in a modal (in datatable format)
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("mydatatable")
)
server <- function(input, output, session) {
mycars = head(mtcars)
output$mydatatable = DT::renderDataTable(mycars, selection = 'single',
rownames = FALSE, options = list(dom = 't'))
observeEvent(input$mydatatable_rows_selected,
{
showModal(modalDialog(
title = "You have selected a row!",
mycars[input$mydatatable_rows_selected,]
))
})
}
shinyApp(ui, server)
You can use renderDataTable inside modalDialog.
library(shiny)
library(DT)
ui <- fluidPage(
DT::dataTableOutput("mydatatable")
)
server <- function(input, output, session) {
mycars = head(mtcars)
output$mydatatable = DT::renderDataTable(mycars, selection = 'single',
rownames = FALSE, options = list(dom = 't'))
observeEvent(input$mydatatable_rows_selected,
{
showModal(modalDialog(
title = "You have selected a row!",
DT::renderDataTable({
DT::datatable(mycars[input$mydatatable_rows_selected, (ncol(mycars) - 3):ncol(mycars)])
})
))
})
}
shinyApp(ui, server)
This is my code, I want copy or print all, but it only print current page, thank you!
library(shiny)
library(DT)
ui <- fluidPage(
DT::dataTableOutput("tt")
)
server <- function(input, output, session) {
iris2 = head(iris, 20)
output$tt <- DT::renderDataTable(
iris2,
extensions = 'Buttons', options = list(
dom = 'Bfrtip',
buttons = c('copy', 'print')
)
)
}
shinyApp(ui, server)
The easiest way is to use the option server = FALSE.
output$tt <- renderDT({
datatable(
iris2,
extensions = 'Buttons',
options = list(
dom = 'Bfrtip',
buttons = c('copy', 'print')
)
)
}, server = FALSE)
I'm trying to create a small app that reads some parameters (as textInput) and changes the data frame accordingly, but it looks like it's not really reading the input.
If I open the app, insert the parameters, and then click submit nothing happens, I still cannot see the dataframe. I have also tried using observeEvent but that didn't work either. I can't figure out why since I used the same code structure for a selectInput and everything worked fine.
I have created a small reproducible example:
library(shiny)
library(shinydashboard)
library(data.table)
library(DT)
library("RJDBC")
library("RODBC")
##
ui <- shinyUI(pageWithSidebar(
headerPanel("DBC Comparison"),
sidebarPanel(
textInput("Database_1", "Database 1"),
textInput("Database_2", "Database2"),
textInput("odbc", "ODBC Name"),
textInput("user", "Username"),
textInput("pwd", "password"
),
actionButton(
inputId = "submit_loc",
label = "Submit")
),
mainPanel(
DT::dataTableOutput("table"),
div(style = 'overflow-x: scroll', tableOutput('table'))
)
))
##
server <- shinyServer(function(input, output, session) {
Difference = reactive({
df <- data.frame(user = input$user, pwd =input$pwd, db2=input$Database_2, db1=input$Database_1)
return(list(df=df))
})
output$table = DT::renderDataTable(server = TRUE,{
DT::datatable(Difference,
extensions=c("Buttons",'Scroller'),
options = list(dom = 'Bfrtip',
buttons = c('copy', 'csv',
'excel', 'pdf',
'print'),
scrollY = 500,
scroller = TRUE)
)
})
})
##
shinyApp(ui = ui, server = server)
Seems like the problem was probably with:
div(style = 'overflow-x: scroll', tableOutput('table'))
So I commented that out, also had to refer to Difference as Difference() in your datatable call. And made the changing of that datatable depend on eventReactive(input$submit_loc,{expr})
library(shiny)
library(shinydashboard)
library(data.table)
library(DT)
library("RJDBC")
library("RODBC")
##
ui <- shinyUI(pageWithSidebar(
headerPanel("DBC Comparison"),
sidebarPanel(
textInput("Database_1", "Database 1"),
textInput("Database_2", "Database2"),
textInput("odbc", "ODBC Name"),
textInput("user", "Username"),
textInput("pwd", "password"
),
actionButton(
inputId = "submit_loc",
label = "Submit")
),
mainPanel(
DT::dataTableOutput("table")#,
#div(style = 'overflow-x: scroll', tableOutput('table'))
)
))
##
server <- shinyServer(function(input, output, session) {
Difference = eventReactive(input$submit_loc,{
df <- data.frame(user = input$user, pwd =input$pwd, db2=input$Database_2, db1=input$Database_1)
return(df)
})
output$table = DT::renderDataTable(server = TRUE,{
DT::datatable(Difference(),
extensions=c("Buttons",'Scroller'),
options = list(dom = 'Bfrtip',
buttons = c('copy', 'csv',
'excel', 'pdf',
'print'),
scrollY = 500,
scroller = TRUE)
)
})
})
##
shinyApp(ui = ui, server = server)
I have a datatable in shiny. When a user selects a certain row, I want to display some other data based on the selected row in a new window. I tried to use shinyBS package but I could not use it without action button and I don't want to include action button. I want the pop up to display when a row is selected. Any ideas?
mymtcars = head(mtcars)
for_pop_up = 1:6
app <- shinyApp(
ui = fluidPage(
DT::dataTableOutput("mydatatable")
),
server = shinyServer(function(input, output, session) {
mycars = head(mtcars)
output$mydatatable = DT::renderDataTable(mycars, selection = 'single',
rownames = FALSE, options = list(dom = 't'))
output$popup = renderPrint({
for_pop_up[input$mydatatable_rows_selected]
})
})
)
runApp(app)
You could use an observeEvent and a modal dialog, like this:
mymtcars = head(mtcars)
for_pop_up = 1:6
app <- shinyApp(
ui = fluidPage(
DT::dataTableOutput("mydatatable")
),
server = shinyServer(function(input, output, session) {
mycars = head(mtcars)
output$mydatatable = DT::renderDataTable(mycars, selection = 'single',
rownames = FALSE, options = list(dom = 't'))
observeEvent(input$mydatatable_rows_selected,
{
showModal(modalDialog(
title = "You have selected a row!",
mycars[input$mydatatable_rows_selected,]
))
})
})
)
Hope this helps!