Beginner to R and shiny here!
Tried to make a minimal working example... I want to check a condition on a reactive input value. What am I doing wrong?
library(shiny)
ui<-fluidPage(
numericInput(inputId="a", label=NULL, value=0),
textOutput(outputId="out")
)
server <- function(input, output) {
x <- reactive(input$a)
if (x() < 4)
{y<-1}
else
{y<-0}
output$out <- renderText({y})
}
shinyApp(ui = ui, server = server)
The error message:
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.)
You just need to use reactive with your if so that shiny knows that y changes when x does.
library(shiny)
ui<-fluidPage(
numericInput(inputId="a", label=NULL, value=0),
textOutput(outputId="out")
)
server <- function(input, output) {
x <- reactive(input$a)
y <- reactive( if (x()<4) 1 else 0 )
output$out <- renderText({ y() })
}
shinyApp(ui = ui, server = server)
The answer above from John Paul is certainly acceptable, but I thought you might like to see another way as a part of your learning process. I will let StackOverflow sort out which is more advisable.
library(shiny)
ui<-fluidPage(
numericInput(inputId="a", label=NULL, value=0),
textOutput(outputId="out")
)
server <- function(input, output) {
state <- reactiveValues()
observe({
state$x <- input$a
state$y <- ifelse(state$x < 4, 1, 0)
})
output$out <- renderText({ state$y })
}
shinyApp(ui = ui, server = server)
here's my attempt.
1) as stated, you don't need to wrap input$a in reactive context and save as x. just use input$a
2) you don't need reactiveValues in this simple example. just save y as a reactive variable. then, in the renderText, access by calling the function ("y()")
library(shiny)
ui<-fluidPage(
numericInput(inputId="a", label=NULL, value=0),
textOutput(outputId="out")
)
server <- function(input, output) {
y <- reactive({
if (input$a < 4) {
return(1)
} else {
return(0)
}
}
)
output$out <- renderText({y()})
}
shinyApp(ui = ui, server = server)
Related
I have a package built so that I am able to test functions using test that. I have 2 scenarios where I test function. One scenario works fine (Sce. A) and other (Sce. B) does not work
Sce.B
## app.R (location : D:/Windows/Analytics/R Programming/GitHub/App/pacakge1)
library(shiny)
ui <- fluidPage(
numericInput("x", "X", value = 5),
textOutput("txt"),
actionButton("button", "Submit")
)
server <- function(input, output, session) {
server_1(input, output, session , y1)
}
shinyApp(ui, server)
## file. R (Location : D:/Windows/Analytics/R Programming/GitHub/App/pacakge1/R
server_1 <- function(input, output, session , y1){
y1 <- reactiveValues(a = 0)
function1 <- function(){
y1$a = 2 * input$x
}
observeEvent(input$button,{
function1()
})
output$txt <- renderText({
y1$a
})
}
## test server (location : D:/Windows/Analytics/R Programming/GitHub/App/pacakge1/tests/testthat)
library(testthat)
library(shinytest)
library(shiny)
testServer(expr = {
# y1 <- session$getReturned()
session$setInputs(x = 7)
function1()
expect_equal(y1$a, 14)
})
When I test above above scenario (Sce. B). It does not work well. So I need to test if y1$a returns 14 or not
But scenario A below works well since I am not writing server function outside
Sce.A
##app.R (Same location as above)
library(shiny)
ui <- fluidPage(
numericInput("x", "X", value = 5),
textOutput("txt"),
actionButton("button", "Submit")
)
server <- function(input, output, session) {
y1 <- reactiveValues(a = 0)
function1 <- function(){
y1$a = 2 * input$x
}
observeEvent(input$button,{
function1()
})
output$txt <- renderText({
y1$a
})
}
shinyApp(ui, server)
##test server (same location as above)
library(testthat)
library(shinytest)
library(shiny)
testServer(expr = {
# y1 <- session$getReturned()
session$setInputs(x = 7)
function1()
expect_equal(y1$a, 14)
})
Above test passes and allworks well..
But Scenario B is not working.
So the question is here, can we not test functions from other files?
I'm working on a shiny app that streams data and am updating the UI via renderTable every second. When the app renders the table dims between each update which is annoying from a visual perspective. Is there a way to disable this behavior?
output$table_state <- renderTable({
invalidateLater(1000)
get_table_state()
})
If get_table_state() performs a long computation, you can try to execute it outside renderTable(). Notice the use of observe here.
Example app
library(shiny)
library(tidyverse)
long_calculation <- function() {
Sys.sleep(1)
iris
}
ui <- fluidPage(
fluidRow(
column(width = 6,
tableOutput('table_slow')),
column(width = 6, tableOutput('table2')))
)
server <- function(input, output, session) {
df <- reactiveValues(x = NULL)
output$table_slow <- renderTable({
invalidateLater(1000)
long_calculation()
})
iris_no_dim <- observe({
invalidateLater(1000)
df$x <- long_calculation()})
output$table2 <- renderTable({
df$x
})
}
shinyApp(ui, server)
I'm trying to dynamically create some content with a for loop using renderUI and uiOutput but every rendered element only contains the information from the last iteration in the for loop. Example:
require(shiny)
ui <- fluidPage(
uiOutput("out1"),
uiOutput("out2")
)
server <- function(input, output, session) {
count <- 1
for(a in c("hello", "world")){
name <- paste0("out", count)
output[[name]] <- renderUI({
strong(a)
})
count <- count + 1
}
}
shinyApp(ui = ui, server = server)
This outputs world twice instead of hello world
It works when using sapply instead of a for loop:
require(shiny)
ui <- fluidPage(
uiOutput("out1"),
uiOutput("out2")
)
server <- function(input, output, session) {
vec <- c("hello", "world")
sapply(seq_along(vec), function(x) {
name <- paste0("out", x)
output[[name]] <- renderUI({
strong(vec[x])
})
})
}
shinyApp(ui = ui, server = server)
As an alternative to Alexandre's answer I figured out using local({}) also works thanks to Zygmunt Zawadzki's comment:
ui <- fluidPage(
uiOutput("out1"),
uiOutput("out2")
)
server <- function(input, output, session) {
count <- 1
for(a in c("hello", "world")){
local({
b <-a #this has to be added as well
name <- paste0("out", count)
output[[name]] <- renderUI({
strong(b)
})
})
count <- count + 1
}
}
shinyApp(ui = ui, server = server)
I have 4 action buttons...but want same return value name. Since it is used in other elements. I initialize the reactive element as
myReactiveDF <- reactiveValues(data=NULL)
myReactiveDF <- eventReactive(input$action1, {
call functions
return(dataframe)
})
myReactiveDF <- eventReactive(input$action2, {
call functions
return(dataframe)
})
.....
However only the last button 4 works. The first three do not.
All the other elements use the same reactive element (dataframe) to get populated.
I tried observeEvent but it doesn't return values.
The following code should address your requirement as I understand them:
library(shiny)
ui <- fluidPage(
fluidRow(column(2, selectInput('action1', label = "Action1:", choices = c('a','b') )),
column(4, selectInput('action2', label = "Action2:", choices = c('A','B') ))),
fluidRow( verbatimTextOutput("outputs"))
)
server = function(input, output, session){
v <- reactiveValues(data = NULL)
observeEvent(input$action1, {
v$data <- input$action1
})
observeEvent(input$action2, {
v$data <- input$action2
})
output$outputs <- renderText({
if (is.null(v$data)) return()
v$data
})
}
shinyApp(ui = ui, server = server)
If what you need is different, please let me know so that I can amend the answer.
How can I display value only on the browser?
Below is my code.
ui <- shinyUI(bootstrapPage(
absolutePanel(
textOutput("renderText1")
)
)
)
server <- function(input,output,session)
{
observeEvent(input$dropdown, {
query <- sprintf("select ....",input$dropdown)
cabinet_info <- dbGetQuery(con,query)
output$renderText1 <- renderText({
paste(cabinet_info)
})
})
}
Below are the outputs:
c('a','w','r','t')
While Geovany's answer may work, it is not a good practice to use observeEvent with the global assignment operator (<<-).
If you would like to execute a side effect (e.g. writing a file, plotting, printing), then you can use observe or observeEvent, but if you want to use a return value, use eventReactive instead.
ui <- shinyUI(bootstrapPage(
absolutePanel(
selectInput("dropdown", label = 'SelectInput', choices = c('A', 'B')),
textOutput("renderText1")
)
)
)
server <- function(input,output,session)
{
cab <- eventReactive(input$dropdown, {
query <- sprintf("select ....",input$dropdown)
#cabinet_info <- dbGetQuery(con,query) #Replaced by a constant
cabinet_info <- paste(c(input$dropdown, 'a','w','r','t'), sep=",")
})
output$renderText1 <- renderText({
cab()
})
}
shinyApp(ui, server)
Call eventReactive from the server side just like a function: cab()
This could help you
runApp(list(
ui = shinyUI(bootstrapPage(
absolutePanel(
actionButton("dropdown", "dropdown"),
textOutput("renderText1")
)
)
),
server = shinyServer(function(input, output) {
cabinet_info <- NULL
observeEvent(input$dropdown, {
cabinet_info <<- c('a','w','r','t')
})
output$renderText1 <- renderText({
input$dropdown
paste(cabinet_info, collapse = ',')
})
})
))