The tables displayed through the DataTables interface from DT package appear messy (e.g. disordered elements, strange looking pagination ...) when using reactive values which their input come from the rows selected in the first table. Using R version 3.4.3, and shiny 1.1.0 and DT 0.4 which both are sourced from CRAN.
The minimal code:
library(shiny)
library(DT)
ui <- fluidPage(
DT::dataTableOutput("dt"),
actionButton("go", "Go"),
wellPanel(DT::dataTableOutput("selected"))
)
server <- function(input, output, session) {
output$dt <- DT::renderDataTable({
DT::datatable(
mtcars,
style = 'bootstrap',
filter = 'top',
rownames = FALSE,
extensions = 'Buttons',
selection = list(mode = 'single'),
options = list(
pageLength = 10,
dom = '<"top"ifl>t<"bottom"Bp>',
buttons = c('copy', 'csv', 'excel'),
searchHighlight = TRUE
)
)
})
rv <- reactiveValues(val = FALSE)
observeEvent(input$go, {
rv$val <- input$go
})
observeEvent(input$dt_rows_selected, {
rv$val <- FALSE
})
output$selected <- DT::renderDataTable({
if (rv$val == FALSE)
return()
reactive({
validate(need(input$dt_rows_selected != "", "Select a row."))
mtcars[input$dt_rows_selected, ]
}) -> .mtcars
isolate({
DT::datatable(
.mtcars(),
style = 'bootstrap',
filter = 'top',
rownames = FALSE,
extensions = 'Buttons',
selection = list(mode = 'single'),
options = list(
pageLength = 10,
dom = '<"top"ifl>t<"bottom"Bp>',
buttons = c('copy', 'csv', 'excel'),
searchHighlight = TRUE
)
) -> table
})
table
})
}
shinyApp(ui, server)
It looks decent without the second table:
The issue is caused by the part style = 'bootstrap' which does not work well with return(NULL). Replacing if (rv$val == FALSE) return() with req(rv$val) in the output has solved the problem. Has taken the reference here.
Related
I want to create a button that downloads the filtered data of a dataTable, so I read these two posts and tried to do like them but I got an error and it didn't show the table rows. (please see the attachment)
R - Download Filtered Datatable
and
Download filtered data from renderDataTable() in Shiny
The error is: 'data' must be 2-dimensional (e.g. data frame or matrix)
This is a part of my code:
#UI SECTION
downloadButton("download_filtered", "Download filtered dataset"),
verbatimTextOutput("filtered_row"),
DT::dataTableOutput("fancyTable"),
tags$hr(),
plotOutput("fancyPlot")
#SERVER SECTION
server <- function(input, output) {
output$fancyTable<- renderDataTable ({
my_data = data_filter()
DT::datatable(my_data, extensions = "Buttons",
options = list(paging = TRUE,
scrollX=TRUE,
searching = TRUE,
ordering = TRUE,
dom = 'l<"sep">Bfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf'),
pageLength=10,
lengthMenu=c(10,20,50,100) )
)
output$filtered_row <- renderPrint({
input[["fancyTable_rows_all"]]
})
output$download_filtered <- downloadHandler(
filename = "Filtered Data.csv",
content = function(file){
write.csv(my_data[input[["fancyTable_rows_all"]], ],
file)
}
)
})
}
I would be happy if you have any suggestions.
Thank you :)
I have tweaked the code minimally. First I used mtcars instead of my_data.
I think the main issue is to Set server = FALSE in the renderDT function (learned here #Stéphane Laurent) R shiny datatable extension "Buttons" - how to export the whole table to excel?:
library(shiny)
library(DT)
ui <- fluidPage(
downloadButton("download_filtered", "Download filtered dataset"),
verbatimTextOutput("filtered_row"),
DT::dataTableOutput("fancyTable"),
tags$hr(),
plotOutput("fancyPlot")
)
server <- function(input, output, session) {
output$fancyTable <-
DT::renderDT({
datatable(mtcars,
filter = "top",
extensions = "Buttons",
options = list(paging = TRUE,
scrollX=TRUE,
searching = TRUE,
ordering = TRUE,
dom = 'l<"sep">Bfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf'),
pageLength=10,
lengthMenu=c(10,20,50,100)
)
)
}, server = FALSE
)
output$filtered_row <- renderPrint({
input[["fancyTable_rows_all"]]
})
output$download_filtered <- downloadHandler(
filename = "Filtered Data.csv",
content = function(file){
write.csv(my_data[input[["fancyTable_rows_all"]], ],
file)
}
)
}
shinyApp(ui, server)
I have an editable datatable which is paginated as follows :
d1 = file.df
output$file.df_data<-DT::renderDataTable(
d1,selection = 'none', editable = list(target = "cell", disable = list(columns = c(which(names(d1) != "product_type")-1))),
rownames = FALSE,
extensions = 'Buttons',
options = list(
paging = TRUE,
searching = TRUE,
fixedColumns = TRUE,
autoWidth = TRUE,
ordering = TRUE,
dom = 'Bfrtip',
buttons = c('csv', 'excel')
),
class = "display"
)
When I make an edit on the current page, move to some other page, and then return to the previous page the edits that I had made on the page disappear. How can I make the edits persist across the pages?
Following is the code I am using to observe edits-
observeEvent(input$file.df_data_cell_edit, {
d1[input$file.df_data_cell_edit$row,input$file.df_data_cell_edit$col+1] <<- input$file.df_data_cell_edit$value
})
You have to use a proxy and the editData function:
library(shiny)
library(DT)
ui <- basicPage(
br(),
DTOutput("dtable")
)
server <- function(input, output, session){
dat <- iris
output[["dtable"]] <- renderDT({
datatable(dat, editable = TRUE)
})
proxy <- dataTableProxy("dtable")
observeEvent(input[["dtable_cell_edit"]], {
info <- input[["dtable_cell_edit"]]
dat <<- editData(dat, info, proxy)
})
}
shinyApp(ui, server)
I'm not proficient in Javascript and would like to replicate a dropdown function as is available in the rhandsontable package but for the DT package.
How could this be achieved in the most efficient way?
Example
library(DT)
i <- 1:5
datatable(iris[1:20, ],
editable = T,
options = list(
columnDefs = list(
list(
targets = 5,
render = JS(
# can't get my head around what should be in the renderer...
)
))
))
The goal is to have the i variable act as validator for the allowed input in the DT object.
Any help is much appreciated!
I blatantly stole the idea from Yihui's app for including radioButtons in DT.
Code:
library(shiny)
library(DT)
ui <- fluidPage(
title = 'Selectinput column in a table',
h3("Source:", tags$a("Yihui Xie", href = "https://yihui.shinyapps.io/DT-radio/")),
DT::dataTableOutput('foo'),
verbatimTextOutput('sel')
)
server <- function(input, output, session) {
data <- head(iris, 5)
for (i in 1:nrow(data)) {
data$species_selector[i] <- as.character(selectInput(paste0("sel", i), "", choices = unique(iris$Species), width = "100px"))
}
output$foo = DT::renderDataTable(
data, escape = FALSE, selection = 'none', server = FALSE,
options = list(dom = 't', paging = FALSE, ordering = FALSE),
callback = JS("table.rows().every(function(i, tab, row) {
var $this = $(this.node());
$this.attr('id', this.data()[0]);
$this.addClass('shiny-input-container');
});
Shiny.unbindAll(table.table().node());
Shiny.bindAll(table.table().node());")
)
output$sel = renderPrint({
str(sapply(1:nrow(data), function(i) input[[paste0("sel", i)]]))
})
}
shinyApp(ui, server)
Output:
Trying to add in the following information to a datatable in Shiny, and getting errors when using the selectinput:
Error: incorrect number of dimensions
library(DT)
library(readr)
library(jsonlite)
library(data.table)
gumdad <- fromJSON("data/boxes.json")
# Define UI for app ----
ui <- fluidPage(
# App title ----
titlePanel("Box Scores"),
#FILTERS
selectInput("season",
"Season:",
c("All",
unique(as.character(gumdad$season)))),
# Main panel for displaying outputs ----
mainPanel(
# Output: Table----
DT::dataTableOutput('tableone')
)
)
# Define server logic ----
server <- function(input, output) {
output$tableone = renderDataTable({
data <- datatable(gumdad, extensions = 'Buttons', rownames = FALSE, escape = FALSE, selection = 'none',
colnames = c('Season', 'Date', 'Opponent', 'Result', 'UNC', 'Opp', 'OT', 'Location', 'Type','Box Score'),
options = list(buttons = c('copy', 'csv'), paging = FALSE, dom = 'Bfrtip')
)
if (input$season != "All") {
data <- data[data$season == input$season,]
}
return(data)
})
gumdad$box <- sapply(gumdad$box, function(x)
toString(tags$a(href=paste0("https://boxscorexxx.com/", x), "Box Score")))
}
shinyApp(ui = ui, server = server)
How can I used the selectInput while customizing the datatable with the correct dimensions?
In your code, data is not a dataframe, this is a datatable. It's not possible to subset it like this: data[data$season == input$season,]. Subset gumdad instead:
output$tableone = renderDT({
data <- gumdad
if (input$season != "All") {
data <- data[data$season == input$season,]
}
datatable(data, extensions = 'Buttons', rownames = FALSE, escape = FALSE, selection = 'none',
colnames = c('Season', 'Date', 'Opponent', 'Result', 'UNC', 'Opp', 'OT', 'Location', 'Type','Box Score'),
options = list(buttons = c('copy', 'csv'), paging = FALSE, dom = 'Bfrtip')
)
})
Also note that you should use renderDT instead of renderDatatable (or use DT::renderDatatable, which is the same as renderDT).
I am looking for suggestions in improving performance of my shiny app. This shiny app saves data in CSV format when user selects a particular row by clicking on check box. I don't want it to save data every time when user clicks on check box. Hence I created action button so that user clicks on button only when he is done with the checkbox selection of multiple rows.
library(shiny)
library(DT)
mydata = mtcars
mydata$id = 1:nrow(mydata)
runApp(
list(ui = pageWithSidebar(
headerPanel('Examples of Table'),
sidebarPanel(
textInput("collection_txt",label="RowIndex")
,br(),
actionButton("run", "Write Data"),
br(),
p("Writeback with every user input. CSV file gets saved on your working directory!")),
mainPanel(
DT::dataTableOutput("mytable")
))
, server = function(input, output, session) {
shinyInput <- function(FUN,id,num,...) {
inputs <- character(num)
for (i in seq_len(num)) {
inputs[i] <- as.character(FUN(paste0(id,i),label=NULL,...))
}
inputs
}
rowSelect <- reactive({
rows=names(input)[grepl(pattern = "srows_",names(input))]
paste(unlist(lapply(rows,function(i){
if(input[[i]]==T){
return(substr(i,gregexpr(pattern = "_",i)[[1]]+1,nchar(i)))
}
})))
})
observe({
updateTextInput(session, "collection_txt", value = rowSelect() ,label = "RowIndex:" )
d = data.frame(n = rowSelect(), stringsAsFactors = F)
if (input$run == 0)
return()
isolate({write.csv(mydata[as.numeric(d$n),], file = "Writeback.csv" , row.names=F)})
})
output$mytable = DT::renderDataTable({
DT::datatable(cbind(Flag=shinyInput(checkboxInput,"srows_",nrow(mydata),value=NULL,width=1),
mydata), extensions = 'Buttons', options = list(orderClasses = TRUE,
pageLength = 5, lengthChange = FALSE, dom = 'Bfrtip',
buttons = c('copy', 'csv', 'excel'),
drawCallback= JS(
'function(settings) {
Shiny.bindAll(this.api().table().node());}')
),escape=F)
}
)
}), launch.browser = T
)
I want action button to write data in CSV format only when user clicks on action button. Is there any way to improve the code below.
d = data.frame(n = rowSelect(), stringsAsFactors = F)
if (input$run == 0)
return()
isolate({write.csv(mydata[as.numeric(d$n),], file = "Writeback.csv" , row.names=F)})
Why are you not using observeEvent for the actionButton?
observeEvent(input$run, {
updateTextInput(session, "collection_txt", value = rowSelect() ,label = "RowIndex:" )
d = data.frame(n = rowSelect(), stringsAsFactors = F)
write.csv(mydata[as.numeric(d$n),], file = "Writeback.csv" , row.names=F)
})
I think you're looking for the require function req(input$run) or try if(is.null(input$run)==T){return()}