Filter out NAs from a shiny app at the RenderUI step

shiny
rstudio

#1

I am new to shiny, and I am creating an app that manages a reactive dataframe that allows selecting among a set of variables (PHENOTYPES) obtained in a data frame with missing values that I don’t want to have plotted using leaflet.

What I am looking for is a way to filter out the NA values, so they are not plotted.

*****This question has also been posted on the shiny google group. I will erase either post once it is resolved and synthetize in one post any feedback so it does not become redundant:

https://groups.google.com/forum/#!topic/shiny-discuss/eLVf2Y50MDY

Thank you for your help.

Here is my R.server

  shinyServer(function(input, output) {


  output$map <- renderLeaflet({
  print('render map')
  leaflet(FULL) %>% 
  addSearchOSM(options = searchOSMOptions(position = 'topleft', zoom = 5)) %>%
  addProviderTiles("OpenStreetMap.Mapnik", group = "OpenStreetmap") %>%
  addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
 
  setView(lng = 0, lat = 50, zoom = 2) %>%
  addLayersControl(baseGroups = c('Esri.WorldImagery',"OpenStreetmap"),
                   options = layersControlOptions(collapsed = TRUE, autoZIndex = F, position = 'bottomleft' ))


   })

   df <- datasets[['FULL']]


    makeReactiveBinding('df')


 df <- reactive({                           #######  This bit was added to sort this problem based
    if (!is.null(input$yvar)){            #######  on advise on this thread, but It 
      out <- data %>%                  ######## stops the app. The app works if I remove this, only
        filter(df == input$yvar,       ######## that with the undesired NAs
               !is.na(value))               ######
      
      return(out)                            #######
    }                                             ###########
  })                                              ##########

   observeEvent(input$makeReactiveBinding,{
   print('dataset')
  leafletProxy('map')%>%clearShapes()
   df <<- datasets[[input$dataset]]  
   i.active <<- NULL

   })


  coords <- reactive({
  print('coords')

  crds <- data.frame(coordinates(df))
  leafletProxy('map')%>%fitBounds(lng1=min(crds[,1]),lng2=max(crds[,1]),
                                lat1=min(crds[,2]),lat2=max(crds[,2]))

  crds

 })

output$xvar <- renderUI(selectInput('color',label='Phenotype',choices = list("Phenotype A" =c("Variable AA",	        "Variable BB"), "Phenotype B"=c("Variable CC", "Variable DD")))
                                                                                      
   xVar <- reactive({
   print('xVar')
   if(is.null(input$xvar)) return(names(df)[1])
  xvar_ <<- input$xvar
  input$xvar})
                                                                                      
  xVar <- reactive({
print('colVar')
 if(is.null(input$color)) return(names(df)[2])
 input$color})   
  colorData <- reactive({
  print(names(input))
                                                                                                                                                                                     
  print('colData')
 df1 <- isolate(df@data)
 df1[,xVar()]})
 colorpal <- reactive(colorNumeric(input$pal, colorData()))
 pal <- reactive({colorpal()(colorData())})
                                                                                      
    observe({
                                                                                      
 print('update map size/opa/color')
 x <- coords()[,1]
y <- coords()[,2]
 leafletProxy('map')%>%
  addCircleMarkers(lng=x,fillColor = pal(),
 lat=y,
 stroke = F,
 layerId = as.character(1:length(x)),
radius = input$size/10, 
color = 'blue',
fillOpacity = 1) 
 })
                                                                                      
 mapData <- reactive({
 print('mapdata')
                                                                                      
 mb <- input$map_bounds
                                                                                      
 if(is.null(mb))
return(1)
 if(nrow(coords())!=nrow((ggvisdf())))
 return(1)
                                                                                      
 as.numeric(coords()[,1]>mb$west&coords()  [,1]<mb$east&
 coords()[,2]>mb$south&coords()[,2]<mb$north)+0.1
                                                                                      
})})})

#2

It will be much easier to help you if you post a minimal reproducible example (i.e. reprex), expecially your code for manipulating the data frame.

However you could use filter from the dplyr package to remove any NAs in your value column (I will name it value in my example):

df <- reactive({
  out <- data %>% 
    filter(country == input$yvar,
           !is.na(value))

  return(out)
})

Then you can call df() in your leaflet call


#3

Thanks so much for your reply, would this go before the render ui step? the reason I am asking is because the label country (I actually used Environment) is introduced at the renderui step.

The example I am working on is using this https://www.showmeshiny.com/geoexplorer/ using different data that in this case, that includes NAs and creates a problem non-existent in the original geoexplorer example

Thanks again


#4

I would typically put it after the renderUI() call, but I am fairly certain it doesn’t really matter whether it is before or after it.

You may want to put a conditional statement at the top of the reactive statement that I gave you so it would look like this:

df <- reactive({
  if (!is.null(input$yvar)){
    out <- data %>% 
      filter(country == input$yvar,
             !is.na(value))

    return(out)
  }
})

This will prevent the filtering from occurring until after a selection is made for the input$yvar


#5

As a side note, I see that you also posted this question on the shiny-discuss forum . Please see this post below from Hadley regarding cross posting. If you do it, you should link to your other posts so that people do not spend time answering your questions if they have already been answered.


#6

so based on this example,

df <- reactive({
  out <- data %>% 
    filter(country == input$yvar,
           !is.na(value))

  return(out)
})  

would be actually

df <- reactive({
  out <- data %>% 
    filter(Environment == input$yvar,
           !is.na(value))

  return(out)
})

#7

I am not sure if you are asking whether that is what you should change it to or just making a declarative statement, but yes you should change country in the filter function to be the name of the column that stores the country info. So if the column name is Environment then you are correct. My code snippet was just a best guess at a column name since I do not have access to your data or code.


#8

This is my .server, I was trying to give an example using countries to simplify, since it includes many other things that may not be of interest.

My data is arraged so every column is an environmental variable and every row is an individual. I have 300ish environmental variables (columns) and more than 1000 rows (individuals). When i plote them using leaflet, i do get the grey dots corresponding to NAs, and I would like to avoid plotting them

library(shiny)
library(shinyjs)
library(shiny)
library(shinyjs)
library(shinyURL)
library(leaflet.extras)
credentials <- list("123" = "202cb962ac59075b964b07152d234b70")

shinyServer(function(input, output) {
  shinyURL.server()
  
  USER <- reactiveValues(Logged = FALSE)
  
  observeEvent(input$.login, {
    if (isTRUE(credentials[[input$.username]]==input$.password)){
      USER$Logged <- TRUE
    } else {
      show("message")
      output$message = renderText("Invalid user name or password")
      delay(2000, hide("message", anim = TRUE, animType = "fade"))
    }
  })
  
  output$app = renderUI(
    if (!isTRUE(USER$Logged)) {
      fluidRow(column(width=4, offset = 4,
                      wellPanel(id = "login",
                                textInput(".username", "Username:"),
                                passwordInput(".password", "Password:"),
                                div(actionButton(".login", "Log in"), style="text-align: center;")
                      ),
                      textOutput("message")
      ))
    } else {
      
      
      output$map <- renderLeaflet({
        print('render map')
        leaflet(FULL) %>% 
          addSearchOSM(options = searchOSMOptions(position = 'topleft', zoom = 5)) %>%
          addProviderTiles("OpenStreetMap.Mapnik", group = "OpenStreetmap") %>%
          addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
          addProviderTiles("Esri.WorldGrayCanvas", group = "Esri.WorldGrayCanvas") %>%
          addProviderTiles("Esri.NatGeoWorldMap", group = "Esri.NatGeoWorldMap") %>%
          addProviderTiles("Esri.OceanBasemap", group = "Esri.OceanBasemap") %>%
          addProviderTiles("CartoDB.DarkMatter", group = "DarkMatter (CartoDB)") %>%
          setView(lng = 0, lat = 50, zoom = 2) %>%
          addLayersControl(baseGroups = c('Esri.WorldImagery',"OpenStreetmap","Esri.WorldGrayCanvas","Esri.NatGeoWorldMap","Esri.OceanBasemap",'DarkMatter (CartoDB)' ),
                           options = layersControlOptions(collapsed = TRUE, autoZIndex = F, position = 'bottomleft' ))
        
      
        })
      

      df <- datasets[['FULL']]
      
    
      makeReactiveBinding('df')
      
      
      observeEvent(input$makeReactiveBinding,{
        print('dataset')
        leafletProxy('map')%>%clearShapes()
        df <<- datasets[[input$dataset]]  
        i.active <<- NULL
        
      })
      
      
      coords <- reactive({
        print('coords')
        
        crds <- data.frame(coordinates(df))
        leafletProxy('map')%>%fitBounds(lng1=min(crds[,1]),lng2=max(crds[,1]),
                                        lat1=min(crds[,2]),lat2=max(crds[,2]))
        
        crds
        
      })
      
      
     
   
      output$yvar <- renderUI(selectInput('yvar',label='Environment',choices =  list("Coordinates" = c("lng"="lng", "lat"="lat"),....etc, too many variables to be able to post it here))))
      output$xvar <- renderUI(selectInput('color',label='Phenotype',choices = list("paper A" =c("F at 10 °C",	"F16\"),	
                                                                                   "Paper B"=c(" cell length (µm)",	" M length (µm)"),	
                                                                                                               
                                etc, too many variables to post here                                                   
      )))
    
      xVar <- reactive({
        out <- data %>% 
          filter(color == input$color,
                 !is.na(value))
        
        return(out)
      })
      
      
      xVar <- reactive({
        print('xVar')
        if(is.null(input$xvar)) return(names(df)[1])
        xvar_ <<- input$xvar
        input$xvar})
      
      yVar <- reactive({
        if(is.null(input$yvar)) return(names(df)[2])
        input$yvar})
      xVar <- reactive({
        print('colVar')
        if(is.null(input$color)) return(names(df)[2])
        input$color})
      
      IDVar <- reactive({
        print('ID')
        if(is.null(input$ID)) return(names(df)[3])
        input$ID})
      
      
      
      
      ggvisdf <- reactive({
        print('ggvesdf1')
        df1 <- isolate(df@data)
        gdf <- df1[, c(xVar(), yVar())]
        names(gdf) <- c("x", "y")
        gdf
      })  
      
      colorData <- reactive({
        print(names(input))
        print('colData')
        df1 <- isolate(df@data)
        df1[,xVar()]})
      colorpal <- reactive(colorNumeric(input$pal, colorData()))
      pal <- reactive({colorpal()(colorData())})
      
      observe({
        
        print('update map size/opa/color')
        x <- coords()[,1]
        y <- coords()[,2]
        leafletProxy('map')%>%
          addCircleMarkers(lng=x,fillColor = pal(),
                           lat=y,
                           stroke = F,
                           layerId = as.character(1:length(x)),
                           radius = input$size/10, 
                           color = 'blue',
                           fillOpacity = 1, 
                           
                           popup = paste("ID:", FULL$id, "<br>",
                                                          "Name: ", FULL$name, "<br>",
                                                          "Country: ", FULL$country, "<br>",
                                                          "CS number: ", FULL$CS_number, "<br>",
                                                          "Admixture group: ", FULL$group)  ) 
        
      })
      
      
      
      observe({
        print('legend')
        leafletProxy("map")%>%
          clearControls() %>% 
          addLegend(opacity = 1,position = "bottomright",title = xVar(),
                    pal = colorpal(), values = rev(colorData()))
        
      })
      
      
      mapData <- reactive({
        print('mapdata')
        
        mb <- input$map_bounds
        
        if(is.null(mb))
          return(1)#as.vector(rep(1,nrow(coords()))))
        if(nrow(coords())!=nrow((ggvisdf())))
          return(1)
        
        as.numeric(coords()[,1]>mb$west&coords()[,1]<mb$east&
                     coords()[,2]>mb$south&coords()[,2]<mb$north)+0.1
        
      })
      
      
      tooltip <- function(x) {
        ggvisHover <<- x
        if(is.null(x)) return(NULL)
        tt<<-paste0(c(xVar(),yVar()), ": ", format(x[1:2]), collapse = "<br/>")
        leafletProxy('map') %>%addControl(tt,layerId = 'tt',position = 'topright')
        tt
      }
      
      
      
      
      
      ggvisHover <- NULL
      makeReactiveBinding('ggvisHover')
      i.active <- NULL
      makeReactiveBinding('i.active')
      
      
      observeEvent(ggvisHover,{
        h <- ggvisHover[1:2]
        i.active <<- ggvisdf()[,'x']==h[[1]]&ggvisdf()[,'y']==h[[2]]
      })
      
      observeEvent(input$map_marker_mouseover,{
        id <- as.numeric(input$map_marker_mouseover$id)
        if(!is.na(id)){
          i.active <<- id
        }
      })
      
      
      
      observeEvent(i.active,{
        leafletProxy('map') %>%
          removeMarker('hover') %>%
          addCircleMarkers(lat=coords()[i.active,2],opacity = 1,
                           fillOpacity = 0,
                           radius = (input$size/5),
                           lng=coords()[i.active,1],
                           layerId = 'hover',weight = 6,
                           color = 'red',fill = FALSE) 
      })
      
      mouseOver <- reactive({
        
        p <- ggvisdf()[i.active,c('x','y')]
        if(class(i.active)=='numeric'){tooltip(p)}
        p
      })
      
      
      ########
      
      #######Table
      output$PHENOTYPES <- DT::renderDataTable(PHENOTYPES, filter = 'top', options = list(
        pageLength = 5, autoWidth = TRUE))
      output$FULL <- DT::renderDataTable(FULL.val, filter = 'top', options = list(
        pageLength = 5, autoWidth = TRUE))
      
   
      
      ######Big plot X vs y
      ggvisdf %>% 
        ggvis(~y,~x) %>%
        set_options(width = "auto", height = "auto", resizable=FALSE) %>%    
        # add_axis("x", title = xVar())  %>% 
        add_axis("x", title = "Phenotype", grid = TRUE, title_offset = 40,  properties = axis_props(
          axis = list(stroke = "red"),title = list(fontSize = 32),
          labels = list(fontSize = 16)))  %>% 
        add_axis("y", title = "Environment", grid = TRUE, title_offset = 60,  properties = axis_props(
          axis = list(stroke = "blue"),title = list(fontSize = 32),
          labels = list(fontSize = 16)))  %>%     
        layer_points(size := input_slider(1, 100, value = 50,id='size',label = 'Size'),
                     opacity := 1,
                     fill := pal) %>% 
        
        add_tooltip(tooltip, "hover") %>%
        layer_points(data =mouseOver,stroke:='blue',size := 150,fillOpacity=0,strokeWidth:=5) %>%
        layer_model_predictions(model = "lm", se = TRUE) %>%
        bind_shiny("p",'ui')
      
      
      #####density plot y
      ggvisdf %>% 
        ggvis(~y) %>%
        set_options(width = "auto", height = "auto", resizable=FALSE) %>%    
        add_axis("x", title = "Phenotype", properties = axis_props(
          axis = list(stroke = "red"),
          title = list(fontSize = 30),
          labels = list(fontSize = 10)))  %>% 
        add_axis("y", title = 'count', properties = axis_props(
          axis = list(stroke = "red"),
          title = list(fontSize = 20),
          labels = list(fontSize = 10)))  %>% 
        
        layer_histograms(width = 0.5, center = 35, fill := "red") %>%    set_options(width = "auto", height = "auto", resizable=FALSE) %>%    
        layer_points(data =mouseOver,stroke:='black',shape := "triangle-down", size := 50) %>%
        bind_shiny("p2")
      
      #####density plot x
      ggvisdf %>% 
        ggvis(~x) %>%
        layer_histograms(width = 0.5, center = 35, fill := "blue") %>%    set_options(width = "auto", height = "auto", resizable=FALSE) %>%    
        add_axis("x", title = "Environment", properties = axis_props(
          axis = list(stroke = "blue"),
          title = list(fontSize = 30),
          labels = list(fontSize = 10)))  %>% 
        add_axis("y", title = 'count', properties = axis_props(
          axis = list(stroke = "red"),
          title = list(fontSize = 20),
          labels = list(fontSize = 10)))  %>% 
        layer_points(data =mouseOver,stroke:='black',shape := "triangle-down", size := 50) %>%
        bind_shiny("p3")

      
      
    })
  
  
})

#9

You are right and I apologize, I was not aware this is something people do but it does make sense and I will edit this to correct it.


#10

Well a first observation is that if this code is copied directly, it looks like you are missing a quotation somewhere as most of your server code is highlighted red to indicate a quote.
The line below seems to be the issue as the “\” escapes the quote after it.

renderUI(selectInput('color',label='Phenotype',choices = list("paper A" =c("F at 10 °C",	"F16\"),

Second, the whole idea behind a minimal reproducible example is that you take the time to eliminate the things that are not of interest. A lot of the time when you are doing this you may solve your own problem. For example, when I try to copy and paste the code you just posted into my own r session, I get several errors and it will not run. You should work to make your example as minimal as possible so that people trying to help can easily copy and paste your code into a new r session and run it.


#11

Thank you for the advice, I think i am pasting below a reproducible example with only the code relevant to my problem. I will correct this on the original post as well. Thanks again for your time and patience.

  shinyServer(function(input, output) {


  output$map <- renderLeaflet({
  print('render map')
  leaflet(FULL) %>% 
  addSearchOSM(options = searchOSMOptions(position = 'topleft', zoom = 5)) %>%
  addProviderTiles("OpenStreetMap.Mapnik", group = "OpenStreetmap") %>%
  addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
 
  setView(lng = 0, lat = 50, zoom = 2) %>%
  addLayersControl(baseGroups = c('Esri.WorldImagery',"OpenStreetmap"),
                   options = layersControlOptions(collapsed = TRUE, autoZIndex = F, position = 'bottomleft' ))


   })

   df <- datasets[['FULL']]


    makeReactiveBinding('df')


   observeEvent(input$makeReactiveBinding,{
   print('dataset')
  leafletProxy('map')%>%clearShapes()
   df <<- datasets[[input$dataset]]  
   i.active <<- NULL

   })


  coords <- reactive({
  print('coords')

  crds <- data.frame(coordinates(df))
  leafletProxy('map')%>%fitBounds(lng1=min(crds[,1]),lng2=max(crds[,1]),
                                lat1=min(crds[,2]),lat2=max(crds[,2]))

  crds

 })

output$xvar <- renderUI(selectInput('color',label='Phenotype',choices = list("Phenotype A" =c("Variable AA",	        "Variable BB"), "Phenotype B"=c("Variable CC", "Variable DD")))
                                                                                      
   xVar <- reactive({
   print('xVar')
   if(is.null(input$xvar)) return(names(df)[1])
  xvar_ <<- input$xvar
  input$xvar})
                                                                                      
  xVar <- reactive({
print('colVar')
 if(is.null(input$color)) return(names(df)[2])
 input$color})   
  colorData <- reactive({
  print(names(input))
                                                                                                                                                                                     
  print('colData')
 df1 <- isolate(df@data)
 df1[,xVar()]})
 colorpal <- reactive(colorNumeric(input$pal, colorData()))
 pal <- reactive({colorpal()(colorData())})
                                                                                      
    observe({
                                                                                      
 print('update map size/opa/color')
 x <- coords()[,1]
y <- coords()[,2]
 leafletProxy('map')%>%
  addCircleMarkers(lng=x,fillColor = pal(),
 lat=y,
 stroke = F,
 layerId = as.character(1:length(x)),
radius = input$size/10, 
color = 'blue',
fillOpacity = 1) 
 })
                                                                                      
 mapData <- reactive({
 print('mapdata')
                                                                                      
 mb <- input$map_bounds
                                                                                      
 if(is.null(mb))
return(1)
 if(nrow(coords())!=nrow((ggvisdf())))
 return(1)
                                                                                      
 as.numeric(coords()[,1]>mb$west&coords()  [,1]<mb$east&
 coords()[,2]>mb$south&coords()[,2]<mb$north)+0.1
                                                                                      
})})})

#12

Ok, so there are a few issues:

  1. There is no ui code posted with this so the app does not actually run. You should really look at the reprex package and use it to create your example.
  2. Currently, you have all of your reactive and observe functions inside your renderUI, these should be moved outside of it. All the renderUI call is going to do is create a ui element. If I am following your logic, you are expecting the renderUI call to render your map? You should move it outside of the renderUI function.

#13

Unfortunately, I cannot share my data until is published, which I do understand is a problem in order to reproduce this. However, as I mentioned before, the logic and design of this app are the ones created by davesteps on his geoExploreR app. The app I am working on, has the same logic, only that his example does not have NA in the data he is using. You can find geoExploreR with all the code and data to run the example in here:

https://github.com/davesteps/geoExploreR/blob/master/server.R

My app works well, and my only issue is with NAs being plotted as NAs, while I just want them filtered and not plotted at all. Of course in the example above I have erased parts of the code which are unrelated to the problem. I have interactivity between leaflet, and different ggvis plot, which makes difficult to post a minimally reproducible code that would be relevant to my particular problem. I agree that the logic of the app could be improved and as I understand, having the reactive and observe functions inside the renderUI is necessary because the app includes ggvis plots as you can see on geoExploreR.app.


#14

The example you share does not have the reactive functions inside of the renderUI. If your only issue is NA’s then just add the reactive statement I posted above and all NA’s in your Environment column will be removed from the dataset.


#15

The code suggested didn’t make it. It is most likely an error on my side, but it does not filter the NAs and in fact stops the app with this warning:

Warning: Error in …stacktraceon…: trying to get slot “data” from an object (class “reactiveExpr”) that is not an S4 object

This has been updated with a comment on where I tried this on the original post, so if anybody has any advice I would really appreciate it


#16

You need to replace the data in my example with whatever the name of your dataset is in your local environment. If the dataset is already reactive than you need to add () after it.