在许多反应对象中使用 if 语句不起作用

Question

我想用我的 currentvariable5() 反应对象创建某种情节 if == "A" ( if(currentvariable5()=="A"){}) 和另一个 if == "B" (else{}).但我在几篇文章中尝试了很多技巧，输出总是：

Warning: Error in : Operation not allowed without an active reactive context.
* You tried to do something that can only be done from inside a reactive consumer.
  55: <Anonymous>
Error : Operation not allowed without an active reactive context.
* You tried to do something that can only be done from inside a reactive consumer.

这是我的例子：

library(leaflet)
library(leaflet.providers)
library(ggplot2)
library(shinythemes)
library(sf)
library(lubridate)
library(dplyr)
library(rgdal)


# get AOI
download.file(
  "https://github.com/Leprechault/trash/raw/main/stands_example.zip",
  zip_path <- tempfile(fileext = ".zip")
)
unzip(zip_path, exdir = tempdir())

# Open the files
setwd(tempdir())
stands_extent <- readOGR(".", "stands_target") # Border
stands_ds <- read.csv("pred_target_stands.csv", sep=";") # Data set
stands_ds <- stands_ds %>%
  mutate(DATA_S2 = ymd(DATA_S2))
stands_ds$CLASS<-c(rep("A",129),rep("B",130)) 
stands_ds$CD<-abs(rnorm(length(stands_ds[,1]),mean=50))

# Create the shiny dash
ui <- fluidPage(
  theme = shinytheme("cosmo"),
  titlePanel(title="My Map Dashboard"),  
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "selectedvariable0",
                  label = "Type", 
                  choices = c(unique(stands_ds$PEST)),selected = TRUE ), 
      selectInput(inputId = "selectedvariable1",
                  label = "Date", 
                  choices = c(unique(stands_ds$DATA_S)),selected = TRUE ), 
      selectInput(inputId = "selectedvariable2",
                  label = "Project", 
                  choices = c(unique(stands_ds$PROJETO)),selected = TRUE ),
      selectInput(inputId = "selectedvariable3",
                  label = "Stand", 
                  choices = c(unique(stands_ds$CD_TALHAO)),selected = TRUE),
      selectInput(inputId = "selectedvariable4",
                  label = "Unique ID", 
                  choices = c(unique(stands_ds$ID_UNIQUE)),selected = TRUE),
      selectInput(inputId = "selectedvariable5",
                  label = "Class", 
                  choices = c(unique(stands_ds$CLASS)),selected = TRUE)            
    ),
    mainPanel(
      textOutput("idSaida"),
      fluidRow(
        splitLayout(plotOutput("myplot"))),
      dateInput(inputId = "Dates selection", label = "Time"),
      leafletOutput("map") 
    )
  )
)
server <- function(input, output){
  
  currentvariable0 <- reactive({input$selectedvariable0})
  currentvariable1 <- reactive({input$selectedvariable1})
  currentvariable2 <- reactive({input$selectedvariable2})
  currentvariable3 <- reactive({input$selectedvariable3})
  currentvariable4 <- reactive({input$selectedvariable4})
  currentvariable5 <- reactive({input$selectedvariable5})
  
  if(currentvariable5()=="A"){
    
    
    output$myplot <- renderPlot({
      
      #Subset stand
      stands_sel <- subset(stands_extent, stands_extent@data$ID_UNIQUE==currentvariable4())
      
      #Subset for input$var and assign this subset to new object, "fbar"
      ds_sel<- stands_ds[stands_ds$ID_UNIQUE==currentvariable4(),]
      
      #Create a map
      polys <- st_as_sf(stands_sel)
      ggplot() +
        geom_sf(data=polys) +
        geom_point(data=ds_sel,
                   aes(x=X, y=Y), color="red") +
        xlab("Longitude") + ylab("Latitude") +
        coord_sf() +
        theme_bw() +
        theme(text = element_text(size=10)) 
    })
  } else {
    
    #Subset stand
    stands_sel <- subset(stands_extent, stands_extent@data$ID_UNIQUE==currentvariable4())
    
    #Subset for input$var and assign this subset to new object, "fbar"
    ds_sel<- stands_ds[stands_ds$ID_UNIQUE==currentvariable4(),]
    
    #Create a map
    polys <- st_as_sf(stands_sel)
    ggplot() +
      geom_sf(data=polys) +
      geom_raster(data = stands_sel, aes(x = X, y = Y, fill = CD)) + 
      scale_fill_gradientn(name="Desfolha (%)",colours = terrain.colors(100))+
      xlab("Longitude") + ylab("Latitude") +
      coord_sf() +
      theme_bw() +
      theme(text = element_text(size=10)) 
    
  }
  
  output$map <- renderLeaflet({
    
    stands_actual<-stands_ds[stands_ds$ID_UNIQUE==currentvariable4(),]
    lng <- mean(stands_actual$X)
    lat <- mean(stands_actual$Y)
    
    leaflet() %>%
      setView(lng = lng, lat = lat, zoom=17) %>%
      addProviderTiles(providers$Esri.WorldImagery) %>%                   
      addMarkers(lng=stands_actual$X, lat=stands_actual$Y, popup="Location")
    
  })   
}
shinyApp(ui, server)
##

拜托，有解决这个问题的技巧吗？提前致谢！！！

Answer 1

我们可以将 if-else 语句包装在 observe() 中。 reactive() 未被调用的原因是因为我们实际上对此处的副作用感兴趣（例如声明输出 $myplot。此外，每当输入 $. . 之所以被调用是因为它旨在根据用户的输入进行更改。

library(leaflet)
library(leaflet.providers)
library(ggplot2)
library(shinythemes)
library(sf)
library(lubridate)
library(dplyr)
library(rgdal)
library(rgeos)

# get AOI
download.file(
    "https://github.com/Leprechault/trash/raw/main/stands_example.zip",
    zip_path <- tempfile(fileext = ".zip")
)
unzip(zip_path, exdir = tempdir())

# Open the files
setwd(tempdir())
stands_extent <- readOGR(".", "stands_target") # Border
stands_ds <- read.csv("pred_target_stands.csv", sep=";") # Data set
stands_ds <- stands_ds %>%
    mutate(DATA_S2 = ymd(DATA_S2))
stands_ds$CLASS<-c(rep("A",129),rep("B",130)) 
stands_ds$CD<-abs(rnorm(length(stands_ds[,1]),mean=50))

# Create the shiny dash
ui <- fluidPage(
    theme = shinytheme("cosmo"),
    titlePanel(title="My Map Dashboard"),  
    sidebarLayout(
        sidebarPanel(
            selectInput(inputId = "selectedvariable0",
                        label = "Type", 
                        choices = c(unique(stands_ds$PEST)),selected = TRUE ), 
            selectInput(inputId = "selectedvariable1",
                        label = "Date", 
                        choices = c(unique(stands_ds$DATA_S)),selected = TRUE ), 
            selectInput(inputId = "selectedvariable2",
                        label = "Project", 
                        choices = c(unique(stands_ds$PROJETO)),selected = TRUE ),
            selectInput(inputId = "selectedvariable3",
                        label = "Stand", 
                        choices = c(unique(stands_ds$CD_TALHAO)),selected = TRUE),
            selectInput(inputId = "selectedvariable4",
                        label = "Unique ID", 
                        choices = c(unique(stands_ds$ID_UNIQUE)),selected = TRUE),
            selectInput(inputId = "selectedvariable5",
                        label = "Class", 
                        choices = c(unique(stands_ds$CLASS)),selected = TRUE)            
        ),
        mainPanel(
            textOutput("idSaida"),
            fluidRow(
                splitLayout(plotOutput("myplot"))),
            dateInput(inputId = "Dates selection", label = "Time"),
            leafletOutput("map") 
        )
    )
)
server <- function(input, output){
    
    currentvariable0 <- reactive({input$selectedvariable0})
    currentvariable1 <- reactive({input$selectedvariable1})
    currentvariable2 <- reactive({input$selectedvariable2})
    currentvariable3 <- reactive({input$selectedvariable3})
    currentvariable4 <- reactive({input$selectedvariable4})
    currentvariable5 <- reactive({input$selectedvariable5})
 
observe({ 
    if(currentvariable5()=="A"){
        
        
        output$myplot <- renderPlot({
            
            #Subset stand
            stands_sel <- subset(stands_extent, stands_extent@data$ID_UNIQUE==currentvariable4())
            
            #Subset for input$var and assign this subset to new object, "fbar"
            ds_sel<- stands_ds[stands_ds$ID_UNIQUE==currentvariable4(),]
            
            #Create a map
            polys <- st_as_sf(stands_sel)
            ggplot() +
                geom_sf(data=polys) +
                geom_point(data=ds_sel,
                           aes(x=X, y=Y), color="red") +
                xlab("Longitude") + ylab("Latitude") +
                coord_sf() +
                theme_bw() +
                theme(text = element_text(size=10)) 
        })
    } else {
        
        #Subset stand
        stands_sel <- subset(stands_extent, stands_extent@data$ID_UNIQUE==currentvariable4())
        
        #Subset for input$var and assign this subset to new object, "fbar"
        ds_sel<- stands_ds[stands_ds$ID_UNIQUE==currentvariable4(),]
        
        #Create a map
        polys <- st_as_sf(stands_sel)
        ggplot() +
            geom_sf(data=polys) +
            geom_raster(data = stands_sel, aes(x = X, y = Y, fill = CD)) + 
            scale_fill_gradientn(name="Desfolha (%)",colours = terrain.colors(100))+
            xlab("Longitude") + ylab("Latitude") +
            coord_sf() +
            theme_bw() +
            theme(text = element_text(size=10)) 
        
    }
    
    output$map <- renderLeaflet({
        
        stands_actual<-stands_ds[stands_ds$ID_UNIQUE==currentvariable4(),]
        lng <- mean(stands_actual$X)
        lat <- mean(stands_actual$Y)
        
        leaflet() %>%
            setView(lng = lng, lat = lat, zoom=17) %>%
            addProviderTiles(providers$Esri.WorldImagery) %>%                   
            addMarkers(lng=stands_actual$X, lat=stands_actual$Y, popup="Location")
        
    }) }) #end of observe function.
}
shinyApp(ui, server)

在许多反应对象中使用 if 语句不起作用

Use if statement in many reactive objects doesn't work

r

shiny

shiny-reactivity