Goal: I would like for the user to upload their own data frame, specify the columns in their data frame that provide "Name", "Longitude", and "Latitude" data, then create a table using DataTable (DT package).
Issue: The data frame appears on the render table after the user makes the selections, but when they attempt to sort each column or interact with the data, or even change a selection for "Name", "Longitude", or "Latitude", the following error message appears on the console:
ERROR: [on_request_read] parse error
Here's my code for the ui and server pages I have (note: I am using dashboardPage for layout):
Reproducible Example
ui <- dashboardPage(
dashboardHeader(title = "Test") ,
dashboardSidebar(
sidebarMenu(
menuItem("Selections", tabName = "selections"),
menuItem("Data Table", tabName = "dataTable")
)
),
dashboardBody(
tabItems(
tabItem(
tabName = "selections",
selectInput("mapChoice",
label = "Choose a map:",
choices = c("",
"New Map from Data Table"),
selected = ""),
conditionalPanel("input.mapChoice == 'New Map from Data Table'",
fileInput("userData",
label = "Choose CSV File",
accept=c('text/csv',
'text/comma-separated-values,text/plain',
'.csv')),
uiOutput("newMapUI")
),
###############################################
# Bookmark widget
shinyURL.ui(width = "400px")
###############################################
),
tabItem(
tabName = "dataTable",
DT::dataTableOutput("table")
)
)
)
)
server <- function(input, output, session) {
############################################################
# Add in function for saving and recording urls as bookmarks
shinyURL.server(session)
############################################################
userData <- reactive({
path <- input$userData
if (is.null(path))
return (NULL)
results <- read.csv(file = path$datapath,
header = TRUE,
stringsAsFactors = FALSE)
results
})
output$newMapUI <- renderUI({
list(
# Specify the column for labeling
if (!is.null(userData())) {
selectizeInput("nameCol",
label = "Choose the column to be used for
point labels: ",
choices = c(names(userData())),
multiple = TRUE,
options = list(placeholder = 'Name',
maxItems = 1))
},
# Specify longitude column
if (!is.null(userData())) {
selectizeInput("lonCol",
label = "Choose the column containing longitude
values: ",
choices = c(names(userData())),
multiple = TRUE,
options = list(placeholder = 'Longitude',
maxItems = 1))
},
# Specify latitude column
if (!is.null(userData())) {
selectizeInput("latCol",
label = "Choose the column conatining latitude
values: ",
choices = c(names(userData())),
multiple = TRUE,
options = list(placeholder = 'Latitude',
maxItems = 1))
}
)
})
nameCol <- reactive({
as.character(input$nameCol)
})
lonCol <- reactive({
as.character(input$lonCol)
})
latCol <- reactive({
as.character(input$latCol)
})
newUserData <- reactive({
if (is.null(userData()))
return (NULL)
# Create the new data frame:
if (length(nameCol()) != 0 &&
length(lonCol()) != 0 &&
length(latCol()) != 0) {
userData <- userData()
name <- nameCol()
lonCol <- lonCol()
latCol <- latCol()
results <- data.frame(Name = userData[, name],
Longitude = userData[, lonCol],
Latitude = userData[, latCol])
results$Name <- as.character(results$Name)
results$Longitude <- as.numeric(results$Longitude)
results$Latitude <- as.numeric(results$Latitude)
}
results
})
mapData <- reactive({
data <- data.frame()
if (input$mapChoice == "New Map from Data Table") {
if (length(nameCol()) != 0 &&
length(lonCol()) != 0 &&
length(latCol() != 0)) {
data <- newUserData()
}
}
data
})
output$table <- DT::renderDataTable({
datatable(mapData(),
extensions = c('Buttons', 'FixedHeader', 'Scroller'),
options = list(dom = 'Bfrtip',
buttons = list('copy', 'print',
list(extend = 'csv',
filename = 'map data',
text = 'Download')
),
scrollX = TRUE,
pageLength = nrow(mapData()),
fixedHeader = TRUE,
deferRender = FALSE,
scrollY = 400,
scroller = FALSE,
autowidth = TRUE
)
)
}
) # End of table render
}
shinyApp(ui = ui, server = server)
Note: If I attempted to use this data for a plot, that will also not work. (Plotting the points on a map is my end goal).
Update1: For some dumb reason, this snippet app runs perfectly fine as expected, yet these lines of code are directly from my application. I will continue to update as more things occur.
Update2: After heavy searching and debugging, I finally caught the source of the error message via help of the js provided by the browser while running the app. The error is trying to use shinyURL in combination with DT and fileInput. My guess is that shinyURL is attempting to save a url, which is entirely too long for the browser, and which provides info that the user gave. In other words, it might be trying to save the fileInput data with the url info..? I'm adding the shinyURL function to the example above, so that it will provide the exact same error message I was stuck on. I don't need a solution immediately, but I am curious about what's really happening. (Lines that produce error are highlighted with ### above and below.
Solution
The issue was expected in my latest update, the combination of the user uploaded file and the interaction of the data frame in DT caused the URL generate by shinyURL to be entirely too long.
To find a work around that allows shinyURL to still be in the application, I did some investigating and discovered that DT output creates its own input objects such as input$tableId_rows_current, which tried to save all of the indices of the table every time the user interacted with. So, as soon as the data frame was too large, any interaction with it would pass a url query error, which showed up on the console in R Studio as ERROR [on_request_read] parse error.
Luckily, shinyURL also has an inherent way of ignoring user selected inputs. How? Just simply place a "." at the beginning of the input ID when creating new widgets. Or, in the case of DT table output, place a period at the beginning of your data table output ID, so that all of the inherent DT inputs are ignored.
Code Solution:
ui <- dashboardPage(
dashboardHeader(title = "Test") ,
dashboardSidebar(
sidebarMenu(
menuItem("Selections", tabName = "selections"),
menuItem("Data Table", tabName = "dataTable")
)
),
dashboardBody(
tabItems(
tabItem(
tabName = "selections",
selectInput("mapChoice",
label = "Choose a map:",
choices = c("",
"New Map from Data Table"),
selected = ""),
conditionalPanel("input.mapChoice == 'New Map from Data Table'",
#########################################################
# Add in a period before file input ID
#########################################################
fileInput(".userData",
label = "Choose CSV File",
accept=c('text/csv',
'text/comma-separated-values,text/plain',
'.csv')),
uiOutput("newMapUI")
),
# # Bookmark widget
shinyURL.ui(width = "400px")
),
tabItem(
tabName = "dataTable",
########################################################
# Add in a period before data table output ID
########################################################
DT::dataTableOutput(".table")
)
)
)
)
server <- function(input, output, session) {
# # Add in function for saving and recording urls as bookmarks
shinyURL.server(session)
userData <- reactive({
path <- input$.userData
if (is.null(path))
return (NULL)
results <- read.csv(file = path$datapath,
header = TRUE,
stringsAsFactors = FALSE)
results
})
output$newMapUI <- renderUI({
list(
# Specify the column for labeling
if (!is.null(userData())) {
selectizeInput("nameCol",
label = "Choose the column to be used for
point labels: ",
choices = c(names(userData())),
multiple = TRUE,
options = list(placeholder = 'Name',
maxItems = 1))
},
# Specify longitude column
if (!is.null(userData())) {
selectizeInput("lonCol",
label = "Choose the column containing longitude
values: ",
choices = c(names(userData())),
multiple = TRUE,
options = list(placeholder = 'Longitude',
maxItems = 1))
},
# Specify latitude column
if (!is.null(userData())) {
selectizeInput("latCol",
label = "Choose the column conatining latitude
values: ",
choices = c(names(userData())),
multiple = TRUE,
options = list(placeholder = 'Latitude',
maxItems = 1))
}
)
})
nameCol <- reactive({
as.character(input$nameCol)
})
lonCol <- reactive({
as.character(input$lonCol)
})
latCol <- reactive({
as.character(input$latCol)
})
newUserData <- reactive({
if (is.null(userData()))
return (NULL)
# Create the new data frame:
if (length(nameCol()) != 0 &&
length(lonCol()) != 0 &&
length(latCol()) != 0) {
userData <- userData()
name <- nameCol()
lonCol <- lonCol()
latCol <- latCol()
results <- data.frame(Name = userData[, name],
Longitude = userData[, lonCol],
Latitude = userData[, latCol])
results$Name <- as.character(results$Name)
results$Longitude <- as.numeric(results$Longitude)
results$Latitude <- as.numeric(results$Latitude)
}
results
})
mapData <- reactive({
data <- data.frame()
if (input$mapChoice == "New Map from Data Table") {
if (length(nameCol()) != 0 &&
length(lonCol()) != 0 &&
length(latCol() != 0)) {
data <- newUserData()
}
}
data
})
output$.table <- DT::renderDataTable({
datatable(mapData(),
extensions = c('Buttons', 'FixedHeader', 'Scroller'),
options = list(dom = 'Bfrtip',
buttons = list('copy', 'print',
list(extend = 'csv',
filename = 'map data',
text = 'Download')
),
scrollX = TRUE,
pageLength = nrow(mapData()),
fixedHeader = TRUE,
deferRender = FALSE,
scrollY = 400,
scroller = FALSE,
autowidth = TRUE
)
)
}
) # End of table render
}
shinyApp(ui = ui, server = server)
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 a shiny app where the user uploads a csv file. Then, using the column names from the csv file, I create sortable bucket list. I would like drag the column name from the first rank list and have it cloned (i.e. not depleted). I tried to use the options parameter in add_rank_list() setting pull='clone', but that did not work. Any idea on how to do this? Below is my code, and some fake data can be accessed here.
library(shiny)
library(shinyjs)
library(sortable)
ui <- fluidPage(
titlePanel("App"),
sidebarLayout(
sidebarPanel(
useShinyjs(),
fileInput(inputId = "file1", label = "Select a .csv file",
accept = c("text/csv", "text/comma-separated-values,text/plain",".csv")
),
uiOutput("show_button")
),
mainPanel(
DT::dataTableOutput("table")
)
),
fluidRow(uiOutput("buckets"))
)
server <- function(input, output) {
# input csv file
input_file <- reactive({
if (is.null(input$file1)) {
return("")
}
# actually read the file
read.csv(file = input$file1$datapath)
})
# button to hide/show table
## only show when table is loaded
output$show_button = renderUI({
req(input$file1)
actionButton(inputId = "button", label = "show / hide table")
})
## observe the button being pressed
observeEvent(input$button, {
shinyjs::toggle("table")
})
# output table
output$table <- DT::renderDataTable({
# render only if there is data available
req(input_file())
# reactives are only callable inside an reactive context like render
data <- input_file()
data
})
# Drag and Drop Col names
output$buckets = renderUI(
{
# create list of colnames
req(input$file1)
data = input_file()
cols = colnames(data)
# create bucket list
bucket_list(
header = "Drag the items in any desired bucket",
group_name = "bucket_list_group",
orientation = "horizontal",
add_rank_list(
text = "Drag from here",
labels = as.list(cols),
input_id = "rank_list_1",
css_id = "list1",
options = sortable_options(
group = list(
pull = "clone",
name = "list_group1",
put = FALSE))
),
add_rank_list(
text = "to here",
labels = NULL,
input_id = "rank_list_2",
css_id = "list2",
options = sortable_options(group = list(name = "list_group1")))
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have a selectizeInput that can take multiple values (here: names of datasets). The current state of this input is monitored by an observeEvent, which renders the corresponding datatables and dynamically populates a tabsetPanel with the outputs. It all works fine when I choose new values directly in the input field. However, when I supply multiple new values with the updateSelectizeInput function, all tabs contain the same dataframe corresponding to the last value in the selected argument.
The example below illustrates the problem. The UI reacts as expected when using the input field, but when pressing the "Add all at once" button all tabs contain the same dataframe.
library(shiny)
library(shinyWidgets)
library(shinyjs)
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput(inputId = "dataframes", label = "select dataframes", choices = c("iris", "mtcars", "DNase", "ChickWeight"), multiple = TRUE),
actionButton(inputId = "add_all", label = "Add all at once")
),
mainPanel(tabsetPanel(id = "df_tabset"))
)
)
server <- function(input, output, session) {
tables <- reactiveValues(iris = iris, mtcars = mtcars, DNase = DNase, ChickWeight = ChickWeight,
df_tabset = NULL) # keeps track of currently displayed tables
observeEvent(input$dataframes, {
if (length(input$dataframes) > length(tables$df_tabset)) { # new dataframes are selected
new_dfs = setdiff(input$dataframes, tables$df_tabset)
for(df in new_dfs){
output[[df]] = renderDT(tables[[df]], editable = T, rownames = F, options = list(dom = "t")) # DOES NOT WORK AS EXPECTED IF THERE is > 1 NEW DF
appendTab(inputId = "df_tabset", select = TRUE,
tabPanel(title = df, value = df, DTOutput(outputId = df))
)
}
tables$df_tabset = input$dataframes # update
} else {
df = tables$df_tabset[! tables$df_tabset %in% input$dataframes]
removeTab(inputId = "df_tabset", target = df)
tables$df_tabset = input$dataframes
}
}, ignoreNULL = FALSE, ignoreInit = TRUE)
observeEvent(input$add_all, {
updateSelectizeInput(session, "dataframes", selected = c("iris", "mtcars", "DNase", "ChickWeight"))
})
}
shinyApp(ui = ui, server = server)
You have to use local (see here).
observeEvent(input$dataframes, {
if (length(input$dataframes) > length(tables$df_tabset)) { # new dataframes are selected
new_dfs = setdiff(input$dataframes, tables$df_tabset)
for(df in new_dfs){
local({
.df <- df
output[[.df]] = renderDT(tables[[.df]], editable = TRUE,
rownames = FALSE, options = list(dom = "t"))
})
appendTab(inputId = "df_tabset", select = TRUE,
tabPanel(title = df, value = df, DTOutput(outputId = df))
)
}
tables$df_tabset = input$dataframes # update
} else {
df = tables$df_tabset[! tables$df_tabset %in% input$dataframes]
removeTab(inputId = "df_tabset", target = df)
tables$df_tabset = input$dataframes
}
}, ignoreNULL = FALSE, ignoreInit = TRUE)
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()}
I'm building a R Shiny app with a dynamic datatable, using the DT package. Users are able to select two columns within a data.frame that contains more columns.
When users select a column, the datatable is updated and all filters/sorting are reset to default within the datatable object. How can I let the application remember filters and sorting when the given column is not replaced by the user?
Minimal working example below:
library(shiny)
library(DT)
library(data.table)
server <- function(input, output) {
df <- data.frame(
name = rep('a',20),
dimA = 1:20,
dimB = 21:40,
dimC = 41:60
)
observe({
columns <- c('name', input$dim1ID, input$dim2ID)
dfDt <- df[names(df) %in% columns]
output$dtDataTable = DT::renderDataTable(
server = FALSE,
expr = datatable(
dfDt,
filter = 'top',
rownames = FALSE,
selection = 'none',
options = list(sDom = '<"top">rt<"bottom">ip')
)
)
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
## Dimension 1
selectInput(
inputId = "dim1ID",
label = "Dimensie 1",
choices = c('dimA', 'dimB', 'dimC'),
selected = 'dimA'
),
## Dimension 2
selectInput(
inputId = "dim2ID",
label = "Dimensie 2",
choices = c('dimA', 'dimB', 'dimC'),
selected = 'dimB'
)
),
mainPanel(DT::dataTableOutput('dtDataTable'))
)
)
shinyApp(ui = ui, server = server)
This can be done using the DataTables Information, in particular the "state" information (input$tableId_state) which contains the order information of the current table, and input$tableId_search_columns which contains the filtering information by columns. If the columns are fixed (ie in the example above "Dimensie 1" and "Dimensie 2" would always be at the same place), it is much simpler to "remember" which one was ordered (unlike the original example where they are alphabetically reordered when the table is created). For instance based on the above example, the following will work if you sort the "A" column and change the right column from "B" to "C" and back:
library(shiny)
library(DT)
library(data.table)
server <- function(input, output) {
df <- data.frame(
name = rep('a',20),
dimA = 1:20,
dimB = 21:40,
dimC = 41:60
)
values <- reactiveValues(
prevDim1 = "",
prevDim2 = "",
options = list(sDom = '<"top">rt<"bottom">ip',
stateSave = TRUE,
order = list())
)
observeEvent(input$dtDataTable_state$order, {
values$options$order <- input$dtDataTable_state$order
})
observeEvent({
input$dim1ID
input$dim2ID
},{
columns <- c('name', input$dim1ID, input$dim2ID)
dfDt <- df[names(df) %in% columns]
if(length(values$options$order) != 0 && ((values$prevDim1 != input$dim1ID && values$options$order[[1]][[1]] == 1) | (values$prevDim2 != input$dim2ID && values$options$order[[1]][[1]] == 2)) ){
values$options$order = list()
}
values$prevDim1 <- input$dim1ID
values$prevDim2 <- input$dim2ID
output$dtDataTable = DT::renderDataTable(
server = FALSE,
expr = datatable(
dfDt,
filter = 'top',
rownames = FALSE,
selection = 'none',
options = values$options
)
)
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
## Dimension 1
selectInput(
inputId = "dim1ID",
label = "Dimensie 1",
choices = c('dimA', 'dimB', 'dimC'),
selected = 'dimA'
),
## Dimension 2
selectInput(
inputId = "dim2ID",
label = "Dimensie 2",
choices = c('dimA', 'dimB', 'dimC'),
selected = 'dimB'
)
),
mainPanel(DT::dataTableOutput('dtDataTable'))
)
)
shinyApp(ui = ui, server = server)