We have a situation where in we would want to take inputs from user in a datatable by creating dynamic drop-downs and would want to save the data locally. We have tried multiple combinations however these are not getting working in our scenario for e.g.: reset, refresh (can't use it as we have a login page). Below is the reproducible e.g.:
The problem with the code is that it takes old value not the updated one.
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/")),
numericInput('num', "enter a number", value = 5, min = 1, max = 10, step = 1),
DT::dataTableOutput('foo'),
verbatimTextOutput('sel'),
actionButton(
"saveBtn",
"Submit Request",
style = "color: #fff; background-color: #282364;
border-color: #2e6da4",
class = "btn btn-primary"
)
)
server <- function(input, output, session) {
data <- reactive({
df <- head(iris, input$num)
for (i in 1:nrow(df)) {
df$species_selector[i] <- as.character(selectInput(paste0("sel", i),
"",
choices = unique(iris$Species),
width = "100px"))
}
df
})
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)]]))
})
observeEvent(input$saveBtn, {
Test_Data <- sapply(1:nrow(data()), function(i) input[[paste0("sel", i)]])
Test_Data <- as.data.frame(Test_Data)
print(Test_Data)})
}
shinyApp(ui, server)
One solution could be creating dynamic ID's, however this can create complexity in our model as we have multiple drop-downs :
https://community.rstudio.com/t/update-dt-table-dropdowns-with-reactive-data-in-shiny/96100/2
You can execute JavaScript to periodically update selected values of dropdown menus:
e.g. JavaScript e.g. invoked by function shinyjs::runjs
document.getElementById("sel1").value = "versicolor"
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 really had trouble finding a title for this question, hope it helps.
I have a fairly complex app for which I'm having trouble resetting an output after an actionButton ("Confirm" on this example) triggers the re-evaluation of a reactiveValues number that feeds a reactive table.
This causes that the selected table only renders once and no matter how many times the table that feeds it changes, it keeps showing the same result as the first time it was rendered.
It will be easy for you to see what I mean from this example. Believe me, it is the minimax from the one I'm coming from:
library(shiny)
library(DT)
ui <- fluidPage(
DTOutput("table"),
actionButton("checkvalues", "Check")
)
server <- function(input, output, session) {
primedata <- reactiveValues(data = NULL)
primedata$data <- as.numeric(Sys.time()) %% 10000
tabledata <- reactive({
data <- data.frame(rep(primedata$data, 5))
for (i in 1:5) {
data$V1[i] <- as.character(selectInput(paste0("sel", i), "",
choices = c("None selected" = 0,
"Icecream", "Donut"),
selected = 0, width = "120px"))
}
return(data)
})
output$table <- renderDataTable( #Generar tabla
tabledata(), filter = 'top', escape = FALSE, selection = 'none', server = 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());")
)
# helper function for reading inputs in DT
shinyValue = function(id, len) {
unlist(lapply(seq_len(len), function(i) {
value = input[[paste0(id, i)]]
if (is.null(value)) NA else value
}))
}
observeEvent(input$checkvalues, {
datos <- tabledata()
selected <- cbind(datos, data.frame(N = shinyValue("sel", nrow(datos))))
selected <- selected %>% group_by(N) %>% summarise("see" = n())
showModal(modalDialog(
title = HTML('<h3 style="text-align:center;">Problem: this table will keep showing the same results as the first one presented</h3>'),
renderDT(datatable(selected, options = list(dom = 't', ordering = F))),
footer = actionButton("Confirm", "Confirm")))
})
observeEvent(input$Confirm, {
primedata$data <- as.numeric(Sys.time()) %% 10000
removeModal()
})
}
shinyApp(ui, server)
When you change primedata$data (by clicking on the Confirm button) this re-renders the table, and you have to unbind before:
ui <- fluidPage(
tags$head(tags$script(
HTML(
"Shiny.addCustomMessageHandler('unbindDT', function(id) {
var $table = $('#'+id).find('table');
if($table.length > 0){
Shiny.unbindAll($table.DataTable().table().node());
}
})")
)),
DTOutput("table"),
actionButton("checkvalues", "Check")
)
observeEvent(input$Confirm, {
session$sendCustomMessage("unbindDT", "table")
primedata$data <- as.numeric(Sys.time()) %% 10000
removeModal()
})
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 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 want users of my Shiny app to fill in the values of a 2x2 table with row and column names. Of course, I could do it with 4 input boxes, but I assume that it will be tricky to position everything neatly. Despite that, I would prefer a table layout such as the one provided by the DT package. Thus, my question is: Is it possible to have a datatable (or something similar) filled by the user?
You can use shinysky
devtools::install_github("AnalytixWare/ShinySky") package
or rhandsontable to do what you want:
rm(list = ls())
library(shiny)
library(shinysky)
server <- shinyServer(function(input, output, session) {
# Initiate your table
previous <- reactive({mtcars[1:10,]})
MyChanges <- reactive({
if(is.null(input$hotable1)){return(previous())}
else if(!identical(previous(),input$hotable1)){
# hot.to.df function will convert your updated table into the dataframe
as.data.frame(hot.to.df(input$hotable1))
}
})
output$hotable1 <- renderHotable({MyChanges()}, readOnly = F)
output$tbl = DT::renderDataTable(MyChanges())
})
ui <- basicPage(mainPanel(column(6,hotable("hotable1")),column(6,DT::dataTableOutput('tbl'))))
shinyApp(ui, server)
A solution with DT:
library(DT)
library(shiny)
dat <- data.frame(
V1 = c(as.character(numericInput("x11", "", 0)), as.character(numericInput("x21", "", 0))),
V2 = c(as.character(numericInput("x21", "", 0)), as.character(numericInput("x22", "", 0)))
)
ui <- fluidPage(
fluidRow(
column(5, DT::dataTableOutput('my_table')),
column(2),
column(5, verbatimTextOutput("test"))
)
)
server <- function(input, output, session) {
output$my_table <- DT::renderDataTable(
dat, selection = "none",
options = list(searching = FALSE, paging=FALSE, ordering=FALSE, dom="t"),
server = FALSE, escape = FALSE, rownames= FALSE, colnames=c("", ""),
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$test <- renderText({
as.character(input$x11)
})
}
shinyApp(ui, server)