R Shiny - Cannot retrieve value of input control created inside DT Table - r

I was following this example from DT's official page to create input controls inside a DT table. I created something similar but I also needed an editable table. Due to which, I need to set server = TRUE in renderDT (Realized after RTFM that reloadData requires server = TRUE). So now I tried following this example of rendering checkbox input inside DT table but with server = TRUE. The issue is that now I am not able to fetch the values of input controls on server-side, which worked fine when server = FALSE. Can any one tell me how to retrieve the control values on the server side in this setup.
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
title = 'Radio buttons in a table',
DT::dataTableOutput('foo'),
verbatimTextOutput('sel')
),
server = function(input, output, session) {
m = matrix(
as.character(1:5), nrow = 12, ncol = 5, byrow = TRUE,
dimnames = list(month.abb, LETTERS[1:5])
)
for (i in seq_len(nrow(m))) {
m[i, ] = sprintf(
'<input type="radio" name="%s" value="%s"/>',
month.abb[i], m[i, ]
)
}
m
output$foo = DT::renderDataTable(
m, escape = FALSE, selection = 'none', server = TRUE,
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-radiogroup');
});
Shiny.unbindAll(table.table().node());
Shiny.bindAll(table.table().node());")
)
output$sel = renderPrint({
str(sapply(month.abb, function(i) input[[i]]))
})
}
)

Related

How to reset selected rows in Shiny

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.

R shiny : How to get the callback value from DT::renderDataTable?

I made a select table with button in R shiny.
I want to add a submit actionButton to get the select value from DT::renderDataTable though observeEvent() function.
I have tried
observeEvent(input$submit,{
data <- data.frame(output$sel)}
This is not work.
Is it possible to get the value of callback?
The value can been see in the UI, but how can i get in server?
library(shiny)
library(DT)
library(googlesheets4)
c1 <-c("Time in free flow (mins)",
"Time slowed down by other traffic (mins)",
"Percentage of total time spent with other vehicles close behind",
"Curviness",
"Running costs",
"Toll cost")
c2 <- c('50','10','25%','Moderate','$12.00','$0.00')
c3 <- c('38','5','31%','extreame','$10.50','$3.00')
c4 <- c('62','8','19%','Almost straight','$9.00','$0.50')
c5 <- c('56','15','12%','Moderate','$13.50','$0.00')
t <- cbind(c1,c2,c3,c4,c5)
shinyApp(
ui = fluidPage(
title = 'Radio buttons in a table',
DT::dataTableOutput('foo'),
#tt <- textOutput('sel'),
textOutput('sel'),
actionButton("submit", "submit")
),
server = function(input, output, session) {
m = matrix(
as.character(1:4), nrow = 1, ncol = 4, byrow = TRUE,
dimnames = list(' ', LETTERS[1:4])
)
for (i in seq_len(nrow(m))) {
m[i, ] = sprintf(
'<input type="radio" name="%s" value="%s"/>',
' ', m[i, ]
)
}
m <- cbind('Chioce',m)
m<-rbind(t,m)
output$foo = DT::renderDataTable(
m, 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-radiogroup');
});
Shiny.unbindAll(table.table().node());
Shiny.bindAll(table.table().node());")
)
output$sel = renderPrint({
str(sapply(' ', function(i) input[[i]]))
})
observeEvent(input$submit,{
})})
You can get the selected row indices (and work forward from there) like this:
ui <- fluidPage(
verbatimTextOutput('log'),
DTOutput('myTable')
)
server <- function(input, output) {
output$myTable <- renderDataTable(iris)
output$log <- renderPrint({
row_indices <- input$myTable_rows_selected
iris[row_indices,]
})
}
shinyApp(ui, server)
edit
You can set server input values via client side javascript.
In your case:
## [...]
for (i in seq_len(nrow(m))) {
m[i, ] = sprintf(
'<input type="radio" name="%s" value="%s"
// set input$selected to m[i,] when clicked:
onClick = "Shiny.setInputValue(\'selected\', %s)" />',
' ', m[i, ], m[i,]
)
}
## now input$selected will be updated upon selection of either radio input
## [...]
see: https://shiny.rstudio.com/articles/communicating-with-js.html

Unable to print updated values in Reactive inputs using Shiny

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"

render dropdown for single column in DT shiny

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:

Extracting values of selected radio buttons in shiny DT

Background : I have a shiny DT in a modaldialog box conataining radio buttons in columns, I want to do some processing based on the selections of radio button in DT
Problem : I am unable to figure out how to extract the value of the selected radiobutton from DT
Below is the reproducible exmaple for the same.
library(shiny)
library(DT)
library(data.table)
library(shinyWidgets)
shinyApp(
ui = fluidPage(
title = 'Radio buttons in a table',
actionBttn(inputId = "btnContinue",label = "Continue",style = "material-flat")
),
server = function(input, output, session) {
dtWithRadioButton <- reactiveValues(dt = NULL)
observeEvent(input$btnContinue,{
m = matrix(
as.character(1:5), nrow = 12, ncol = 5, byrow = TRUE,
dimnames = list(month.abb, LETTERS[1:5])
)
for (i in seq_len(nrow(m))) {
m[i, ] = sprintf(
'<input type="radio" name="%s" value="%s"/>',
month.abb[i], m[i, ]
)
}
dt <- data.table(m)
v <- LETTERS[1:12]
dt <- cbind(v,dt)
dtWithRadioButton$dt <- dt # setting reactive value
showModal(modalDialog(
size = "l",easyClose = F,fade = T,
renderDataTable(datatable(dt, selection = "none",escape = FALSE, options = list(dom = 't') , rownames = F)),
footer = tagList(
actionBttn(inputId = "btnCancel",label = "Cancel",style = "float",size="sm",color="warning"),
actionBttn(inputId = "btnProcess",label = "Process",style = "float",size="sm",color="success")
)
))
})
observeEvent(input$btnProcess,{
dt <- dtWithRadioButton$dt # accessing the reactive value
# do some processing based on the radio button selection
})
observeEvent(input$btnCancel,{
removeModal(session)
})
}
)
On click of 'Continue' button a pop-up containing a shiny DT with radio button is displayed to user. Once user makes selection using radio button. I want to run a process on click of btnProcess
You can do:
library(shiny)
library(DT)
library(shinyWidgets)
m <- matrix(
as.character(1:5), nrow = 12, ncol = 5, byrow = TRUE,
dimnames = list(month.abb, LETTERS[1:5])
)
for (i in seq_len(nrow(m))) {
for(j in seq_len(ncol(m))) {
m[i, j] <- sprintf(
'<input type="radio" name="%s" value="%s" %s/>',
month.abb[i], m[i, j], ifelse(j==1, 'checked="checked"', "")
)
}
}
shinyApp(
ui = fluidPage(
title = 'Radio buttons in a table',
actionBttn(inputId = "btnContinue", label = "Continue",
style = "material-flat")
),
server = function(input, output, session) {
dtWithRadioButton <- reactiveValues(dt = m)
observeEvent(input$btnContinue,{
showModal(modalDialog(
size = "l", easyClose = FALSE, fade = TRUE,
DTOutput("datatable"),
footer = tagList(
actionBttn(inputId = "btnCancel", label = "Cancel",
style = "float", size="sm", color="warning"),
actionBttn(inputId = "btnProcess", label = "Process",
style = "float", size="sm", color="success")
)
))
})
output$datatable <- renderDT(
datatable(dtWithRadioButton$dt, selection = "none", escape = 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-radiogroup');
});
Shiny.unbindAll(table.table().node());
Shiny.bindAll(table.table().node());"),
rownames = TRUE),
server = FALSE
)
observeEvent(input$btnProcess,{
dt <- dtWithRadioButton$dt # accessing the reactive value
# do some processing based on the radio button selection
for(month in month.abb){
print(paste0(month, ": ", input[[month]]))
}
})
observeEvent(input$btnCancel,{
removeModal(session)
})
}
)
Then the value of the selected button is in input$Jan for the first row, input$Feb for the second row, etc.

Resources