R shiny and R session environment [duplicate] - r

I'm writing a shiny app that has a table (using DT::renderDataTable) from which users can select a row. But I want the user to also be able to add new row(s) if what they want is not already in the table. I'm using input controls for the user to enter new data, and I have an action button which, if pressed, should create a new row of data in the table from the input values. But pressing the button does not update the table.
A minimal example:
library(shiny)
library(DT)
mydata = data.frame(id=letters[1:5], val=sample(10,5,T))
ui = fluidPage(dataTableOutput("table"),
textInput('NewID', 'Enter new ID'),
numericInput('NewVal', 'Enter new val', 1),
actionButton("goButton", "Update Table"))
server = function(input,output){
output$table = renderDataTable(mydata)
update = eventReactive(input$goButton, {
newrow = data.frame(id = input$NewID, val = input$NewVal)
mydata = rbind(mydata, newrow)
})
}
shinyApp(ui,server)
Clearly, this is the wrong way to approach this. I've tried various combinations of wrapping both renderDataTable and the code to update mydata inside renderUI, observe and reactive, but I can't find the right way to do this.
This is my first shiny app, so maybe there is a basic concept that I'm not quite grasping. What is the right way?

You can render the result of eventReactive, where you return the updated dataset. Don't forget to use <<- to modify the global dataset as well:
server = function(input,output){
output$table <- renderDataTable( df())
df <- eventReactive(input$goButton, {
if(input$NewID!="" && !is.null(input$NewVal) && input$goButton>0){
newrow = data.table(id = input$NewID,
val = input$NewVal)
mydata <<- rbind(mydata, newrow)
}
mydata
}, ignoreNULL = FALSE)
}

You should use replaceData() function from package DT. Example:
...
dataTableOutput("OPreview"),
actionButton("BRefresh","Refresh"),
...
in server part(assuming ds is a dataset to show):
output$OPreview<-renderDataTable({ ds })
onclick("BRefresh",{
proxy=dataTableProxy("OPreview")
replaceData(proxy,ds)
})

Related

Reset Button in R shiny (reload R environment)

I'm new to R shiny and I'm building a R shiny app that allows users to update values on a matrixInput. When that values are change the app update my datasets with the new information. I would like to have a button ("Reset Button") that allows to show the matrix with the values ​​in their original form (ie with my original dataset when it opens for the first time in the app), but i would like to do that without close/open the app.
this is part of the code:
library(shiny)
library(shinyjs)
library(data.table)
ui:
shinyUI(pageWithSidebar(
headerPanel("title"),
sidebarPanel(conditionalPanel(condition="input.tabselected==1",
selectInput("equip_input", "Equip", choices=c("Total", equip_order)),
matrixInput("matrix_aux",
value = matrix_aux,
cols = list(names = TRUE)),
useShinyjs(),
actionButton("action_simulation", "Simulation"),
actionButton("reset_button","Reset")))))
And in the server i tried to "reload" my R environment, that's where i have the datasets without changes:
shinyServer(function(input,output, session)({
var_aux1 <- reactive({
table_input = as.matrix(input$matrix_aux)
var_aux1 = table_input[,2]
return (var_aux1)})
var_aux2 <- reactive({
table_input = as.matrix(input$matrix_aux)
var_aux2 = table_input[,3]
return (var_aux2) })
var_aux3 <- reactive({
table_input = as.matrix(input$matrix_aux)
var_aux3 = table_input[,4]
return (var_aux3)})
observeEvent(input$action_simulation, {
var_aux1 <- as.numeric(var_aux1())
var_aux2<- as.numeric(var_aux2())
var_aux3 <- as.numeric(var_aux3())
v1[(v1$Equip == as.character(input$equip_input),]$var1 <<- var_aux1
v1[(v1$Equip == as.character(input$equip_input),]$var2 <<- var_aux2
v1[(v1$Equip == as.character(input$equip_input),]$var3 <<- var_aux3
}
#this button doesn't do what i want
observeEvent(input$reset_button, {
rm(list=ls())
load("mydata") })}))
But it doesn't work. How can I do it??
Example:
When the user change the values in the matrix, the app updates my datasets with the new values:
observeEvent(input$action_simulation, {
v1[(v1$Equip == as.character(input$equip_input),]$var1 <<- var_aux1
v1[(v1$Equip == as.character(input$equip_input),]$var2 <<- var_aux2
v1[(v1$Equip == as.character(input$equip_input),]$var3 <<- var_aux3
}})
And I would like to have a option to make reset to the original values without changes

Is there a way to just read an edited DT?

I'm trying to make an app where users can edit some tables and run a calculation, and using DT. Is there a way to just read in what's currently in a DT table? This would simplify things a lot for me. All the solutions I've been able to find involve detecting when the table is edited, and then updating the data accordingly. This seems clunky and also might cause problems for my use case later.
Here's an example: after editing the data zTable, I'd like something that just returns what is now in zTable after clicking the calculate button aside from just watching every edit and updating z$data.
library(shiny)
library(DT)
ui <- fluidPage(
DT::dataTableOutput("zTable"),
actionButton("calcButton","Calculate!")
)
server <- function(input, output) {
z<-reactiveValues(data={data.frame(x=c(0,1),
y=c(0,1))
})
output$zTable <- DT::renderDT(z$data,editable=T)
observeEvent(input$calcButton,{
print(z$data)
})
observeEvent(input$zTable_cell_edit, {
info = input$zTable_cell_edit
z$data[as.numeric(info$row),as.numeric(info$col)] <- as.numeric(info$value)
})
}
shinyApp(ui = ui, server = server)
You can do as follows. There's a problem with the current version of DT: when you edit a numeric cell, the new value is stored as a string instead of a number. I've just done a pull request which fixes this issue. With the next version of DT the .map(Number) in the JavaScript callback will not be needed anymore. If you are ok to adopt my solution, tell me if you want to use it with non-numeric cells, and I'll have to improve the code in order to handle this situation. Or you can install my fork of DT in which I fixed the issue: remotes::install_github("stla/DT#numericvalue").
library(shiny)
library(DT)
callback <- c(
'$("#show").on("click", function(){',
' var headers = Array.from(table.columns().header()).map(x => x.innerText);',
' var arrayOfColumns = Array.from(table.columns().data());',
' var rownames = arrayOfColumns[0]',
' headers.shift(); arrayOfColumns.shift();',
' var entries = headers.map((h, i) => [h, arrayOfColumns[i].map(Number)]);',
' var columns = Object.fromEntries(entries);',
' Shiny.setInputValue(',
' "tabledata", {rownames: rownames, columns: columns}, {priority: "event"}',
' );',
'});'
)
ui <- fluidPage(
br(),
DTOutput("dtable"),
br(),
tags$h3("Edit a cell and click"),
actionButton("show", "Print data")
)
server <- function(input, output) {
dat <- data.frame(x=c(0,1),
y=c(0,1))
output[["dtable"]] <- renderDT({
datatable(
dat,
editable = TRUE,
callback = JS(callback)
)
}, server = FALSE)
observeEvent(input[["tabledata"]], {
columns <- lapply(input[["tabledata"]][["columns"]], unlist)
df <- as.data.frame(columns)
rownames(df) <- input[["tabledata"]][["rownames"]]
print(df)
})
}
shinyApp(ui = ui, server = server)
You can rely on JavaScript to get the data via the DataTable api:
library(shiny)
library(DT)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
DT::dataTableOutput("zTable"),
actionButton("calcButton","Calculate!")
)
server <- function(input, output) {
z <- reactiveValues(data = data.frame(x = 0:1, y = 0:1))
output$zTable <- renderDT(z$data, editable = TRUE)
observeEvent(input$calcButton, {
runjs('Shiny.setInputValue("mydata", $("#zTable table").DataTable().rows().data())')
})
observeEvent(input$mydata, {
dat <- req(input$mydata)
## remove chunk from .data()
dat[c("length", "selector", "ajax", "context")] <- NULL
print(do.call(rbind, dat))
})
}
shinyApp(ui = ui, server = server)
However, as you need to some data wrangling to back-transfrom the data, I am not sure whether this is eventually such a good idea.
What is your general issue with the _cell_edit approach? (which I would prefer because no need to additional data wrangling other than storing it in the right spot?

How to make a DT datatable row selection sticky in an R Shiny app

The rows in a table may dynamically change, but existing row selections by a user should remain. Selected rows are stored by their row index, so when a new datatable() is rendered, how do you retain the selected rows?
There are two parts to the solution. First the selection parameter in datatable() can take a list of the form list(mode='multiple', selected=c(1,3))
The second part is to determine what selected rows remain in the new table.
One solution to the second part is to store a copy of the datatable as a session variable. When a new datatable is generated, the old table is compared with the new. A new set of selected row indices is computed based on the common rows in the old and new tables. The row indices into the new table are found by using a which(newkeys %in% oldkeys) idiom.
Here's an example:
library(shiny)
ui <- fluidPage(
checkboxInput('yellow.only', 'Yellow Only'),
uiOutput('fruit.selection'),
DT::dataTableOutput("dt.fruit.selection")
)
server <- function(input, output) {
fruit.options <- reactive({
all.fruits <- c(grape='Grape', banana='Banana', papaya='Papaya', raspberry='Raspberry')
yellow.fruits <- c(FALSE, TRUE, TRUE, FALSE)
all.fruits[yellow.fruits | !input$yellow.only]
})
fruit.options.df <- reactive({
data.frame(fruits=fruit.options(), some.other.col=nchar(fruit.options()))
})
output$fruit.selection <- renderUI({ selectInput('fruit', 'Fruit', choices=fruit.options(), selected=input$fruit, multiple=TRUE, selectize=FALSE, size=length(fruit.options())) })
output$dt.fruit.selection <- DT::renderDataTable({
if (!exists('fruit.options.cache') || identical(fruit.options.cache, fruit.options.df())) {
rows.selected <- isolate(input$dt.fruit.selection_rows_selected)
} else {
rows.selected <- which(fruit.options.df()$fruit %in% fruit.options.cache$fruits[isolate(input$dt.fruit.selection_rows_selected)])
}
fruit.options.cache <<- fruit.options.df()
DT::datatable(fruit.options.cache, rownames=FALSE, selection=list(mode="multiple", selected=rows.selected))
})
}
# Run the application
shinyApp(ui = ui, server = server)
This can also be run from RStudio with shiny::runGist("https://gist.github.com/dkulp2/7ebb1c936d08f3434127e58d7798af28")

Updating state of DT and extracting data from DT using State in shiny R

DT package provides the ability to save the state of a table with filters, searching and everything. I can see the content of that state(input$TableId_state) on text output. But I can't use it in any proper way. I want to do two things:
Saving a state of DT at any time, and apply it to same DT with an action button. (I want to have full data but with filters and text in search box) .
Extracting data from output table into another data table inside server function (not as output table)
I can do 2. bullet by using input$tableId_rows_all . But I need to be able to do that with the state.
In my opinion, if any of these are not possible than state function is useless and just to show off.
Here is my trial to do 2. bullet:
library(shiny)
library(DT)
data <- iris
ui <- fluidPage(
actionButton(inputId = "action", label = "Apply",icon=
icon("refresh",lib="font-awesome"),style="background-
color:#FBAF16",width =validateCssUnit(385)),
fluidRow(DT::dataTableOutput(outputId =
"Table")),hr(),fluidRow(DT::dataTableOutput(outputId = "FilteredTable"))
)
server <- function(input,output,session){
output$Table<-DT::renderDataTable(expr = {
DT::datatable(data,option = list(stateSave =
TRUE),filter=list(position="top",clear=TRUE))
})
filtereddata <- eventReactive(input$action,{
return(DT::datatable(data
,options = list(state=input$Table_state)
))
})
output$FilteredTable<- DT::renderDataTable(expr = {
return(filtereddata())
})
}
runApp(list(ui = ui, server = server),host="127.0.0.2",port=5013, launch.browser = TRUE)

Update data in shiny application without refreshing the whole application

I have an application for real time data visualization build with R shiny library. I do periodic data reload from file using reactivePoll function. What I do not like about this is that whenever data reloads the whole application refreshes.
So for example if I have DT table output with selection and I use this selection input$table_rows_selected it resets to NULL whenever data reloads which is not user-friendly at all.
Is it overall possible to change data output without interrupting user?
UPDATE.
Can this be achieved with any other package for displaying tables - googleVis or other?
Working example.
library(shiny)
library(DT)
runApp(shinyApp(
ui = fluidPage(dataTableOutput('table')),
server = function(input, output, session) {
pollData <- reactivePoll(4000, session,
checkFunc = function(){ Sys.time() },
valueFunc = function(){ data.frame(id = sample(letters[1:3]), a = runif(3), b = runif(3), c = runif(3)) })
output$table <- renderDataTable({pollData()})
proxy <- dataTableProxy('table')
observeEvent(pollData(), {
selectRows(proxy, input$table_rows_selected)
})}
))
I have taken this example from #NicE answer and added id column. The point is that #NicE answer is OK if one needs certain row to be selected when that row is identified by the row number.
Now suppose I need a row to be selected when that row is identified by some id value. That is if I select a row with id equal b, then the next time data reloads I want the row to be selected with the same id value.
You could use a dataTableProxy to select rows when the datable is created after a pollData update.
Here's an example, the dataframe is refreshed every 4 seconds:
library(shiny)
library(DT)
ui <- fluidPage(dataTableOutput("table"))
server <- function(input,output,session){
values <- reactiveValues()
pollData <- reactivePoll(4000, session,
checkFunc=function(){
Sys.time()
},
valueFunc=function(){
data.frame(a=sample(c("a","b","c"),3),b=runif(3),c=runif(3),stringsAsFactors = F)
})
output$table <- renderDataTable({ pollData()})
observe({
values$selected <- pollData()$a[input$table_rows_selected]
})
proxy = dataTableProxy('table')
observeEvent(pollData(),{
selectRows(proxy, which(pollData()$a %in% values$selected))
})
}
shinyApp(ui,server)
Update: on the above code, when the data changes, the selected rows are the ones that have the same first column as previously.

Resources