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).
Related
I have a small rshiny app, in which i can select row in datatable and get values from first columns.
but how to quickly get rid of the selected rows and values without clicking on the row again?
also if you know what can be improved in this code, then write, I just started coding in R
# Define UI
ui <- fluidPage(
dataTableOutput('main_information'),
fluidRow(
column(8,verbatimTextOutput('selected_rows', placeholder = TRUE)),
fluidRow(
column(4,actionButton("reset", "RESET"))
)
)
)
# Define server function
server <- function(input, output,session) {
getScoreTable<-reactive({
db <- dbConnect(SQLite(), "path")
data <- dbGetQuery(
conn = db,
statement =
'...'
)
})
output$main_information <- renderDataTable(
getScoreTable(),
options = list(
pageLength = 5,
lengthMenu = list(c(5,10, 25, 50, 100),
c('5', '10', '25','50', '100'))
)
)
s<-reactiveValues(data= NULL)
output$selected_rows = renderPrint({
s = input$main_information_rows_selected
if (length(s)) {
cat('These values were selected:\n\n')
cat(getScoreTable()[s,1], sep = '\n')
}else{
cat('No value has been selected')
}
})
}
# Create Shiny object
shinyApp(ui = ui, server = server)
You can use a custom action button:
library(DT)
js <- "
function ( e, dt, node, config ) {
dt.rows().deselect();
}
"
datatable(
iris,
extensions = c("Buttons", "Select"),
selection = "none",
options = list(
"dom" = "Bfrtip",
"select" = TRUE,
"buttons" = list(
list(
"extend" = "collection",
"text" = "DESELECT",
"action" = JS(js)
)
)
)
)
This example works fine. If you have an issue in Shiny, please provide a minimal reproducible code, not using SQL.
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:
I'm using the datatables package in a shiny app and its working well, but when i edit a cell/value the focus changes from the current row to the first row. The table is long so having to scroll back to the row being edited is a problem. Is there a way of selecting a certain row? then I can return to the row being edited after the table reloads.
Here's the code for the datatable render in shiny. Any suggestions please?
output$book_table <- DT::renderDT(RVTables$book %>%
filter(deal == as.numeric(input$deal_choice)),
selection = 'single',
editable = TRUE,
rownames = FALSE,
options = list(
autoWidth = TRUE,
ordering = FALSE,
pageLength = 12,
scrollX = TRUE,
scrollY = TRUE,
bLengthChange = FALSE,
searching = FALSE
)
)
edit:
I found a way of selecting a row, but I can't dynamically update it.
row_edit<-3
output$book_table <- DT::renderDT(RVTables$book %>%
filter(deal == as.numeric(input$deal_choice)),
selection = list(mode='single',selected=row_edit)
editable = TRUE,
rownames = FALSE,
options = list(
autoWidth = TRUE,
ordering = FALSE,
pageLength = 12,
scrollX = TRUE,
scrollY = TRUE,
bLengthChange = FALSE,
searching = FALSE
)
)
and using a global assignment in the edit event also hasn't worked:
row_edit<<- 22
EDIT
Here's a sample app to show what I'm trying to do.
Edit row 42 for example an see how the next row highlighted is back on the first page, which is annoying if you want to edit a single value multiple times to see the effect.
library(shiny)
library(shinyjs)
library(tidyverse)
library(DT) #load after shiny
data_input <- data.frame(ID=seq(1,50),
weight=sample(50:65,50,replace = TRUE),
height=sample(150:225,50,replace = TRUE)
)
#shiny---
shinyApp(
#ui----
ui= fluidPage(
fluidRow(
br(),
column(2,
actionButton("increase_weight","increase weight"),
uiOutput("show_row_selected"),
uiOutput("last_row_selected")
),
column(4,DT::DTOutput("data_table"))
)
),
server=function(input,output,session){
#save data frame as a reactive value
RV <- reactiveValues(
data=data_input
)
#try to save last row selected----
row_select <- reactive({
#case when code below fails, use row 3 to illustrate code
3
#uncomment code below and run to see error
# case_when(
# #valid row selected
# length(input$data_table_rows_selected)>0 ~ as.numeric(input$data_table_rows_selected),
# #after update, row object is empty to use last selected row
# #this is now recursive and app fails - "evaluation nested too deeply: infinite recursion...."
# length(input$data_table_rows_selected)==0 ~ row_select()
# )
})
#render data frame for output
output$data_table <- DT::renderDT(RV$data,
selection = list(mode="single",selected=row_select()),
editable = TRUE,
rownames = FALSE,
options=list(
autoWidth=TRUE,
scrollX = TRUE,
ordering=FALSE,
pageLength=12,
scrollY = TRUE,
bLengthChange= FALSE,
searching=FALSE
)
)
#edit a single cell----
observeEvent(input$data_table_cell_edit, {
info <- input$data_table_cell_edit
edit_row <- info$row
edit_col <- info$col+1 # column index offset by 1
edit_value <- info$value
#find leg to be edited
ID <- edit_row
RV$data[ID,edit_col] <-as.numeric(edit_value)
})
#increase weight by one----
observeEvent(input$increase_weight, {
edit_row <- input$data_table_rows_selected
RV$data[edit_row,"weight"] <- RV$data[edit_row,"weight"]+1
})
#show current row selected----
output$show_row_selected <- renderText({
paste0("row selected: ",as.character(as.numeric(input$data_table_rows_selected)))
})
#show last row selected----
output$last_row_selected <- renderText({
paste0("row selected: ",as.character(row_select()))
})
})
With help from this question, here's some code which works.
library(shiny)
library(shinyjs)
library(tidyverse)
library(DT) #load after shiny
data_input <- data.frame(ID=seq(1,50),
weight=sample(50:65,50,replace = TRUE),
height=sample(150:225,50,replace = TRUE)
)
#shiny---
shinyApp(
#ui----
ui= fluidPage(
fluidRow(
br(),
column(2,
actionButton("increase_weight","increase weight"),
uiOutput("show_row_selected")
),
column(4,DT::DTOutput("data_table"))
)
),
server=function(input,output,session){
#save data frame as a reactive value
RV <- reactiveValues(
data=data_input
)
previousSelection <- NULL
previousPage <- NULL
#render data table
output$data_table <- DT::renderDataTable({
DT::datatable(
RV$data,
editable = TRUE,
selection = list(mode = "single", target = "row", selected = previousSelection),
options = list(
autoWidth=TRUE,
scrollX = TRUE,
pageLength = 10,
displayStart = previousPage))
})
#edit a single cell----
observeEvent(input$data_table_cell_edit, {
info <- input$data_table_cell_edit
edit_row <- info$row
edit_col <- info$col
edit_value <- info$value
previousSelection <<- input$data_table_rows_selected
previousPage <<- input$data_table_rows_current[1] - 1
#find leg to be edited
RV$data[edit_row,edit_col] <-as.numeric(edit_value)
})
#increase weight by one----
observeEvent(input$increase_weight, {
edit_row <- input$data_table_rows_selected
previousSelection <<- input$data_table_rows_selected
previousPage <<- input$data_table_rows_current[1] - 1
RV$data[edit_row,"weight"] <- RV$data[edit_row,"weight"]+1
})
#show current row selected----
output$show_row_selected <- renderText({
paste0("row selected: ",as.character(as.numeric(input$data_table_rows_selected)))
})
})
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.