Create a Reactive Function Outside the Shiny App

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



Leave a reply



Submit