I've got the same module called 2 time within my application. In one of the call I've a "static" data.frame while in the second call I would like to pass a reactive value.
Is it possible to pass reactive and static value to the same shiny module?
If this is not possible should be better to develop 2 version of the same module or convert to reactive also the other data frame?
#--- Reactive Values ----
reactive_selected_account <- reactive({ input$budget_slider })
reactive_monthly_total <- reactive({
monthly_total %>%
filter( account==reactive_selected_account() ) %>%
group_by(dt) %>%
select(-account) %>%
function_do_monthly_total()
})
#--- Components Calls ----
callModule(component_srv, "istance1", data=monthly_total)
callModule(component_srv, "istance1", data=reactive_monthly_total() )
You can write the module in a way where a reactive value is expected
component_srv <- function(input, output, session, reactive_parameter) {
observeEvent(reactive_parameter(), {
# ...
}
# ...
}
Then you can choose to pass a static value by just wrapping reactive() around it.
static_object <- iris
callModule(component_srv, "instance",
reactive_parameter = reactive(static_object))
reactive_object = reactive({
get_data(input$dataset)
})
callModule(component_srv, "instance2",
reactive_parameter = reactive_object)
Note that you need to use reactive_object rather than reactive_object() in callModule() to make this work.
Related
I have a shiny app, where I test the server component using testthat and testServer. The server part of the app has a couple of reactive values but also renders some elements in an observe() element (I group multiple renders together for performance reasons).
A simple server + testServer example function looks like this
library(shiny)
library(dplyr)
library(testthat)
server <- function(input, output, session) {
data <- reactive(mtcars)
observe({
print("Observe is active")
# do some further analysis on the data here
data2 <- data() |> filter(mpg > 20)
output$nrows <- renderUI(nrow(data2)) # 14
output$unique_mpgs <- renderUI(length(unique(data2$mpg))) # 10
})
}
testServer(server, {
expect_equal(data(), mtcars) # works because data() is a reactive() not observe()...
# how can I test here that nrows == 14 and unique_mpgs == 10
})
As mentioned earlier, I don't want to have multiple reactive values (eg one for nrows, then another for unique_mpgs) if possible.
Is there a way to check the value of an observe element in testServer?
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.
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.
I'm trying to get a reactiveValue that is depending on a reactive. In the real code (this is a very simplified version), I load a dataset interactively. It changes when pushing the buttons (prevBtn/nextBtn). I need to know the number of rows in the dataset, using this to plot the datapoints with different colors.
The question: Why can't I use the reactive ro() in the reactiveValues function?
For understanding: Why is the error saying "You tried to do something that can only be done from inside a reactive expression or observer.", although ro() is used inside a reactive context.
The error is definitely due to vals(), I already checked the rest.
The code :
library(shiny)
datasets <- list(mtcars, iris, PlantGrowth)
ui <- fluidPage(
mainPanel(
titlePanel("Simplified example"),
tableOutput("cars"),
actionButton("prevBtn", icon = icon("arrow-left"), ""),
actionButton("nextBtn", icon = icon("arrow-right"), ""),
verbatimTextOutput("rows")
)
)
server <- function(input, output) {
output$cars <- renderTable({
head(dat())
})
dat <- reactive({
if (is.null(rv$nr)) {
d <- mtcars
}
else{
d <- datasets[[rv$nr]]
}
})
rv <- reactiveValues(nr = 1)
set_nr <- function(direction) {
rv$nr <- rv$nr + direction
}
observeEvent(input$nextBtn, {
set_nr(1)
})
observeEvent(input$prevBtn, {
set_nr(-1)
})
ro <- reactive({
nrow(dat())
})
output$rows <- renderPrint({
print(paste(as.character(ro()), "rows"))
})
vals <- reactiveValues(needThisForLater = 30 * ro())
}
shinyApp(ui = ui, server = server)
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
I think you want
vals <- reactiveValues(needThisForLater = reactive(30 * ro()))
Not everything in a reactiveValues list is assumed to be reactive. It's also a good place to store constant values. So since it's trying to evaluate the parameter you are passing at run time and you are not calling that line in a reactive environment, you get that error. So by just wrapping it in a call to reactive(), you provide a reactive environment for ro() to be called in.
So, I've been on google for hours with no answer.
I want to create a user-defined function inside the server side that takes inputs that I already know to wrap reactive({input$feature)} but the issue is how to incorporate reactive values as inputs too.
The reason why I want to do this is because I have a navbarPage with multiple tabs that shares elements such as same plots. So I want a user defined function that creates all the similar filtering and not have to create multiple of the same reactive expression with different input and reactive variable names which take up 2000+ lines of code.
server <- function(input, output) {
filtered_JointKSA <- reactiveVal(0)
create_filtered_data <- function(df, input_specialtya, filtered_JointKSA) {
if (input_specialtya == 'manual') {
data <- filter(data, SPECIALTY %in% input_specialtyb)
}
if (filtered_JointKSA != 0) {
data <- filter(data, SPECIALTY %in% filtered_JointKSA)
}
reactive({return(data)})
}
filtered_data <- create_filtered_data(df,
reactive({input$specialty1}),
filtered_JointKSA())
observeEvent(
eventExpr = input$clickJointKSA,
handlerExpr = {
A <- filtered_JointKSA(levels(fct_drop(filtered_data()$`Joint KSA Grouping`))[round(input$clickJointKSA$y)])
A
}
)
This gets me an error:
"Error in match(x, table, nomatch = 0L) :
'match' requires vector arguments"
The error is gone if I comment out where I try to create filtered_data but none of my plots are created because filtered_data() is not found.
What is the correct approach for this?
Ideally, I would like my observeEvents to be inside user defined functions as well if that has a different method.
This example may provide some help, but it's hard to tell without a working example. The change is to wrap the call to your function in reactive({}) rather than the inputs to that function, so that the inputs are all responsive to user input and the function will update.
library(shiny)
ui <- fluidPage(
numericInput("num", "Number", value = NULL),
verbatimTextOutput("out")
)
server <- function(input, output){
## User-defined function, taking a reactive input
rvals <- function(x){
req(input$num)
if(x > 5){x * 10} else {x*1}
}
# Call to the function, wrapped in a reactive
n <- reactive({ rvals(input$num) })
# Using output of the function, which is reactive and needs to be resolved with '()'
output$out <- renderText({ n() })
}
shinyApp(ui, server)