Modifying a Non-Reactive R Dataframe while running Shiny App - r

I'm building my first Shiny app and I'm running into some trouble.
When I register a new user for the app, I need to add a row with some empty values to a dataframe, that will be used to generate recommendations.
user_features3 <- rbind(user_features3,c(612,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0))
This works alright while the app isn't running, and the 612th row is added. But while it's running, this has no effect on user_features3. I think this may be because R is busy with the webapp.
If I make a reactive value, say values <- reactiveValues() and then
value$df <- user_features3, I can modify the values in this reactive one, but I am unable to access the non-reactive one in a similar manner while the app is running.
I need to update it in real-time so that I can use it to generate movie recommendations. Any suggestions?

This solves your asked question, but modifying non-reactive variables can cause problems as well. In general, thinking about modifying a non-reactive variable within a shiny environment indicates perhaps you aren't thinking about how to scale or store or properly maintain the app state. For instance, if you are expecting multiple users, then know that this data is not shared with the other users, it is the current-user only. There is no way around this using local variables. (If you need to "share" something between users, you really need a data backend such as some form of SQL, including SQLite. See: https://shiny.rstudio.com/articles/persistent-data-storage.html)
In addition to all of the other shiny tutorials, I suggest you read about variable scope in shiny, specifically statements such as
"A read-only data set that will load once, when Shiny starts, and will be available to each user session", talking about data stored outside of the server function definition;
"This local copy of [this variable] is not be visible in other sessions", talking about a variable stored within the server function; and
"Objects defined in global.R are similar to those defined in app.R outside of the server function definition".
Having said that, two offered solutions.
Reactive Frame (encouraged!)
library(shiny)
ui <- fluidPage(
# App title ----
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
textInput(inputId = "sometext", label = "Some Text:",
placeholder = "(nothing meaningful)"),
actionButton(inputId = "addnow", label = "Add!")
),
mainPanel(
tableOutput("myframe")
)
)
)
server <- function(input, output, session) {
rxframe <- reactiveVal(
data.frame(txt = character(0), i = integer(0),
stringsAsFactors = FALSE)
)
observeEvent(input$addnow, {
newdat <- data.frame(txt = isolate(input$sometext),
i = nrow(rxframe()) + 1L,
stringsAsFactors = FALSE)
rxframe( rbind(rxframe(), newdat, stringsAsFactors = FALSE) )
})
output$myframe <- shiny::renderTable( rxframe() )
}
shinyApp(ui, server)
This example uses shiny::reactiveVal, though it would be just as easy to use shiny::reactiveValues (if multiple reactive variables are being used).
Non-Reactive Frame (discouraged)
library(shiny)
ui <- fluidPage(
# App title ----
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
textInput(inputId = "sometext", label = "Some Text:",
placeholder = "(nothing meaningful)"),
actionButton(inputId = "addnow", label = "Add!")
),
mainPanel(
tableOutput("myframe")
)
)
)
server <- function(input, output, session) {
nonrxframe <- data.frame(txt = character(0), i = integer(0),
stringsAsFactors = FALSE)
output$myframe <- shiny::renderTable({
req(input$addnow)
nonrxframe <<- rbind(nonrxframe,
data.frame(txt = isolate(input$sometext),
i = nrow(nonrxframe) + 1L,
stringsAsFactors = FALSE),
stringsAsFactors = FALSE)
nonrxframe
})
}
shinyApp(ui, server)
Both allow sequencing as the screenshots below demonstrate. Many will argue that the first (reactive) example is cleaner and safer. (Just the use of <<- is deterrent enough for me!)

Related

Summarize data from fileInput to use in updateCurrencyInput / updateNumericInput

Currently creating a sales report generating site in R using Shiny. I have been struggling to pull the data from a CSV file the user imports into the dashboard itself. I need to use the data from my fileInput to run a calculation and then actively display these results in my shiny window. Ideally this would be initiated by the action of selecting the CSV file for the fileInput by the user and the calculations would occur.
Let's say this is the CSV that the user inputs
ID
DATE
GROSS
000001
5/22/22
75000
000002
5/25/22
100000
Here is an abridged version of the related code
# Load packages
library(shiny)
library(bslib)
library(shinyWidgets)
library(dplyr)
# Define static variables
mayquota <- 135000
# UI
ui <- navbarPage(title = "Example",
tabPanel(title = "Page 1",
fluidPage(inputPanel(textInput("key", "KEY")),
fixedRow(column(12, fileInput("salesdata", "SALES DATA",
width = 100%, buttonLabel = "SELECT"))),
inputPanel(currencyInput("profits", "PROFITS", format = "dollar",
value = 0, align = "right"),
currencyInput("quota", "QUOTA", format = "dollar",
value = 0, align = "right"),
currencyInput("difference", "DIFFERENCE",
format = "dollar", value = 0,
align = "right")))))
# Server
server <- function(input, output, session) {
prof <- reactive({read_csv(input$profits)})
toListen <- reactive({input$key})
observeEvent(toListen(),
{if(input$key == "test123")
{updateCurrencyInput(session, "quota", value = mayquota)
updateCurrencyInput(session, "difference", value = profits() - mayquota}})
}
# Run application
shinyApp(ui = ui, server = server)
I need to pull the sum of the GROSS column in the CSV and use it to updateCurrencyInput in the form of:
updateCurrencyInput(session, "profits", value = profits())
I was hoping that something like this would work:
toListenFile() <- reactive({input$salesdata})
observeEvent(toListenFile(), {profits <- reactive({prof() %>% summarize(sum(`GROSS`))})})
But I was given the error that summarize from dplyr could not be used on reactive data. So that is where I stand. Any help would be appreciated to achieve a similar function to dplyr in a reactive environment where the CSV data is inputted by the user.
It appears as though I have a solution to my issue, just wanted to share since I already opened the question.
server <- function(input, output, session) {
abcInput <- reactive({
req(input$salesdata)
tibble(read_csv(input$salesdata$datapath))
})
sumprof <- reactive({sum(abcInput()$`GROSS`)})
observeEvent(input$rdata, {updateCurrencyInput(session, "profits", value = sumprof())
})
There might be a more elegant way to achieve this, but this appears to work thus far.

Using InsertUI and UpdateSelectizeInput

I'm attempting to use InsertUI and updateSelectizeInput methods in the server function as part of my app, primarily since my list of choices is so large.
library(shiny)
baby_names <- babynames::babynames %>%
distinct(name) %>%
.[["name"]] %>%
sort()
ui <- fluidPage(
tags$div(id = 'placeholder')
)
server <- function(input, output, session) {
id = "babies"
insertUI(selector = '#placeholder',
ui = tags$div(list(
selectizeInput("babynames", label = "Baby Names!", multiple = TRUE, choices = NULL, width = '400px',
options = list(placeholder = 'Type a baby name.'))
),
immediate = TRUE,
id = id))
updateSelectizeInput(
session, inputId = "babynames",
choices = baby_names,
server = TRUE)
}
shinyApp(ui, server)
I'm not getting much success out of this, as the selectizeInput is displayed but the dropdown options are not shown. How should I address this issue? Thanks!
This is explained in the documentation of insertUI:
This function allows you to dynamically add an arbitrarily large UI object into your app, whenever you want, as many times as you want. Unlike renderUI(), the UI generated with insertUI is not updatable as a whole: once it's created, it stays there. Each new call to insertUI creates more UI objects, in addition to the ones already there (all independent from one another). To update a part of the UI (ex: an input object), you must use the appropriate render function or a customized reactive function
(I added the bold font)
Therefore, you should use renderUI instead.

Use functions or loops to create shiny UI elements

I am creating a shiny app and realized I am repeating a particular UI element so I am wondering if there is a way to wrap this in a function and supply parameters to make it work in different cases. In my server file, I have
output$loss <- renderUI({
req(input$got)
if(input$got %in% Years) return(numericInput('got_snow', label = 'John Snow', value = NA))
if(!input$got %in% Years) return(fluidRow(column(3)))
})
and in the ui file, I have:
splitLayout(
cellWidths = c("30%","70%"),
selectInput('got', label = 'Select age', choices = c('',Years) , selected = NULL),
uiOutput("loss")
)
Since I find myself using these several times and only changing a few things in both the UI and server files, I wanted to wrap these in a function and use them as and when I please. I tried this for the server file
ui_renderer <- function(in_put, label, id){
renderUI({
req(input[[in_put]])
if(input[[in_put]] %in% Years) return(numericInput(id, label = label, value = NA))
if(!input[[in_put]] %in% Years) return(fluidRow(column(3)))
})
}
output$p_li <- ui_renderer(input='li', "Enter age", id="c_li")
and in my ui file, I put
uiOutput('c_li')
but it's not working. Any help is greatly appreciated.
I was unable to test your code since there was no minimal working example. I don't know if this is a typo in your example, but your are trying to render c_li, but your output is called p_li. Not sure how wrapping a render object in a standard function works, but I have done something similar using reactive values instead.
This is a minimal example using some of your terminology. It is not a working example, but an outline of the idea to my proposed solution.
# Set up the UI ----
ui <- fluidPage(
uiOutput("loss")
)
# Set up the server side ----
server <- function(input, output, session) {
# Let us define reactive values for the function inputs
func <- reactiveValues(
value <- "got",
label <- "select age",
id <- "xyz"
)
# Set up an observer for when any of the reactive values change
observeEvent({
func$value
func$label
func$id
}, {
# Render a new UI any time a reactive value changes
output[["loss"]] <- renderUI(
if (input[[func$value]] %in% years) {
numericInput(func$id, label = func$label, value = NA)
} else {
fluidRow(
column(3)
)
}
)
})
}
# Combine into an app ----
shinyApp(ui = ui, server = server)
The general idea is to define a set of reactive values and set up an observer that will render the UI every time one or more of the reactive values change. You can assign a new value to any of the reactive values using direct assignment, e.g. current$value <- "object_two". Making that change will update the UI using Shiny's reactive pattern, which means you only need to change one value to update the UI.

In shiny, selecting unique values from a column in a reactive object to use as input choices

I'm trying to make a shiny dashboard app in which the choices available in the dropdown menu are retrieved from a column in a reactive data object.
At the moment my code looks something like this:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(tidyverse)
data <- reactiveFileReader(
intervalMillis = 100000,
NULL,
filePath = 'Data\\data.csv',
readFunc = read.csv,
fileEncoding="UTF-8-BOM"
)
header <- dashboardHeader(title = "test")
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("plots", tabName = "plots"),
pickerInput('to','To:',
options = list(`actions-box` = TRUE, size = 10), multiple = TRUE,
choices = NULL)
)
)
fluid1 <- fluidRow(
box()
)
body <- dashboardBody(
tabItems(
tabItem(
tabName = 'plots', h2(fluid1)
)
)
)
ui <- dashboardPage(title = 'test', header, sidebar, body, skin='blue')
server <- function(input, output){
choices <- reactive({
data() %>%
select(to) %>%
unique()
})
observe({updatePickerInput('to',choices = choices())})
}
shinyApp(ui = ui, server = server)
And some sample data:
data <- data.frame(from = c('RCD', 'RCD', 'RCR', 'RCD', 'RCS', 'RCR', 'RCR', 'RCS', 'RCO', 'RCS'),
to = c('RCS', 'RCR', 'RCO', 'RCO', 'RCR', 'RCD', 'RCS', 'RCD', 'RCR', 'RCO'),
n = c(1,2,3,4,5,6,7,8,9,10))
What I expected was for this -
choices <- reactive({
data() %>%
select(to) %>%
unique()
})
to give me a list of unique values in the to column of the data() reactive object, which I could then pass to observe({updatePickerInput('to',choices = choices())})
Instead I get this error:
Warning: Error in : $ operator is invalid for atomic vectors
I'm quite new to using shiny so am having real problems troubleshooting this.
Any help would be greatly appreciated
This comes up often. You may have a working shiny app with a server method lacking a session parameter. But once you use methods like updatePickerInput, updateSelectInput, updateTextInput, etc. you run into an error, because it will require that you pass session to it. Thus, you need to make sure you include the session argument to your server function:
server <- function(session, input, output) {
...
}
The session object can be helpful in a number of circumstances, such as doing something when the browser is closed, customizing a user interface, updating inputs, or sending messages to javascript. For more information, see this practical answer.
In the case of updatePickerInput, you are actually sending a message to a picker input on the session's client web page. If the input is present, then the binding object's receiveMessage method is called. The updatePickerInput is a friendly wrapper to use instead of the generic sendInputMessage. In this instance, try including session:
updatePickerInput(session, 'to', choices = choices())
A helpful reference on the session object:
https://shiny.rstudio.com/reference/shiny/latest/session.html

Saving state of Shiny app to be restored later

I have a shiny application with many tabs and many widgets on each tab. It is a data-driven application so the data is tied to every tab.
I can save the application using image.save() and create a .RData file for later use.
The issue I am having how can I get the state restored for the widgets?
If the user has checked boxes, selected radio buttons and specified base line values in list boxes can I set those within a load() step?
I have found libraries such as shinyURL and shinystore but is there a direct way to set the environment back to when the write.image was done?
I am not sure where to even start so I can't post code.
edit: this is a cross-post from the Shiny Google Group where other solutions have been suggested
This is a bit hacky, but it works. It uses an "internal" function (session$sendInputMessage) which is not meant to be called explicitly, so there is no guarantee this will always work.
You want to save all the values of the input object. I'm getting all the widgets using reactiveValuesToList(input) (note that this will also save the state of buttons, which doesn't entirely make sense). An alternative approach would be to enumerate exactly which widgets to save, but that solution would be less generic and you'd have to update it every time you add/remove an input. In the code below I simply save the values to a list called values, you can save that to file however you'd like (RDS/text file/whatever). Then the load button looks at that list and updates every input based on the value in the list.
There is a similar idea in this thread
library(shiny)
shinyApp(
ui = fluidPage(
textInput("text", "text", ""),
selectInput("select", "select", 1:5),
uiOutput("ui"),
actionButton("save", "Save"),
actionButton("load", "Load")
),
server = function(input, output, session) {
output$ui <- renderUI({
tagList(
numericInput("num", "num", 7),
checkboxGroupInput("chk", "chk", 1:5, c(2,4))
)
})
observeEvent(input$save, {
values <<- lapply(reactiveValuesToList(input), unclass)
})
observeEvent(input$load, {
if (exists("values")) {
lapply(names(values),
function(x) session$sendInputMessage(x, list(value = values[[x]]))
)
}
})
}
)
Now with bookmarking is possible to save the state of your shinyapp. You have to put the bookmarkButton on your app and also the enableBookmarking.
The above example may not work if shiny UI involves date. Here is a minor change for date handling.
library(shiny)
shinyApp(
ui = fluidPage(
dateInput("date", "date", "2012-01-01"),
selectInput("select", "select", 1:5),
uiOutput("ui"),
actionButton("save", "Save"),
actionButton("load", "Load")
),
server = function(input, output, session) {
output$ui <- renderUI({
tagList(
numericInput("num", "num", 7),
checkboxGroupInput("chk", "chk", 1:5, c(2,4))
)
})
observeEvent(input$save, {
values <<- lapply(reactiveValuesToList(input), unclass)
})
observeEvent(input$load, {
if (exists("values")) {
lapply(names(values),
function(x) session$sendInputMessage(x, list(value = values[[x]]))
)
temp=as.character(as.Date(values$date, origin = "1970-01-01"))
updateDateInput(session, inputId="date", label ="date", value = temp)
}
})
}
)

Resources