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:
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.
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"
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]]))
})
}
)
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 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)