Dynamic reactive objects conflits with observe combined with if

Question

I try to create an app in Shiny and all selectInput were dynamic reactive objects but at the moment they make some plot (output$myplot) with the combination of the variables select and if(){} condition using observe({}), my plot doesn't work (PEST == unique(stands_ds$PEST) : length of larger object is not multiple of length of smaller object). The problem is with the final selection object selectedvariable4 and try to used selectedvariable4, selectedvariable4(),selectedvariable4()$ID_UNIQUE and unique(selectedvariable4()$ID_UNIQUE) without success. In my example:

# Packages
library(rgdal)
library(shiny)
library(leaflet)
library(leaflet.providers)
library(ggplot2)
library(shinythemes)
library(sf)
library(lubridate)
library(dplyr)
library(anytime)


# 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$PEST<-c(rep("A",34),rep("B",225))
  
# Create the shiny dash
ui <- fluidPage(
  theme = shinytheme("cosmo"),
  titlePanel(title="My Map Dashboard"),  
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "selectedvariable0", "Type", choices = c(unique(stands_ds$PEST))),
      selectInput(inputId = "selectedvariable1", "Date",choices = NULL),
      selectInput(inputId = "selectedvariable2", "Project",choices = NULL),
      selectInput(inputId = "selectedvariable3", "Stand",choices = NULL),
      selectInput(inputId = "selectedvariable4", "ID-Unique",choices = NULL)
    
    ),
    mainPanel(
      textOutput("idSaida"),
      fluidRow(
        splitLayout(plotOutput("myplot")))
    )
  )
)

server <- function(input, output, session){
  
  
  selectedvariable0 <- reactive({
    filter(stands_ds, PEST == unique(stands_ds$PEST))
  })
  observeEvent(selectedvariable0(), {
    choices <- anytime::anydate(unique(selectedvariable0()$DATA_S2))
    updateSelectInput(inputId = "selectedvariable1", choices = choices) 
  })
  
  selectedvariable1 <- reactive({
    req(input$selectedvariable1)
    filter(selectedvariable0(), DATA_S2 == anytime::anydate(input$selectedvariable1))
  })
  observeEvent(selectedvariable1(), {
    choices <- unique(selectedvariable1()$PROJETO)
    updateSelectInput(inputId = "selectedvariable2", choices = choices)
  })
  
  selectedvariable2 <- reactive({
    req(input$selectedvariable2)
    filter(selectedvariable0(), PROJETO == input$selectedvariable2)
  })
  observeEvent(selectedvariable2(), {
    choices <- unique(selectedvariable2()$CD_TALHAO)
    updateSelectInput(inputId = "selectedvariable3", choices = choices)
  })
  
  selectedvariable3 <- reactive({
    req(input$selectedvariable3)
    filter(selectedvariable0(), CD_TALHAO == input$selectedvariable3)
  })
  observeEvent(selectedvariable3(), {
    choices <- unique(selectedvariable3()$ID_UNIQUE)
    updateSelectInput(inputId = "selectedvariable4", choices = choices)
  })
  selectedvariable4 <- reactive({
    req(input$selectedvariable4)
    filter(selectedvariable0(), ID_UNIQUE == input$selectedvariable4)
  })
  
  
  #Create plot and maps
  
  observe({
    
    req(selectedvariable0())
    
    if(selectedvariable0()=="B"){
      
      
  output$myplot <- renderPlot({

    #Subset stand
    stands_sel <- subset(stands_extent, stands_extent@data$ID_UNIQUE==unique(selectedvariable4()$ID_UNIQUE))

    #Subset for input$var and assign this subset to new object, "fbar"
    ds_sel<- stands_ds[stands_ds$ID_UNIQUE==unique(selectedvariable4()$ID_UNIQUE),]

    #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") +
      coord_sf() +
      theme_bw() +
      theme(text = element_text(size=10))
  })
  
    } else {
      
      output$myplot <- renderPlot({
        
        #Subset stand
        stands_sel <- subset(stands_extent, stands_extent@data$ID_UNIQUE==unique(selectedvariable4()$ID_UNIQUE))
        
        #Subset for input$var and assign this subset to new object, "fbar"
        ds_sel<- stands_ds[stands_ds$ID_UNIQUE==unique(selectedvariable4()$ID_UNIQUE),]
        
        #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="blue") +
          coord_sf() +
          theme_bw() +
          theme(text = element_text(size=10))
      })
      }
    }) #end of observe function.
 }
shinyApp(ui, server)
##

Please, any help for fix it?

Answer 1

The lines where we are filtering and subset would have == and some of them on the rhs of the operator is unique values i.e. it could be a single value or more than one value. With ==, it is elementwise comparison and it can work only when the rhs object is of length 1 or have the same length as the lhs object. With length 1, it recycles and have no issue, but if the length is more than 1 and not equal to the other object, the recycling will do erroneous output and it may also gives the length warning if the length is not a multiple of the other object.

It may be safer to use %in% instead. Below is the updated code (not tested though)

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


# 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$PEST<-c(rep("A",34),rep("B",225))
  
# Create the shiny dash
ui <- fluidPage(
  theme = shinytheme("cosmo"),
  titlePanel(title="My Map Dashboard"),  
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "selectedvariable0", "Type", choices = c(unique(stands_ds$PEST))),
      selectInput(inputId = "selectedvariable1", "Date",choices = NULL),
      selectInput(inputId = "selectedvariable2", "Project",choices = NULL),
      selectInput(inputId = "selectedvariable3", "Stand",choices = NULL),
      selectInput(inputId = "selectedvariable4", "ID-Unique",choices = NULL)
    
    ),
    mainPanel(
      textOutput("idSaida"),
      fluidRow(
        splitLayout(plotOutput("myplot")))
    )
  )
)

server <- function(input, output, session){
  
  
  selectedvariable0 <- reactive({
    filter(stands_ds, PEST %in% unique(stands_ds$PEST))
  })
  observeEvent(selectedvariable0(), {
    choices <- anytime::anydate(unique(selectedvariable0()$DATA_S2))
    updateSelectInput(inputId = "selectedvariable1", choices = choices) 
  })
  
  selectedvariable1 <- reactive({
    req(input$selectedvariable1)
    filter(selectedvariable0(), DATA_S2 %in% anytime::anydate(input$selectedvariable1))
  })
  observeEvent(selectedvariable1(), {
    choices <- unique(selectedvariable1()$PROJETO)
    updateSelectInput(inputId = "selectedvariable2", choices = choices)
  })
  
  selectedvariable2 <- reactive({
    req(input$selectedvariable2)
    filter(selectedvariable0(), PROJETO %in% input$selectedvariable2)
  })
  observeEvent(selectedvariable2(), {
    choices <- unique(selectedvariable2()$CD_TALHAO)
    updateSelectInput(inputId = "selectedvariable3", choices = choices)
  })
  
  selectedvariable3 <- reactive({
    req(input$selectedvariable3)
    filter(selectedvariable0(), CD_TALHAO %in% input$selectedvariable3)
  })
  observeEvent(selectedvariable3(), {
    choices <- unique(selectedvariable3()$ID_UNIQUE)
    updateSelectInput(inputId = "selectedvariable4", choices = choices)
  })
  selectedvariable4 <- reactive({
    req(input$selectedvariable4)
    filter(selectedvariable0(), ID_UNIQUE %in% input$selectedvariable4)
  })
  
  
  #Create plot and maps
  
  observe({
    
    req(selectedvariable0())
    
    if("B" %in% input$selectedvariable0  ){
      
      
  output$myplot <- renderPlot({

    #Subset stand
    stands_sel <- subset(stands_extent, stands_extent@data$ID_UNIQUE %in% unique(selectedvariable4()$ID_UNIQUE))

    #Subset for input$var and assign this subset to new object, "fbar"
    ds_sel<- stands_ds[stands_ds$ID_UNIQUE %in% unique(selectedvariable4()$ID_UNIQUE),]

    #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") +
      coord_sf() +
      theme_bw() +
      theme(text = element_text(size=10))
  })
  
    } else {
      
      output$myplot <- renderPlot({
        
        #Subset stand
        stands_sel <- subset(stands_extent, stands_extent@data$ID_UNIQUE %in% unique(selectedvariable4()$ID_UNIQUE))
        
        #Subset for input$var and assign this subset to new object, "fbar"
        ds_sel<- stands_ds[stands_ds$ID_UNIQUE %in% unique(selectedvariable4()$ID_UNIQUE),]
        
        #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="blue") +
          coord_sf() +
          theme_bw() +
          theme(text = element_text(size=10))
      })
      }
    }) #end of observe function.
 }
shinyApp(ui, server)