Shiny in R: How to properly use observe? - r

I have a problem with my code. I have 2 input files which I want to read with click of button and a numeric input which contains a filter value for the output of the table being created from the 2 files (after manipulating the data). The whole process (read files + create table + filter) right now is executed every time the user click the button. I want to do only the filter action if the input files doesn't change, because the process takes long time.
After the first click I want to do only the filtering command when the numeric input changes, unless the input files is also changed by the user.
The following code reproduces my problem:
library(shiny)
library(data.table)
server <- function(input, output, session) {
output$table1 <- renderDataTable({
input$gobtn
isolate({
infile1 <<- input$f1
infile2 <<- input$f2
if (is.null(infile1) || is.null(infile1)) {
return (NULL)
}
else {
calc()
}
})
})
calc <- function() {
inf1 <<- fread(infile1$datapath)
inf2 <<- fread(infile2$datapath)
# do some process with files data.....
my_table <- as.data.table(rbind(inf1, inf2))
setnames(my_table, c('name', 'rank'))
result <- my_table[rank > input$rank]
return(result)
}
}
ui <- basicPage(
fileInput("f1", "f1"),
fileInput("f2", "f2"),
numericInput("rank", "show rank only above :", value = 6),
actionButton("gobtn", "show"),
dataTableOutput('table1')
)
shinyApp(ui = ui, server = server)

The way to use reactivity is to break things into parts, so that you only need to update what is necessary. The first step in your pipeline is reading and processing the files. This seems like a good reactive: if they don't change, nothing happens, but when they change, everything that needs to be recalculated is recalculated. The next step is filtering, when the filter variable changes we want to refilter the data. Then we can just put that in the output.
server <- function(input, output, session) {
processedData <- reactive({
req(input$f1,input$f2)
inf1 <- fread(input$f1$datapath)
inf2 <- fread(input$f2$datapath)
# do some process with files data.....
my_table <- as.data.table(rbind(inf1, inf2))
setnames(my_table, c('name', 'rank'))
my_table
}
filteredData <- reactive({
req(input$rank)
processedData()[processedData()$rank > input$rank]
})
output$table1 <- renderDataTable({
input$gobtn
isolate({
filteredData()
})
})
}

Related

Read a file after taking user input(selection) in Shiny

I am trying to read a file after taking inputs from user - first a date and then a selection of file, but I can't get the code read any file and do anything with it. The Error message is following. Also is there a way to make this code more efficient?
ui <- fluidPage(
titlePanel("Select the execution date")
,dateInput("ME_DATE",label=h3("Execution Date Input"), value="2020-05-29")
,hr()
,fluidRow(column(3,verbatimTextOutput("Output_path")))
,hr()
,selectInput('selectfile','Select File in Above Location', choices=NULL)
,textOutput('fileselection_statement')
,tableOutput('selected_table')
)
server <- function(input, output, session) {
# Location for Outputs
Output_DIR <- "K:/Outputs/"
Output_loc <- reactive({
year_N_ME_DATE <- format(input$ME_DATE,"%Y")
month_N_ME_DATE <- format(input$ME_DATE,"%m")
month_T_ME_DATE <- months(input$ME_DATE)
file.path(paste(Output_DIR,month_N_ME_DATE,". ",month_T_ME_DATE, " ",year_N_ME_DATE,"/",sep=""))
})
# Output Path
output$Output_path <- renderPrint({ Output_loc() })
# files list
Updated_Output_files_list <- reactive({ list.files(Output_loc()) })
observeEvent(input$selectfile, {
updateSelectInput(session, "selectfile", choices=Updated_Output_files_list())
output$fileselection_statement <- renderText({paste0('You have selected: ', input$selectfile) })
})
selectfile <- reactive(get(input$selectfile))
output$selected_table <- renderTable({ read.csv(paste0(renderPrint({ Output_loc() }),renderPrint({ selectfile() }),sep="")) })
}
shinyApp(ui, server)
(Since changed) Make the block containing file.path(.) a reactive block and assign it to something so that other reactive components can use it. In your case, you changed it to Output_loc, so other blocks will refer to it as Output_loc().
Similarly, you cannot put output$... <- assignments or render* calls inside an observe or observeEvent block. So we'll move your output$fileselection_statement outside of the observeEvent.
renderPrint is its own rendering function, on the same level as renderTable. You cannot nest them. In this case, I'm just going to remove them from inside the renderTable call, they make no sense there.
This case did not need selectfile <- reactive(get(input$selectfile)), there is no apparent gain in that indirection. Just use input$selectfile. Removed.
After fixing all of the above, it is also the case that you were updating the selectInput every time the selectInput was changed, which is incorrect (and completely disallows any real use of this). Instead, you want to update it when the Updated_Output_files_list() changes.
Also, instead of repeatedly concatenating the path together to create the file to be read, I use list.files(..., full.names=TRUE). This will be a named vector, where the values are the full path and filename, but the names will be just the filename (no leading path). This useful because selectInput displays the name but returns the value (full path). There is rarely a time when I think not specifying full.names=TRUE is the right thing (I cannot think of any right now).
Here's a working copy. It is not perfectly-awesome, there are still areas where some grooming might be in order.
server <- function(input, output, session) {
# Location for Outputs
Output_DIR <- "K:/Outputs/"
Output_loc <- reactive({
year_N_ME_DATE <- format(input$ME_DATE, "%Y")
month_N_ME_DATE <- format(input$ME_DATE, "%m")
month_T_ME_DATE <- months(input$ME_DATE)
file.path(Output_DIR,
paste0(month_N_ME_DATE, ". ", month_T_ME_DATE, " ", year_N_ME_DATE),
"/")
})
# alternative
# Output_loc <- reactive({
# file.path(Output_DIR, format(Sys.Date(), format = "%m. %b %Y"))
# })
# Output Path
output$Output_path <- renderPrint({ req(Output_loc()) })
# files list
Updated_Output_files_list <- reactive({
lf <- list.files(Output_loc(), full.names = TRUE)
names(lf) <- basename(lf)
# in this example, 'lf' is now:
# c(iris.csv = "K:/Outputs/05. May 2020/iris.csv", mtcars.csv = "K:/Outputs/05. May 2020/mtcars.csv")
# ... the *name* will be displayed in the selectInput, but the
# *full path* will be the value of the selection
lf
})
output$fileselection_statement <- renderText({
paste0('You have selected: ', input$selectfile)
})
observeEvent(Updated_Output_files_list(), {
updateSelectInput(session, "selectfile", choices = Updated_Output_files_list())
})
output$selected_table <- renderTable({
req(input$selectfile)
read.csv(input$selectfile)
})
}

Object not found R Shiny

I am trying to access the data frame created in one render function into another render function.
There are two server outputs, lvi and Category, in lvi I have created Data1 data frame and Category I have created Data2 dataframe. I want to select Data2 where Data1 ID is matching.
I am following the below steps to achieve my objective but I get error "Object Data1 not found".
My UI is
ui <- fluidPage(
# App title ----
titlePanel("Phase1"),
fluidPage(
column(4,
# Input: Select a file ----
fileInput("file1", "Import file1")
)
),
fluidPage(
column(4,
# Input: Select a file ----
fileInput("file2", "Import File2")
)
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Data file ----
dataTableOutput("lvi"),
dataTableOutput("category")
)
)
My server code is
server <- function(input, output) {
output$lvi <- renderDataTable({
req(input$file1)
Data1 <- as.data.frame(read_excel(input$file1$datapath, sheet = "Sheet1"))
})
output$category <- renderDataTable({
req(input$file2)
Data2 <- as.data.frame(read_excel(input$file2$datapath, sheet = "Sheet1"))
Data2 <- Data2[,c(2,8)]
Data2 <- Data2[Data1$ID == "ID001",]
})
}
shinyApp(ui, server)
Once a reactive block is done executing, all elements within it go away, like a function. The only thing that survives is what is "returned" from that block, which is typically either the last expression in the block (or, when in a real function, something in return(...)). If you think of reactive (and observe) blocks as "functions", you may realize that the only thing that something outside of the function knows of what goes on inside the function is if the function explicitly returns it somehow.
With that in mind, the way you get to a frame inside one render/reactive block is to not calculate it inside that reactive block: instead, create that frame in its own data-reactive block and use it in both the render and the other render.
Try this (untested):
server <- function(input, output) {
Data1_rx <- eventReactive(input$file1, {
req(input$file1, file.exists(input$file1$datapath))
as.dataframe(read_excel(input$file1$datapath, sheet = "Sheet1"))
})
output$lvi <- renderDataTable({ req(Data1_rx()) })
output$category <- renderDataTable({
req(input$file2, file.exists(input$file2$datapath),
Data1_rx(), "ID" %in% names(Data1_rx()))
Data2 <- as.data.frame(read_excel(input$file2$datapath, sheet = "Sheet1"))
Data2 <- Data2[,c(2,8)]
Data2 <- Data2[Data1_rx()$ID == "ID001",]
})
}
shinyApp(ui, server)
But since we're already going down the road of "better design" and "best practices", let's break data2 out and the data2-filtered frame as well ... you may not be using it separately now, but it's often better to separate "loading/generate frames" from "rendering into something beautiful". That way, if you need to know something about the data you loaded, you don't have to (a) reload it elsewhere, inefficient; or (b) try to rip into the internals of the shiny DataTable object and get it manually. (Both are really bad ideas.)
So a slightly better solution might start with:
server <- function(input, output) {
Data1_rx <- eventReactive(input$file1, {
req(input$file1, file.exists(input$file1$datapath))
as.dataframe(read_excel(input$file1$datapath, sheet = "Sheet1"))
})
Data2_rx <- eventReactive(input$file2, {
req(input$file2, file.exists(input$file2$datapath))
dat <- as.dataframe(read_excel(input$file2$datapath, sheet = "Sheet1"))
dat[,c(2,8)]
})
Data12_rx <- reactive({
req(Data1_rx(), Data2_rx())
Data2_rx()[ Data1_rx()$ID == "ID001", ]
})
output$lvi <- renderDataTable({ req(Data1_rx()); })
output$category <- renderDataTable({ req(Data12_rx()); })
}
shinyApp(ui, server)
While this code is a little longer, it also groups "data loading/munging" together, and "render data into something beautiful" together. And if you need to look at early data or filtered data, it's all right there.
(Side note: one performance hit you might see from this is that you now have more copies of data floating around. As long you are not dealing with "large" data, this isn't a huge deal.)

Shiny renderDataTable table_cell_clicked

I am trying to create a table using Shiny, where the user can click on a row in order to see further information about that row. I thought I understood how to do this (see code attached).
However, right now as soon as the user clicks the "getQueue" action button, the observeEvent(input$fileList_cell_clicked, {}) seems to get called. Why would this be called before the user even has the chance to click on a row? Is it also called when the table is generated? Is there any way around this?
I need to replace "output$devel <- renderText("cell_clicked_called")" with code that will have all sorts of errors if there isn't an actual cell to refer to.
Thank you for any advice!
ui <- fluidPage(
actionButton("getQueue", "Get list of queued files"),
verbatimTextOutput("devel"),
DT::dataTableOutput("fileList")
)
shinyServer <- function(input, output) {
observeEvent(input$getQueue, {
#get list of excel files
toTable <<- data.frame("queueFiles" = list.files("queue/", pattern = "*.xlsx")) #need to catch if there are no files in queue
output$fileList <- DT::renderDataTable({
toTable
}, selection = 'single') #, selection = list(mode = 'single', selected = as.character(1))
})
observeEvent(input$fileList_cell_clicked, {
output$devel <- renderText("cell_clicked_called")
})}
shinyApp(ui = ui, server = shinyServer)
minimal error code
DT initializes input$tableId_cell_clicked as an empty list, which causes observeEvent to trigger since observeEvent only ignores NULL values by default. You can stop the reactive expression when this list is empty by inserting something like req(length(input$tableId_cell_clicked) > 0).
Here's a slightly modified version of your example that demonstrates this.
library(shiny)
ui <- fluidPage(
actionButton("getQueue", "Get list of queued files"),
verbatimTextOutput("devel"),
DT::dataTableOutput("fileList")
)
shinyServer <- function(input, output) {
tbl <- eventReactive(input$getQueue, {
mtcars
})
output$fileList <- DT::renderDataTable({
tbl()
}, selection = 'single')
output$devel <- renderPrint({
req(length(input$fileList_cell_clicked) > 0)
input$fileList_cell_clicked
})
}
shinyApp(ui = ui, server = shinyServer)

R shiny isolate reactive data.frame

I am struggling to understand how isolate() and reactive() should be used in R Shiny.
I want to achieve the following:
Whenever the "Refresh" action button is clicked:
Perform a subset on a data.frame and,
Feed this into my function to recalculate values.
The subset depends on a group of checkboxes that the user has ticked, of which there are approximately 40. I cannot have these checkboxes "fully reactive" because the function takes about 1.5 sec to execute. Instead, I want to give the user a chance to select multiple boxes and only afterwards click a button to (a) subset and (b) call the function again.
To do so, I load the data.frame in the server.R function:
df1 <- readRDS("D:/././df1.RData")
Then I have my main shinyServer function:
shinyServer(function(input, output) {
data_output <- reactive({
df1 <- df1[,df1$Students %in% input$students_selected]
#Here I want to isolate the "students_selected" so that this is only
#executed once the button is clicked
})
output$SAT <- renderTable({
myFunction(df1)
})
}
How about something like
data_output <- eventReactive(input$button, {
df1[,df1$Students %in% input$students_selected]
})
Here is my minimal example.
library(shiny)
ui <- list(sliderInput("num", "rowUpto", min= 1, max = 10, value = 5),
actionButton("btn", "update"),
tableOutput("tbl"))
server <- function(input, output) {
data_output <- eventReactive(input$btn, {
data.frame(id = 1:10, x = 11:20)[seq(input$num), ]
})
output$tbl <- renderTable({
data_output()})
}
runApp(list(ui = ui, server = server))
Edit
Another implementation, a bit more concise.
renderTable by default inspects the changes in all reactive elements within the function (in this case, input$num and input$button).
But, you want it to react only to the button. Hence you need to put the elements to be ignored within the isolate function.
If you omit the isolate function, then the table is updated as soon as the slider is moved.
library(shiny)
ui <- list(sliderInput("num", "rowUpto", min= 1, max = 10, value = 5),
actionButton("btn", "update"),
tableOutput("tbl"))
server <- function(input, output) {
output$tbl <- renderTable({
input$btn
data.frame(id = 1:10, x = 11:20)[seq(isolate(input$num)), ]
})
}
runApp(list(ui = ui, server = server))
Use eventReactive instead:
data_output <- eventReactive(input$updateButton, {
df1 <- df1[,df1$Students %in% input$students_selected] #I think your comments are messed up here, but I'll leave the filtering formatting to you
})
output$SAT <- renderTable({
data_output()
})
And in your UI you should have something like:
actionButton('updateButton',label = "Filter")
Looking at ?shiny::eventReactive:
Use eventReactive to create a calculated value that only updates in
response to an event. This is just like a normal reactive expression
except it ignores all the usual invalidations that come from its
reactive dependencies; it only invalidates in response to the given
event.

Update handsontable by editing table and/or eventReactive

I am using the rhandsontable package in a Shiny app which should have the following functionality:
the data used in the calculation can be randomly generated, invoked by an actionButton (and when the app starts)
the data can be manually edited by the user via the handsontable object
after manual editing it should be possible to re-generate random data, invoking a new calculation
The following app does exactly that what I want, but I could not figure it out how to get rid of the global variable did_recalc. It is a minimal example, where the data consists of two numeric values which are summed up.
library(shiny)
library(rhandsontable)
did_recalc <- FALSE
ui <- fluidPage(
rHandsontableOutput('table'),
textOutput('result'),
actionButton("recalc", "generate new random vals and calculate")
)
server <- function(input,output,session)({
dataset_generator <- eventReactive(input$recalc, {
df <- as.data.frame(runif(2))
output$table <- renderRHandsontable({rhandsontable(df)})
did_recalc <<- TRUE
df
}, ignoreNULL = FALSE)
output$result <- renderText({
df <- dataset_generator()
if (!is.null(input$table) && !did_recalc)
df <- hot_to_r(input$table)
did_recalc <<- FALSE
sum(df)
})
})
shinyApp(ui = ui, server = server)
If I remove the !did_recalc condition within output$result <- ... then editing the table still invokes a (correct) calculation. But if "recalc" is pressed (after some manual editing was done), then the "recalc" button just generates new random values, but without recalculating the sum.
It seems to me, that input$table can just be changed by manual edits of the table object and does not care about new values given via renderRHandsontable. Hence I need this hack with the global variable, which allows me to track if the user just re-generated the data (causing that input$table is "outdated")
Has anybody an idea how to get the functionality of this example without the global variable?
You could store the data in a reactiveValues and have two observers updating it; one if the button is clicked, one if the table is edited by hand.
In your output$table and output$result, you then just need to use the data that is in the reactiveValues. Here's an example (same ui.R as you posted):
server <- function(input,output,session)({
values <- reactiveValues(data=as.data.frame(runif(2)))
observe({
input$recalc
values$data <- as.data.frame(runif(2))
})
observe({
if(!is.null(input$table))
values$data <- hot_to_r(input$table)
})
output$table <- renderRHandsontable({
rhandsontable(values$data)
})
output$result <- renderText({
sum(values$data)
})
})

Resources