How to have table in Shiny filled by user? - r

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)

Related

DT with Shiny: Multipage editable DataTable jumps to first page after an edit

I have the following program. As the title suggests, every time I edit an item on pages after the first page the table goes back to the first page. I'd like the table to stay on the page I'm editing without jumping back to the first page.
I've seen this problem on other threads here but their solutions don't seem to work with current version of DT and shiny packages.
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
DTOutput('x1'),
verbatimTextOutput("print")
),
server = function(input, output, session) {
x = reactiveValues(df = NULL)
observe({
df <- iris
df$Date = Sys.time() + seq_len(nrow(df))
x$df <- df
})
output$x1 = renderDT(x$df, selection = 'none', editable = TRUE)
proxy = dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
x$df[i, j] <- isolate(DT::coerceValue(v, x$df[i, j]))
})
output$print <- renderPrint({
x$df
})
}
)
Any help would be appreciated
You can do like this:
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
DTOutput('x1'),
verbatimTextOutput("print")
),
server = function(input, output, session) {
dat <- reactiveVal(cbind(iris, Date = Sys.time() + seq_len(nrow(iris))))
output$x1 = renderDT(isolate(dat()), selection = 'none', editable = TRUE)
proxy = dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
dat(editData(dat(), info, proxy, resetPaging = FALSE))
})
output$print <- renderPrint({
dat()
})
}
)
Please see DT-edit. I have copied the 2 relevant examples below:
library(shiny)
library(DT)
dt_output = function(title, id) {
fluidRow(column(
12, h1(paste0('Table ', sub('.*?([0-9]+)$', '\\1', id), ': ', title)),
hr(), DTOutput(id)
))
}
render_dt = function(data, editable = 'cell', server = TRUE, ...) {
renderDT(data, selection = 'none', server = server, editable = editable, ...)
}
shinyApp(
ui = fluidPage(
title = 'Double-click to edit table cells',
dt_output('client-side processing (editable = "cell")', 'x1'),
dt_output('server-side processing (editable = "cell")', 'x5')
),
server = function(input, output, session) {
d1 = iris
d1$Date = Sys.time() + seq_len(nrow(d1))
d5 = d1
options(DT.options = list(pageLength = 5))
# client-side processing
output$x1 = render_dt(d1, 'cell', FALSE)
observe(str(input$x1_cell_edit))
# server-side processing
output$x5 = render_dt(d5, 'cell')
# edit a single cell
proxy5 = dataTableProxy('x5')
observeEvent(input$x5_cell_edit, {
info = input$x5_cell_edit
str(info) # check what info looks like (a data frame of 3 columns)
d5 <<- editData(d5, info)
replaceData(proxy5, d5, resetPaging = FALSE) # important
# the above steps can be merged into a single editData() call; see examples below
})
}
)
I am not sure why you seem to be unnecessarily complicating the process with your reactiveValues but that is probably the cause of your table needing to refresh back to the first page.

How to replaceData in DT rendered in R shiny using the datatable function

I have an R shiny app with a DT datatable that is rendered using the datatable function in order to set various options. I would like to use dataTableProxy and replaceData to update the data in the table, but all the examples I can find assume the DT is rendered directly from the data object, not using the datatable function. The reprex below shows what I would like to do, but replaceData doesn't work in this pattern. How do I do this? Thanks.
# based on
# https://community.rstudio.com/t/reorder-data-table-with-seleceted-rows-first/4254
library(shiny)
library(DT)
ui = fluidPage(
actionButton("button1", "Randomize"),
fluidRow(
column(6,
h4("Works"),
DT::dataTableOutput('table1', width="90%")),
column(6,
h4("Doesn't Work"),
DT::dataTableOutput('table2', width="90%"))
)
)
server = function(input, output, session) {
my <- reactiveValues(data = iris)
output$table1 <- DT::renderDataTable(isolate(my$data))
output$table2 <- DT::renderDataTable({
DT::datatable(isolate(my$data),
options = list(lengthChange=FALSE, ordering=FALSE, searching=FALSE,
columnDefs=list(list(className='dt-center', targets="_all")),
stateSave=TRUE, info=FALSE),
class = "nowrap cell-border hover stripe",
rownames = FALSE,
editable = FALSE
) %>%
DT::formatStyle('Sepal.Width', `text-align`="center")
})
observeEvent(input$button1, {
# calculate new row order
row_order <- sample(1:nrow(my$data))
my$data <- my$data[row_order, ]
proxy1 <- DT::dataTableProxy('table1')
DT::replaceData(proxy1, my$data)
proxy2 <- DT::dataTableProxy('table2')
DT::replaceData(proxy2, my$data)
})
}
shinyApp(ui, server)
Update: Very strangely, removing rownames = FALSE made it all possible. I'm not exactly sure why, but probably rownames might be essential for replacing Data.
# based on
# https://community.rstudio.com/t/reorder-data-table-with-seleceted-rows-first/4254
library(shiny)
library(DT)
ui = fluidPage(
actionButton("button1", "Randomize"),
fluidRow(
column(6,
h4("Works"),
DT::dataTableOutput('table1', width="90%")),
column(6,
h4("Doesn't Work"),
DT::dataTableOutput('table2', width="90%"))
)
)
server = function(input, output, session) {
my <- reactiveValues(data = iris)
output$table1 <- DT::renderDataTable(isolate(my$data))
output$table2 <- DT::renderDataTable({
DT::datatable(isolate(my$data),
options = list(lengthChange=FALSE, ordering=FALSE, searching=FALSE,
columnDefs=list(list(className='dt-center', targets="_all")),
stateSave=TRUE, info=FALSE),
class = "nowrap cell-border hover stripe",
# rownames = FALSE,
editable = FALSE
) %>%
DT::formatStyle('Sepal.Width', `text-align`="center")
})
observeEvent(input$button1, {
# calculate new row order
row_order <- sample(1:nrow(my$data))
my$data <- my$data[row_order, ]
proxy1 <- DT::dataTableProxy('table1')
DT::replaceData(proxy1, my$data)
proxy2 <- DT::dataTableProxy('table2')
DT::replaceData(proxy2, my$data)
})
}
shinyApp(ui, server)

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:

User input in DataTable used for recalculation and update of column in Shiny

I want to create a web app, which allows user to enter input in numericInput object, which is embedded in DataTable and recalculates result (multiplication of column with some static values and a user input column) in another column.
I believe that when I set a reactive function which wraps around merging dataset and user input column and later I call it from RenderDataTable, that I somehow break the reactivity and I don't have a clue how to keep reactivity within table dependent on user input (which is also in the table). Please help.
Reproducible example to where I am stuck:
library(shiny)
library(DT)
set.seed(21)
db <- data.frame(ent = rep(x = 1,5),
group = c("G","M","O","F","L"),
val = sample(1:100, 5, replace=TRUE))
ui <- fluidPage(
titlePanel(paste0("entity - ", unique(db$ent))),
sidebarLayout(
sidebarPanel(
helpText("Shiny app calculation")
),
mainPanel(
DT::dataTableOutput("table")
))
)
numericText <- function(FUN, id_nums, id_base, label, value, ...) {
inputs <- 1:length(id_nums)
for (i in 1:length(inputs)) {
inputs[i] <- as.character(FUN(paste0(id_base,
id_nums[i]), label, value, ...))
}
return(inputs)
}
inputs <- numericText(numericInput,
id_nums = as.character(1:5),
id_base = "input_",
label = NULL,
value = 0)
db <- data.frame(db,
num = inputs)
server <- function(input, output, session) {
shinyValue = function(id, len) {
unlist(lapply(seq_len(len), function(i) {
value = input[[paste0(id, i)]]
if (is.null(value)) NA else value
}))
}
output_table <- reactive({
data.frame(db, calc = shinyValue("input_", 5))
})
output$table <- renderDataTable({
datatable(output_table(), rownames = FALSE, escape = FALSE, selection
= 'none', options = list(paging = FALSE, ordering = FALSE, searching
= FALSE, preDrawCallback = JS('function() {
Shiny.unbindAll(this.api().table().node()); }'), drawCallback =
JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
})
}
shinyApp(ui = ui, server = server)
Also maybe it helps - I was able to do this if I remove reactive expression from the dataframe and if I write result in another output type(however this is not a solution, since my main purpose is to write it in another column in DataTable):
library(shiny)
library(DT)
set.seed(21)
db <- data.frame(ent = rep(x = 1,5),
group = c("G","M","O","F","L"),
val = sample(1:100, 5, replace=TRUE))
ui <- fluidPage(
titlePanel(paste0("entity - ", unique(db$ent))),
sidebarLayout(
sidebarPanel(
helpText("Shiny app calculation")
),
mainPanel(
DT::dataTableOutput("table"),
verbatimTextOutput("text")
))
)
numericText <- function(FUN, id_nums, id_base, label, value, ...) {
inputs <- 1:length(id_nums)
for (i in 1:length(inputs)) {
inputs[i] <- as.character(FUN(paste0(id_base,
id_nums[i]), label, value, ...))
}
return(inputs)
}
inputs <- numericText(numericInput,
id_nums = as.character(1:5),
id_base = "input_",
label = NULL,
value = 0)
db <- data.frame(db,
num = inputs)
server <- function(input, output, session) {
shinyValue = function(id, len) {
unlist(lapply(seq_len(len), function(i) {
value = input[[paste0(id, i)]]
if (is.null(value)) NA else value
}))
}
output_table <- db
output$table <- renderDataTable({
datatable(output_table, rownames = FALSE, escape = FALSE, selection
= 'none', options = list(paging = FALSE, ordering = FALSE, searching
= FALSE, preDrawCallback = JS('function() {
Shiny.unbindAll(this.api().table().node()); }'), drawCallback =
JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
})
}
output$text <- reactive({shinyValue("input_", 5) * db$val
})
shinyApp(ui = ui, server = server)
I couldn't fully understand your code so I've myself produced another reproducible example based on a bunch of other answers especially this one.
library(shiny)
library(data.table)
library(rhandsontable)
DF = data.frame(num = 1:10, qty = rep(0,10), total = 1:10,
stringsAsFactors = FALSE)
#DF = rbind(DF, c(0,0,0))
ui = fluidPage(
titlePanel("Reactive Table "),
fluidRow(box(rHandsontableOutput("table", height = 400)))
)
server = function(input, output) {
data <- reactiveValues(df=DF)
observe({
input$recalc
data$df <- as.data.frame(DF)
})
observe({
if(!is.null(input$table))
data$df <- hot_to_r(input$table)
})
output$table <- renderRHandsontable({
rhandsontable(data$df)
})
output$table <- renderRHandsontable({
data$df$total <- data$df$num * data$df$qty
print(sum(data$df$num*data$df$price) )
rhandsontable(data$df, selectCallback = TRUE)
})
}
shinyApp(ui, server)
The very first idea is to use rhandsontable which is specifically for this kind of purpose.

use rhandsontable package to edit multiple data frame on shiny

I am new to the shiny, I would like to edit different multiple data frames by radio button or selectinput by using rhandsontable package. However, my script can not show other data frame but only the first one, I don't know what is the problem.
ui.R:
library(rhandsontable)
fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("select2", label = h3("Choose to edit"),
choices = list("003.csv", "004.csv", "005.csv",
"006.csv", "007.csv"),
selected = "003.csv"),
actionButton("saveBtn", "Save changes")
),
mainPanel(
rHandsontableOutput("hot")
)))
server.R
values <- reactiveValues()
setHot <- function(x) values[["hot"]] <<- x
function(input, output, session) {
fname <- reactive({
x <- input$select2
return(x)
})
observe({
input$saveBtn # update csv file each time the button is pressed
if (!is.null(values[["hot"]])) {
write.csv(x = values[["hot"]], file = fname(), row.names = FALSE)
}
})
output$hot <- renderRHandsontable({
if (!is.null(input$hot)) { # if there is an rhot user input...
DF <- hot_to_r(input$hot) # convert rhandsontable data to R object
and store in data frame
setHot(DF) # set the rhandsontable values
} else {
DF <- read.csv(fname(), stringsAsFactors = FALSE) # else pull table from the csv (default)
setHot(DF) # set the rhandsontable values
}
rhandsontable(DF) %>% # actual rhandsontable object
hot_table(highlightCol = TRUE, highlightRow = TRUE, readOnly = TRUE) %>%
hot_col("Status", readOnly = FALSE)
})}
I can edit and save the dataframe that it shows the first one 003.csv, however when i use the drop down list to 004.csv, it didn't show the dataframe. please advise.
This will write (and possibly overwrite ⚠ any existing file with) dummy data:
for (i in c("003.csv", "004.csv", "005.csv", "006.csv", "007.csv")) {
write.csv(cbind(V1 = rep(i, 3), Status = "foo"), i, row.names = FALSE)
}
I overhauled server a bit:
library(shiny)
library(rhandsontable)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(
"select2", label = h3("Choose to edit"), selected = "003.csv",
choices = list("003.csv", "004.csv", "005.csv", "006.csv", "007.csv")
),
actionButton("saveBtn", "Save changes")
),
mainPanel(
rHandsontableOutput("hot")
)
)
)
server <- function(input, output, session) {
DF <- reactiveVal()
observe({
DF(read.csv(input$select2, stringsAsFactors = FALSE))
})
observe({
if (!is.null(input$hot)) DF(hot_to_r(input$hot))
})
observeEvent(input$saveBtn, {
if (!is.null(DF())) write.csv(DF(), input$select2, row.names = FALSE)
})
output$hot <- renderRHandsontable({
rhandsontable(DF()) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE, readOnly = TRUE) %>%
hot_col("Status", readOnly = FALSE)
})
}
shinyApp(ui, server)

Resources