Create a reactive function outside the shiny app
Shiny modules is what might help you.
See here: https://shiny.rstudio.com/articles/modules.html
As you can read in the article the desired functionality to pass in input is possible if you wrap the input in a reactive()
function. (See the end of the "Writing server functions" section of the article).
You would define the my_sum
function as follows:
(Note that you have to use the variables a
and b
as reactives a()
and b()
and wrap the result in a reactive()
function.)
my_sum <- function(input, output, session, a, b) {
reactive(as.numeric(a()) + as.numeric(b()))
}
And could use it as:
my_sum_reactive <- callModule(my_sum, "id", reactive(input$a), reactive(input$b))
which is then usable as:
my_sum_reactive()
Reproducible example:
library(shiny)
my_sum <- function(input, output, session, a, b) {
reactive(as.numeric(a()) + as.numeric(b()))
}
ui <- fluidPage({
fluidRow(
selectInput("a", "a", 1:3),
selectInput("b", "b", 1:3),
textOutput("txt")
)
})
server <- function(input, output, session) {
my_sum_reactive <- callModule(my_sum, "id", reactive(input$a), reactive(input$b))
output$txt <- renderText(paste0("The sum is: ", my_sum_reactive()))
}
shinyApp(ui, server)
Call reactive function() outside the shiny app
You cannot define a function in the server (or ui) and then use it outside, nor call inputs values outside of a shiny app. What you can do is write your functions outside of the server (in another file for example), source it, and pass your inputs or reactive as arguments to these functions
library(shiny)
# in script.R
myfunction <- function(argument1){
return(as.numeric(argument1))
}
# in app.R
#source("script.R")
ui <- fluidPage(
numericInput("price", "Price", value=1, min=1 , max=10)
,textOutput("text")
)
server <- function(input, output, session) {
price <- reactive(myfunction(argument1 = input$price))
output$text<- renderText(price())
}
shinyApp(ui, server)
How can I summarize reactive data from outside a render function in a Shiny app?
Here's a few ideas - but there are multiple approaches to handling this, and you probably want to restructure your server
function a bit more after working with this further.
First, you probably want a reactive
expression that will update your model based on vals$keeprows
as this changes with your clicks. Then, you can access the model results from this expression from both your plot and data table.
Here is an example:
fit_model <- reactive({
## Keep and exclude based on reactive value keeprows
keep = cdat[ vals$keeprows, , drop = FALSE]
exclude = cdat[!vals$keeprows, , drop = FALSE]
## Fits circular model specifically for 'keeprows' of selected data
k_circlm <- lm.circular(type = "c-c", y = keep$cthetarad, x = keep$cpsirad, order = 1)
## Returns list of items including what to keep, exclude, and model
list(k_circlm = k_circlm, keep = keep, exclude = exclude)
})
It will return a list
that you can access from the plot:
output$k <- renderPlot({
exclude <- fit_model()[["exclude"]]
keep <- fit_model()[["keep"]]
k_circlm <- fit_model()[["k_circlm"]]
ggplot(keep, aes(cthetarad, cpsirad)) +
...
And can access the same from your table (though you have as renderPlot
?):
output$s <- renderPlot({
keep = fit_model()[["keep"]]
k_circ.lm <- fit_model()[["k_circlm"]]
# Create Summary table
summarytable <- data.frame(matrix(ncol = 4, nrow = nrow(keep)))
...
Note that because the table length changes with rows kept, you might want to use nrow(keep)
as I have above, rather than nrow(cdat)
, unless I am mistaken.
I also loaded gridExtra
library for testing this.
I suspect there are a number of other improvements you could consider, but thought this might help you get to a functional state first.
Creating a reactive and memoizable function outside of shiny context
Sorry for not quite understanding the rlang stuff. But could you just call the foo()
function in a reactive expression, wrapping it in a function to pass args if needed? I tried tweaking approach 2 like this:
library(shiny)
library(rlang)
options(shiny.suppressMissingContextError=TRUE)
shiny:::setAutoflush(TRUE)
makeReactiveBinding("x_react")
makeReactiveBinding("foo")
foo <- function(x_react = get("x_react", 1), y = c("a", "b")) {
message("Executing foo()")
try(print(missing(x_react)))
try(print(match.arg(y)))
x_react * 10
}
foo_react <- function(...) {
reactive({
foo(...)
})
}
## no args
f <- foo_react()
x_react <- 1
f()
# Executing foo()
# [1] TRUE
# [1] "a"
# [1] 10
f()
# [1] 10
x_react <- 10
f()
# Executing foo()
# [1] TRUE
# [1] "a"
# [1] 100
f()
# [1] 100
## with args
f <- foo_react(x_react = 3, y = "b")
f()
# Executing foo()
# [1] FALSE
# [1] "b"
# [1] 30
f()
# [1] 30
R Shiny: Can't access reactive value outside of reactive consumer
The problem is that, as the error suggests, divider
is reactive, but you are using it outside of the reactive environment. For example, variables like ind_rur
need to be recomputed each time divider
changes, but in your code they are computed only once.
Try this for your server
function:
shinyServer(function(input, output) {
div_ru <- reactive({
input$divider
})
# dividing on the basis of rural and urban
ind_rur <- reactive({ind_urca > div_ru()})
ind_urb <- reactive({ind_urca <= div_ru()})
ind_rur_star <- reactive({st_as_stars(ind_rur())})
ind_urb_star <- reactive({st_as_stars(ind_urb())})
output$plot1 = renderPlot({
plot(ind_rur_star())
})
output$plot2 = renderPlot({
plot(ind_urb_star())
})
output$download1 = downloadHandler(
filename = function() {
paste0("rural_raster_", div_ru(), ".tif")
},
content = function(file) {
write_stars(ind_rur_star(), file, layer = 1)
}
)
output$download2 = downloadHandler(
filename = function() {
paste0("urban_raster_", div_ru(), ".tif")
},
content = function(file) {
write_stars(ind_urb_star(), file, layer = 1)
}
)
})
How to separately time multiple reactive functions in R Shiny App?
Here is one solution using a reactiveVal
to store the total time, and increment it within each reactive
data computation.
library(DT)
library(shiny)
library(dplyr)
library(data.table)
data <-
data.frame(
ID = c(1,1,1,2,2,2,3,3,3),
Period = c(1, 2, 3, 1, 2, 3, 1, 2, 3),
Values = c(5, 10, 15, 0, 2, 4, 3, 6, 9),
State = c("X0","X1","X2","X0","X2","X0", "X2","X1","X9")
)
numTransit <- function(x, from=1, to=3){
setDT(x)
unique_state <- unique(x$State)
all_states <- setDT(expand.grid(list(from_state = unique_state, to_state = unique_state)))
dcast(x[, .(from_state = State[from],
to_state = State[to]),
by = ID]
[,.N, c("from_state", "to_state")]
[all_states,on = c("from_state", "to_state")],
to_state ~ from_state, value.var = "N"
)
}
ui <- fluidPage(
tags$head(tags$style(".datatables .display {margin-left: 0;}")),
h4(strong("Transition table inputs:")),
numericInput("transFrom", "From period:", 1, min = 1, max = 3),
numericInput("transTo", "To period:", 2, min = 1, max = 3),
h4(strong("Output transition table:")),
DTOutput("resultsDT"),
h4(strong("Extract of above transition table:")),
tableOutput("resultsPlot"),
# Display execution time results:
verbatimTextOutput(outputId = "timer", placeholder = TRUE)
)
server <- function(input, output, session) {
# Start timer off at zero
timer_total <- reactiveVal(0)
# Display execution time:
output$timer <- renderText({
req(timer_total())
paste0("Executed in: ", round(timer_total()*1000), " milliseconds")
})
results <- reactive({
tm <- system.time({
results <- numTransit(data, input$transFrom, input$transTo) %>%
replace(is.na(.), 0) %>%
bind_rows(summarise_all(., ~(if(is.numeric(.)) sum(.) else "Sum")))
results <- cbind(results, Sum = rowSums(results[,-1]))
# some extra time here
Sys.sleep(0.25)
results <- results %>%
mutate(across(-1, ~ .x / .x[length(.x)])) %>%
replace(is.na(.), 0) %>%
mutate(across(-1, scales::percent_format(accuracy = 0.1)))
})
# without isolate() here you'll get an infinite loop
isolate(
timer_total(timer_total() + tm[["elapsed"]])
)
results
})
extractResults <- reactive({
tm <- system.time({
extractResults <-
data.frame(lapply(results()[1:nrow(results())-1,2:nrow(results())],
function(x) as.numeric(sub("%", "", x))/100))
Sys.sleep(0.5)
row.names(extractResults) <- colnames(extractResults)
})
isolate(
timer_total(timer_total() + tm[["elapsed"]])
)
extractResults
})
output$data <- renderTable(data)
output$resultsDT <- renderDT(server=FALSE, {datatable(data = results())})
output$resultsPlot <- renderTable({extractResults()},rownames=TRUE)
}
shinyApp(ui, server)
Shiny: how to make a reactive input for a conditional filter in this case?
As you correctly assumed in your question R pretty much gives you the answer in the error message:
Input `..1` is `Alias == input$id`.
x Can't access reactive value 'id' outside of reactive consumer.
i Do you need to wrap inside reactive() or observe()?
you cant access the value within input$id
outside of a reactive context. Just wrap your assignment of df_kpi1
into a reactive, e.g.:
df_kpi1 <- reactive(data %>%
...
...
)
This should solve your issue.
EDIT: Your example
# shiny lib
library(shiny)
library(shinydashboard)
# core
suppressPackageStartupMessages(library(tidyverse))
suppressPackageStartupMessages(library(DT))
#### UI
ui <- dashboardPage(
dashboardHeader(title = "TEST"),
dashboardSidebar(
sidebarMenu(id = "tabs",
menuItem("Inspection",
tabName = "analyze"
)
)
),
dashboardBody(
tabItems(
tabItem(tabName = "analyze",
selectInput(inputId = "id",
label = "Select",
choices = "",
selected = ""),
mainPanel(width = 100,
fluidPage(
fluidRow(dataTableOutput("ts_kpi1.1")
)
)
)
)
)
)
)
#### SERVER
server <- function(input, output, session) {
data <- tibble(value = c(c(10000.33,15000.55),c(12000.99,33005.44)),
Alias = c(rep("A",2),rep("B",2))
)
updateSelectInput(session ,
"id",
choices = unique(data$Alias)
)
DT_kpi1 <- reactive({
df_kpi1 <- data %>%
dplyr::filter(Alias == input$id) %>%
summarise(Mean = mean(value),
Median = median(value)
) %>% as_tibble() %>%
mutate_if(is.numeric, ~round(., 0)
)
DT_kpi1 <- datatable(df_kpi1,
options = list(
scrollX = FALSE,
autoWidth = TRUE,
bFilter = 0,
bInfo = FALSE,
bPaginate = FALSE,
lengthChange = FALSE,
columnDefs = list(list(searchable = FALSE, targets = "_all"),
list(targets = c(0), visible = TRUE),
list(searching = FALSE),
list(ordering=F)
)
),
rownames = FALSE ) %>%
formatCurrency(columns = c(1:2), currency = "", interval = 3, mark = ".")
DT_kpi1
})
output$ts_kpi1.1 <- DT::renderDataTable({
DT_kpi1()
})
}
runApp(list(ui = ui, server = server),launch.browser = TRUE)
Related Topics
Unexpected Symbol Error in Parse(Text = Str) with Hyphen After a Digit
Force a Regular Plot Object into a Grob for Use in Grid.Arrange
Q-Q Plot with Ggplot2::Stat_Qq, Colours, Single Group
In R, Check If String Appears in Row of Dataframe (In Any Column)
Splitting String Based on Letters Case
How to Replace Multiple Strings with the Same in R
Regex; Eliminate All Punctuation Except
What Does < Stand for in Data.Table Joins with On=
R 3.0.3 Rbind Multiple CSV Files
Keep Only Groups of Data with Multiple Observations
Why Does Subsetting a Column from a Data Frame VS. a Tibble Give Different Results
Create a Reactive Function Outside the Shiny App
How to Make a Barplot with R from a Table
Highlight a Line in Ggplot with Multiple Lines
Get Dates of a Certain Weekday from a Year in R
General Guide for Creating Publication Quality Tables Using R, Sweave, and Latex