I am trying to write a shiny app to accommodate a specific function which estimates numbers of fish from sampled data. The function creates an amalgamated variable that is nonsense to the user. The code does run, but I am trying to modify this table after the fact to create variables that will make sense to the user. In order to do this, I need to split the nonsense variable into parts, rename those parts, and specify which ones to print. I can do this in the tidyverse using mutate, but haven't figured out how or where to incorporate these changes so that it doesn't kill the app.
I have tried a reactive within server. I have tried to perform these changes within renderTable.
In the code below, estimate is the output of the custom function MRIP.catch and the output needs to be modified. There is an output column called "domain" that conglomerates all of the inputs. I need to split these back apart so that the user knows what they are looking at in the table output.
I know this code isn't run-able on it's own. I was just hoping that it was a simple syntax question that someone could help me to untangle. I haven't been able to find examples of tables that need to be changed after being calculated but before being displayed.
server <- function(input, output, session) {
sp<-eventReactive(input$go,{input$species})
yr1<-eventReactive(input$go, {input$start_yr})
yr2<-eventReactive(input$go, {input$end_yr})
freq2<-eventReactive(input$go,{
case_when(input$freq =='annual'~annual,
input$freq =='wave'~wave)
})
sub<-eventReactive(input$go, {
case_when(input$reg =='by state'~state,
input$reg =='by coast'~coast)
})
mode<-eventReactive(input$go, {
case_when(input$modes=='all modes combined'~all_mode,
input$modes=='all modes by mode'~each_mode)
})
area<-eventReactive(input$go, {
case_when(input$areas == 'all areas combined'~all_area,
input$areas=='all areas by area'~each_area)
})
dom1<- eventReactive(input$go, {list(wave=freq2()#Use for annual estimate. Comment out for wave
,sub_reg=sub() #Use for custom geo regions
,mode_fx=mode() #use to combine modes.
,area_x=area() #Use to combine fishing areas.
)})
estimate<-eventReactive(input$go,{
MRIP.catch(intdir='C:\\Users\\',
st = 12, styr = yr1(), endyr= yr2(), common = sp()
, dom = dom1()
)})
output$species <- renderText({paste( 'you have seletected',sp()) })
output$range<-renderText({paste ('from',yr1(), 'to', yr2())})
output$table<-renderTable({estimate()})
}
The following is the code I used in dplyr to create the independent sections of the variable and rename them. I'm sure it isn't the most elegant way to make this go, but it does work.
##Separates out each piece of domain to name
estimate<-
estimate%>%
mutate (yr = substr(Domain, 5,8),
wave1=substr(Domain,13,13),
basin1=substr(Domain,25,25),
mode1=substr(Domain, 33,33),
area1=substr(Domain, 40,40),
cntys1=substr(Domain, 45,45),
yr_wave=paste(yr,wave1, sep='-'))
estimate<-
estimate%>%
mutate (basin = case_when (basin1 == '6' ~'SA',
basin1=='7'~'Gulf',
basin1=='1'~'statewide'
),
mode = case_when(mode1=='1'~'combined',
mode1 =='3'~'Shore',
mode1=='5'~'Charter',
mode1=='7'~'Private'),
area = case_when(area1 =='1'~'EC state',
area1=='2'~'EC fed',
area1=='3'~'Gulf state',
area1=='4'~'Gulf fed',
area1=='5'~'Inland'))
I will try to focus on this part: "find examples of tables that need to be changed after being calculated but before being displayed".
Take a look at the example below and check if this is something which can help you.
library(shiny)
ui <- fluidPage(
actionButton("go", "Go"),
tableOutput("table")
)
server <- function(input, output, session) {
df <- reactiveVal(data.frame(a = c(1, 2))) # but reactiveVal() can be left empty as well, then it starts with NULL value
initial_data <- reactive({
first_computation <- df() %>%
mutate(b = c(3, 4))
df(first_computation )
})
observeEvent(input$go, {
second_computation <- initial_data() %>%
mutate(c = c(5, 6))
df(second_computation)
})
output$table <- renderTable({
req(input$go) # not sure if this will be enough for your needs!
df()
})
}
shinyApp(ui, server)
I created reactiveVal object and this is most important part - this object can be use in different places (active-reactive context) and can be modify. At first is data.frame with one variable, then I made some computation, but do not display anything. Then I have made some new additional computation when user clicks "go" and after that the new table is displayed.
Related
The bounty expires in 5 days. Answers to this question are eligible for a +50 reputation bounty.
mat wants to draw more attention to this question.
I'm trying to generalize the Hierarchical select boxes approach described in the Mastering Shiny book to enable non-sequential filtering. Currently, the drill-down approach only works if the user selects categories in a specific order, for example, Terriority -> Customer -> Order number. However, I would like the drill-down to work regardless of the initial input the user provides. Additionally, my application involves approximately 10 inputs, so I want the code to be scalable.
I have been following the example in the Mastering Shiny book, but I'm having difficulty adapting the code to allow for non-sequential filtering. Specifically, when I try to modify the code to accommodate non-sequential filtering, the select boxes become unresponsive.
Any suggestions for how to modify the code to allow for non-sequential filtering would be greatly appreciated.
One way to do this is to modify and filter the underlying data. So, create a nested list of all possible combinations of the filter values, and then use the reduce() function from the purrr package to apply the filtering iteratively.
Example:
Let's say I want to filter my nutritional supplement sales. Assume we have a dataframe, df, with columns Supplement, Customer, and OrderNumber.
library(shiny)
library(purrr)
# Create a nested list of all possible filter combinations
filters <- list(
by_Supplement = split(df, df$Supplement),
by_customer = map(filters$by_Supplement, ~split(.x, .x$Customer)),
by_order_number = map(filters$by_customer, ~map(.x, ~split(.x, .x$OrderNumber)))
)
# Define a function to filter the data by a list of filter values
filter_data <- function(data, filters) {
reduce(filters, function(data, filter) {
if (!is.null(filter)) {
data %>% filter(!!!filter)
} else {
data
}
}, .init = data)
}
# Define the Shiny app UI
ui <- fluidPage(
selectInput("Supplement", "Supplement", choices = names(filters$by_Supplement)),
uiOutput("customer"),
uiOutput("order_number"),
tableOutput("table")
)
# Define the Shiny app server
server <- function(input, output, session) {
output$customer <- renderUI({
Supplement_data <- filters$by_Supplement[[input$Supplement]]
selectInput("customer", "Customer", choices = c("", names(Supplement_data)))
})
output$order_number <- renderUI({
Supplement_data <- filters$by_Supplement[[input$Supplement]]
if (!is.null(input$customer)) {
customer_data <- Supplement_data[[input$customer]]
selectInput("order_number", "Order Number", choices = c("", customer_data$OrderNumber))
} else {
selectInput("order_number", "Order Number", choices = "")
}
})
output$table <- renderTable({
filter_values <- list(Supplement = input$Supplement, Customer = input$customer, OrderNumber = input$order_number)
filtered_data <- filter_data(df, map(filters, ~if (!is.null(.x)) .x[[filter_values[[names(.x)]]]]))
filtered_data
})
}
# Run the Shiny app
shinyApp(ui, server)
filter_data() goes into output$table with a list of filter values, via map() and has the currently selected values of all three select boxes, regardless of the order of selection.
I have a tab of my app where I display a bunch of text inputs based on a three-column data frame that contains: variable_name, text_prompt, and example_data. The code below seems to work fine since it displays how I want it to. Eventually, I will be feeding it different data frames, depending on the circumstances, so I need to be able to do everything programmatically.
library(shiny)
library(tidyverse)
library(DT)
additional.data.fields <- tibble (var.name = c("project.id", "director.name"),
prompt.text = c("Enter Project ID", "Enter Director's name"),
var.value = c("e.g. 09-111", "e.g. Paul Smith"))
ui <- fluidPage(
tabsetPanel(
#Generate Input fields from dataframe
tabPanel("Input", #value = "input.2",
# Generate input fields with pmap
actionButton("submit", "Submit"),
pmap(additional.data.fields, ~textInput(..1, ..2, value = ..3)),
),
#Output data to tell if it updates with button click
tabPanel("Output", value = "output",
DT::dataTableOutput("data")
)
)
)
server <- function(input, output, session) {
# Create a reactive values object to store the input data
values <- reactiveValues()
# Set the reactive values object when the submit button is clicked
observeEvent(input$submit, {
var.names <- pull(additional.data.fields, var.name)
#THIS IS THE PART I DON'T KNOW HOW TO DO
#input.data <- ???
#I'll add dummy data so that the program loads
input.data <- tibble(var.names,
temp = 1:length(var.names))
values$data <- input.data
})
# Render the input data table
output$data <- DT::renderDataTable({
values$data
})
}
shinyApp(ui, server)
But what I want - and really have no idea how to do - is to get it back into a data frame after the user hits "submit" (I only need two columns in the subsequent data frame; I don't need the text_prompt data again.)
I know that the user input creates a list of read-only ReactiveValues called "input". But I can't figure out how to do anything with this list besides access using known names (i.e. I know that there is a variable named "project_id" which I can access using input$project_id). But what I want is not to have to write them all out, so that I can change the data used to create the input fields. So I need a way to collect them in a data frame without knowing all the individual names of the variables or even how many there are.
I figured this out on my own. You can't index reactive values with []. However, for some reason you can using [[]].
I would love to know why this is, if anyone has an answer that can help me understand why it works this way.
Here's the key bit of code that I was missing before:
input.data <- tibble (names = var.names,
values = map_chr(var.names, ~input[[.x]]))
The full code that works as I want it is pasted below. I'd still appreciate any feedback or recommendations for improvement.
library(shiny)
library(tidyverse)
library(DT)
additional.data.fields <- tibble (var.name = c("project.id", "director.name"),
prompt.text = c("Enter Project ID", "Enter Director's name"),
var.value = c("e.g. 09-111", "e.g. Paul Smith"))
ui <- fluidPage(
tabsetPanel(
#Generate Input fields from dataframe
tabPanel("Input", #value = "input.2",
# Generate input fields with pmap
actionButton("submit", "Submit"),
pmap(additional.data.fields, ~textInput(..1, ..2, value = ..3)),
),
#Output data to tell if it updates with button click
tabPanel("Output", value = "output",
DT::dataTableOutput("data")
)
)
)
server <- function(input, output, session) {
# Create a reactive values object to store the input data
values <- reactiveValues()
# Set the reactive values object when the submit button is clicked
observeEvent(input$submit, {
var.names <- pull(additional.data.fields, var.name)
input.data <- tibble (names = var.names,
values = map_chr(var.names, ~input[[.x]]))
values$data <- input.data
})
# Render the input data table
output$data <- DT::renderDataTable({
values$data
})
}
shinyApp(ui, server)
I generate a dynamic number of valueBox in my shiny, and this number can change depending of the user input.
I managed to handle this with a renderUI where I put the wanted number of valueBoxOutput, and I have an observe that will feed them with the content using renderValueBox.
My problem is: the code in the renderValueBox, for some reason, is actually executed after the observe is finished, so because the renderValueBox is in a loop (to have a dynamic number of them) but the code is executed for all the output after the loop, all my output will get the last value of the loop.
Here is a min reprex:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
# Function
compute <- function(id)
{
print(paste("Compute ", id))
return(id)
}
# UI
ui = shinyUI(fluidPage(
titlePanel("Compare"),
useShinydashboard(),
sidebarLayout(
sidebarPanel(
numericInput("numitems", label = "Number of items", min = 1, max = 10, value = 2)
),
mainPanel(
uiOutput("boxes")
)
)
))
# Server
server = shinyServer(function(input, output, session) {
data <- reactiveValues(
ids = list()
)
output$boxes <- renderUI({
print("boxes")
box_list <- list()
id_list <- list()
for(id in 1:(input$numitems)) {
id_box <- paste0("box_", id)
print(paste("boxes - ", id_box))
id_list <- append(id_list, id_box)
box_list <- append(
box_list,
tagList(
shinydashboard::valueBoxOutput(id_box)
)
)
data$ids <- id_list
}
print("boxes end")
fluidRow(box_list)
})
observe({
print("observe")
for(id_box in data$ids) {
print(paste("observe - ", id_box))
output[[id_box]] <- shinydashboard::renderValueBox(valueBox(id_box, compute(id_box), icon = icon("circle-info"), color = "teal"))
}
print("end observe")
})
})
# Run
shinyApp(ui = ui , server = server)
Here is the result:
And the console output:
As you can see the compute (and the render in general) is done after the end of the observe function, and both output will use the last id_box that were set (so the last loop, box_2), instead of correctly using box_1 and box_2.
I tried using force, computing valueBox outside the render, using reactive lists, nothing worked, because whatever I do the render is evaluated after the observe so only the last loop values will be used no matter what.
Do anyone know a way to force execution during the loop ? Or see another way of achieving the same result ?
Why it's always after spending hald a day on a problem, looking for dozens of posts and forum, don't find anything, finally decide to ask a question... that a few minutes later I finally find an answer.
Anyway, one way to correct this (found here) is to encapsulate the render inside the local function, like this:
observe({
print("observe")
for(id_box in data$ids) {
print(paste("observe - ", id_box))
local({
tmp <- id_box
output[[tmp]] <- shinydashboard::renderValueBox(valueBox(tmp, compute(tmp), icon = icon("circle-info"), color = "teal"))
})
}
print("end observe")
})
Now the compute is still called after the end of the observe, but the tmp variable has the correct value:
The result is what I wanted:
For the record, I had already tried to use the local function, but if you don't copy the id_box inside another variable just for the local bloc, it won't work.
I've written a script to calculate glicko ratings and produce odds and historic plots for sport teams. A separate script is responsible for querying the SQL server that holds historic data and extracting the relevant info to make a local tsv file of the info I need for the rating calculation. To make it more user-friendly, I've put the functions into a simple shiny app.
My problem is that I would like to put in a button that automatically executes the code of the second script that adds recent matches to the data file, so the ratings can be updated.
I've proved a simplified example of my code, showing that I'm handling the bulk of the data wrangling and preparation of the ratings object, from where I can get probabilities, before defining the UI. I tried a simple example of modifying the teams_list with my action button, but this did not recalculate the list of teams available to enter in selectInput(); because of how observeEvent() handles the code with isolate() to avoid recalculations, I'm guessing. So simply duplicating all the code that loads data and prepares the ratings object will not do unless it makes all the rest of the code re-evaluate its input.
I considered moving all of that into the action button and deleting it from the start of the script, but that would mean that there is no data at all until the action button would be pressed and that is not desirable either. I don't want to query the database more often than is necessary, so it is a must to be able to run the app from the existing data rather than querying it every time the app is launched.
Does anyone have a suggestion for how this could be accomplished?
### Toy example
## Prep: This input data normally exists before app is run.
library(tidyverse)
tibble(team1 = c("Name1", "Name2", "Name3", "Name2"),
team2 = c("Name2", "Name1", "Name1", "Name3"),
team1Won = c(T, T, F, T)) %>%
write_tsv("example_match_file.tsv")
## Here the app code starts.
# Loading data and calculating team ratings
match_df <- read_tsv("example_match_file.tsv")
rating_calculation <- function(match_data = match_df) {
match_data %>%
group_by(team1) %>%
summarize(matchesWon = sum(team1Won)) %>%
arrange(desc(matchesWon))
}
rating_df <- rating_calculation(match_df)
team_list <- rating_df$team1
odds_calculation <- function(team1, team2, ratingObject = rating_df) {
#Real calculation omitted for brevity
p <- runif(1)
}
## Define Shiny UI
library(shiny)
ui <- fluidPage(
titlePanel("Odds"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "team1",
label = "Team 1",
choices = team_list),
selectInput(inputId = "team2",
label = "Team 2",
choices = team_list),
#actionButton("update", "Update match data")
),
mainPanel(
tableOutput("odds")
)
)
)
## Define Shiny server logic
server <- function(input, output) {
#Generate Odds
output$odds <- renderTable({
p <- odds_calculation(rating_df, input$team1, input$team2)
tibble(Team = c(input$team1, input$team2), Win = c(p, 1-p)) %>%
mutate(Odds = (1/Win))
})
### Make Action Button update database, re-read example_match_file.tsv and rerun all calculations.
# datasetInput <- observeEvent(input$update, {
# ???
# })
}
# Run the application
shinyApp(ui = ui, server = server)
If I'm reading this right you'd like to spare your query limit by providing a local set of data to your shiny application. But if a user requests an update you'd like to trigger a query to be used in calculations.
I cannot recommend enough that you make full use of reactivity in Shiny. It is fairly rare to use an object from the global environment, especially when you intend for user inputs to manipulate those objects. You should have your base data ( in your case the tsv) load into the global environment, and then call that information into your application via a reactive dataframe. I built the below minimal example using mpg subset to the first 5 rows to simulate the .tsv on your local machine. mpg subset to 10 rows is to simulate the results of a query to a database. These two data sets get called via an if else statement dependent on an actionbutton.
library(tidyverse)
library(shiny)
# using partial mpg data to simulate un-updated data
mpg <- ggplot2::mpg[1:5,]
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("update", "Update Data"),
uiOutput('selectOpts')
),
mainPanel(
h2("This is our base data layer"),
verbatimTextOutput('print_interval1'),
h2("This is our output data"),
verbatimTextOutput('print_interval2')
)
)
)
server <- function(input, output) {
# The core of shiny is the reactivity. It's the workhorse of interactive apps.
# If possible, a data calculation should always happen in a reactive context.
working_data <- reactive({
# actionbuttons increment a value by 1, starting with 0. If input < 0 the
# user has not interacted yet. If incremented again, the reactive context
# will invalidate and re-calculate the working_data() object
if (input$update < 1) {
base_dat <-
mpg %>%
mutate(ratio = cty/hwy)
} else {
base_dat <-
ggplot2::mpg[1:10,] %>% # calling from namespace to simulate a query. Full data
mutate(ratio = cty/hwy)
}
# return our base data. Can be called with `working_data()`
data.frame(base_dat)
})
output$print_interval1 <- renderPrint({
working_data()
})
output$selectOpts <- renderUI({
# using the reactive data inside renderUI we can be flexible in our options
# this lets us adapt the UI to reactive data.
radioButtons('model',
"Select Model",
sort(unique(working_data()$model)))
})
# You can also chain reactive objects.
output_data <- reactive({
working_data() %>%
group_by(model) %>%
filter(model == input$model) %>%
summarise(m.ratio = mean(ratio))
})
output$print_interval2 <- renderPrint({
output_data() %>%
data.table()
})
}
shinyApp(ui = ui, server = server)
I also recommend looking into this post about database syncing for setting up triggers and using reactive objects as your applications get more complex. I hope that's enough to get you on the right track for both your initial question about updating data, and your comments about having your inputs react to updated data.
I am new to Shiny. I was trying to subset a data frame and the data frame, but encountered an error message:
"Can't access reactive value 'xx' outside of reactive consumer."
Could anybody tell me why?
The design idea is to (1) let the users to select the subgroup that they'd like to look into, which I tried to accomplish using the reactiveValues() command but failed, and then (2), an delayed action, which is within that subgroup, sort the data based on a key variable. Below are the codes, and I appreciate your help:
library(shiny)
library(tidyverse)
data(iris)
ui <- fluidPage(
navbarPage(
title = "Test",
tabsetPanel(
tabPanel(
"Tab 3, subset and then sort",
sidebarLayout(
sidebarPanel(
selectInput("xx", "species:", choices = unique(iris$Species), selected = "setosa"),
actionButton("click", "sort")
),
mainPanel(
tableOutput("table3")
)
)
)
)
)
)
server <- function(input, output) {
rv <- reactiveValues(
#### This line caused a problem whenever I added %>% dplyr::filter ####
df3 = iris %>% dplyr::filter(Species == !!input$xx)
)
observeEvent(input$click, {
rv$df3 <- rv$df3[order(rv$df3$Sepal.Length), ]
})
output$table3 <- renderTable({
rv$df3
})
}
# Run the application
app <- shinyApp(ui = ui, server = server)
runApp(app)
reactiveValues should be used like a list of values that are updated/evaluated within reactive/observe blocks. It's being used incorrectly here, I think you should be using reactive or eventReactive.
Double-bang !! is relevant for NSE (non-standard evaluation) within rlang (and much of the tidyverse), but that's not what you're doing here. In your case, input$xx is character, in which case you can simply compare to it directly, ala Species == input$xx.
Sometimes, depending on the startup of an app, the reactive is triggered before the input has a valid value, instead it'll be NULL. This causes an error and glitches in the shiny interface, and can be avoided by the use if req.
Unfortunately, you can't resort a reactive data block outside of it.
Here's one alternative:
server <- function(input, output) {
rv_unsorted <- reactive({
req(input$xx)
dplyr::filter(iris, Species == input$xx)
})
rv_sorted <- reactive({
req(input$click)
dplyr::arrange(isolate(rv_unsorted()), Sepal.Length)
})
output$table3 <- renderTable({
rv_sorted()
})
}
Another method, which is less efficient (more greedy, less lazy),
server <- function(input, output) {
rv <- reactiveVal(iris)
observeEvent(input$xx, {
rv( dplyr::filter(iris, Species == input$xx) )
})
observeEvent(input$click, {
rv( dplyr::arrange(rv(), Sepal.Length) )
})
output$table3 <- renderTable({
rv()
})
}
This may seem more straight-forward logically, but it will do more work than will technically be necessary. (observe blocks are greedy, firing as quickly as possible, even if their work is not used/noticed. reactive blocks are lazy in that they will never fire unless something uses/needs them.)
Edit: I corrected the previous behavior, which was:
Load iris, have all species present, store in rv().
Immediately filter, showing just setosa, store in rv().
Display in the table.
Change selector to a new species.
Filter the contents of rv() so that only the new species are in the frame. Unfortunately, since the contents of rv() were just setosa, this next filtering removed all rows.
The means that the current observe-sequence (as greedy and inefficient as it may be) must start with a fresh frame at some point, so I changed the input$xx observe block to always start from iris.