ifelse function producing error 'not a valid subset' on a raster image in shiny

[prasenjit.ac]

Hi

I am having trouble with the ifelse function on a raster image in shiny. Can anyone help me in this regard? Here is a reproducible code for the problem.

library(shiny)
library(leaflet)
library(raster)
library(rgdal)
library(mapview)

xy <- matrix(runif(400),20,20)
rst <- raster(xy)
extent(rst) <- c(-152,-150 ,66,68)
projection(rst) <- CRS("+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0")
names(rst) <- 'ndvi_map'

#map <- leaflet() %>% addProviderTiles("Esri.WorldImagery") %>%
  #setView(lng = -152, lat = 67.5, zoom =7) %>%
  #addMouseCoordinates(style = "basic")
ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),
  absolutePanel(top = 10, right = 10,
                sliderInput("ndvi_map", "ndvi", min= 0, max= 1,
                            value = 0.5, step = 0.1)
                #checkboxInput("legend", "Show legend", TRUE)
  )
  #mainPanel(leafletOutput('Raster', width = "100%", height = "100%"))
)

server <- function(input, output, session) {
  filterData <- reactive({
  calc(rst[[input$ndvi_map]], fun = function(x){
    ifelse(is.na(x) == T, NA,
           ifelse(x >=input$ndvi_map[1] & x <=input$ndvi_map[2], x, NA))}) 
             })
  #})

  
  pal <- colorNumeric("RdYlBu", values(rst), 
                      na.color = "transparent")
  output$map <- renderLeaflet({
  leaflet() %>% addProviderTiles("Esri.WorldImagery") %>%
      setView(lng = -152, lat = 67.5, zoom =7) %>%
      addMouseCoordinates(style = "basic")%>%
    addRasterImage(filterData(), colors = pal, opacity = 1) %>%
    addLegend(position = "bottomright", pal = pal, values = values(rst),
              opacity = 1)
    #observe({
      #leafletProxy('map_rst') %>%
        #clearImages() %>%
        #addRasterImage(filterData(), colors = pal, opacity = 1, layerId = input$range)
    #})
  })
}
shinyApp(ui, server)
    

Listening on http://127.0.0.1:4791
Warning: Error in inherits: not a valid subset

[Rodrigue]

hi @prasenjit.ac.

Your trouble is not specificly with the ifelse function but with what you put in overlay function :
overlay(rst[[input$ndvi_map]], fun = function(x).... the default value of input$ndvi_map in yr ui is 0.5.

So you tell Shiny to take rst[[0.5]] and you have an error. when i put the default value to 1, there are no more trouble.

And I'm not sure to really understand what your are doing in the overlay function. This function is used to create a new raster based on 2 or more raster, but in your script you use only 1 raster.

Hope it helps

[prasenjit.ac]

Thanks Rodrigue for your reply. However, I observed that even if I change the default value to 1.0, the problem still persists. The raster image did not appear on the background leaflet image.
How can I fix that?

[Rodrigue]

Like I say in my last post, I'm not sure to understand. Can you explain what want to do?

I don't understand the connection between your sliderInput and your raster. According to my understanding, you want to filter layers in yr raster with the sliderinput but your raster have only 1 layer.

If you just want to add the current raster, changing addRasterImage(filterData(), colors = pal, opacity = 1) by addRasterImage(rst, colors = pal, opacity = 1) will give you this:

Also, I don't understand input$ndvi_map[1] ... input$ndvi_map[2]. Ìnput$ndvi_map return the current value off your slider and you can't ask for value 1, 2....

[prasenjit.ac]

I want to mask this raster image based on the range of values that are given interactively. The filteredData() which is put under reactive expression satisfies this condition. Moreover, I observed that It is causing no trouble while I am doing it in R. However, It throws me an error in shiny. Can't figured out what's wrong with that? I am attaching my example code in R here.
regards.

r <- raster(nrow=10, ncol = 10)
r1 <- init(r, fun = runif)
extent(r1) <- c(68,88,20,34)
projection(r1) <- CRS("+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0")

f <- function(x){
  ifelse(is.na(x)== T,NA, ifelse(x > 0.4 && x < 0.8, x*1, NA))
}
mask.r1 <- overlay(r1, fun = f)
plot(mask.r1)

[Rodrigue]

Ok I understand now.

You have to do 2 things:

• Change the value of sliderinput to take 2 values: value = 0.5 --> value = c(0.5,0.8)
• Change rst[[input$ndvi_map]] to rst in the calc/overlay function

library(leaflet)
library(raster)
library(rgdal)
library(mapview)

xy <- matrix(runif(400),20,20)
rst <- raster(xy)
extent(rst) <- c(-152,-150 ,66,68)
projection(rst) <- CRS("+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0")
names(rst) <- 'ndvi_map'

#map <- leaflet() %>% addProviderTiles("Esri.WorldImagery") %>%
#setView(lng = -152, lat = 67.5, zoom =7) %>%
#addMouseCoordinates(style = "basic")
ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),
  absolutePanel(top = 10, right = 10,
                sliderInput("ndvi_map", "ndvi", min= 0, max= 1,
                            value = c(0.5,0.8), step = 0.1)
                #checkboxInput("legend", "Show legend", TRUE)
  )
  #mainPanel(leafletOutput('Raster', width = "100%", height = "100%"))
)

server <- function(input, output, session) {
  filterData <- reactive({
    calc(rst, fun = function(x){
      ifelse(is.na(x) == T, NA,
             ifelse(x >=input$ndvi_map[1] & x <=input$ndvi_map[2], x, NA))}) 
  })
  #})
  
  
  pal <- colorNumeric("RdYlBu", values(rst), 
                      na.color = "transparent")
  output$map <- renderLeaflet({
    leaflet() %>% addProviderTiles("Esri.WorldImagery") %>%
      setView(lng = -152, lat = 67.5, zoom =7) %>%
      addMouseCoordinates(style = "basic")%>%
      addRasterImage(filterData(), colors = pal, opacity = 1) %>%
      addLegend(position = "bottomright", pal = pal, values = values(rst),
                opacity = 1)
    #observe({
    #leafletProxy('map_rst') %>%
    #clearImages() %>%
    #addRasterImage(filterData(), colors = pal, opacity = 1, layerId = input$range)
    #})
  })
}
shinyApp(ui, server)
type or paste code here

[prasenjit.ac]

Thank you very much for this elegant solution. It works on this training data. Now, I am trying the same thing into my own raster data having a spatial resolution of 0.0083 deg. However, it is taking more than 15-20 mints to display in the app window. Any quick solution for that?..... regards.