Leaflet Shiny: Données de points non trouvées

Question

J'essaie de tracer des cercles sur une brochure en suivant l'exemple donné dans la page github de RSTUDIO here. J'ai essayé de faire fonctionner ces deux derniers jours en adoptant diverses suggestions données ici aussi bien que dans d'autres blogs. Mais je reçois constamment l'erreur suivante:

Warning: Error in derivePoints: Point data not found; please provide addCircles with data and/or lng/lat arguments 

Je ne sais pas si je suis absent des bibliothèques ou si l'un de mes paquets nécessite la mise à jour. Ce qui suit est l'ensemble de données avec les codes. Si je lance l'exemple tel quel depuis la page github de r-studio, il fonctionne sans problème. Je vérifie la structure des données, et les deux sont exactement les mêmes types. Aspect incertain où le problème pourrait être:

Sortie désirée: Une carte avec des cercles de tailles différentes pour chaque catégorie (céréales, impulsions) qui change de façon réactive lors de la sélection.

library(shiny) 
library(leaflet) 
library(RColorBrewer) 

data <- structure(list(LATITUDE = c(26.912434, 28.459497, 23.022505, 
10.790483, 28.704059), LONGITUDE = c(75.787271, 77.026638, 72.571362, 
78.704673, 77.10249), CEREALS = c(450L, 350L, 877L, 1018L, 600L 
), PULSES = c(67L, 130L, 247L, 250L, 324L)), .Names = c("LATITUDE", 
"LONGITUDE", "CEREALS", "PULSES"), row.names = c(1263L, 4524L, 
10681L, 7165L, 12760L), class = "data.frame") 

ui <- bootstrapPage(
    tags$style(type = "text/css", "html, body {width:100%;height:100%}"), 
    leafletOutput("map", width = "100%", height = "100%"), 
    absolutePanel(top = 10, right = 10, 
    selectInput(inputId = "productCategoryMonthly", "PRODUCTS",choices = NULL, selected = NULL), 
     selectInput("colors", "Color Scheme",rownames(subset(brewer.pal.info, category %in% c("seq", "div"))) 
    ))) 


server <- function(input, output, session) { 

    df <- reactive({data})  

    observe({ 
     withProgress(message = "Loading data, Please wait...",value = 0.1, { 
     updateSelectizeInput(session,inputId = "productCategoryMonthly", choices = as.character(sort(toupper(colnames(df()[,c(3:4)]))),decreasing = TRUE), selected = "CEREALS", server = TRUE) 
     }) 
    }) 

    filteredData <- reactive({ 
     if(input$productCategoryMonthly == "CEREALS") { 
      df()[,c(1,2,3)] 
     } else if (input$productCategoryMonthly == "PULSES") { 
       df()[,c(1,2,4)] 
     } 
    }) 

    output$map <- renderLeaflet({ 
    leaflet(df()) %>% addTiles() %>% 
     fitBounds(~min(LONGITUDE), ~min(LATITUDE), ~max(LONGITUDE), ~max(LATITUDE)) 
    }) 


    observe({ 
    mag <- filteredData()[[input$productCategoryMonthly]] 
    leafletProxy("map", data = filteredData()) %>% 
     clearShapes() %>% 
     addCircles(radius = ~10^mag/10, weight = 1, color = "#777777", 
     fillOpacity = 0.7, popup = ~paste(mag) 
    ) 
    }) 

} 

shinyApp(ui, server) 

Answer 1

C'est un peu code modifié:

Je redimensionnée la variable mag pour contrôler la taille des cercles, vous pouvez jouer avec cette sorte que la zone du cercle représentent les quantités quelle que soit la catégorie de produits . J'ai codé en dur le menu déroulant du produit, la création dynamique de la liste déroulante ne fonctionne pas. Je vais y jeter un coup d'oeil plus tard. La couleur de remplissage manquait dans l'appel leafletProxy. Voici le code:

library(shiny) 
    library(leaflet) 
    library(RColorBrewer) 



    data <- structure(list(LATITUDE = c(26.912434, 28.459497, 23.022505, 
             10.790483, 28.704059), 
          LONGITUDE = c(75.787271, 77.026638, 72.571362, 
                      78.704673, 77.10249), 
          CEREALS = c(450L, 350L, 877L, 1018L, 600L 
                      ), 
          PULSES = c(67L, 130L, 247L, 250L, 324L)), 
         .Names = c("LATITUDE", "LONGITUDE", "CEREALS", "PULSES"), 
         row.names = c(1263L, 4524L, 10681L, 7165L, 12760L), 
         class = "data.frame") 
    #mag <- c(5, 5.2, 5.3, 5.4, 5.5) 

    ui <- bootstrapPage(
      tags$style(type = "text/css", "html, body {width:100%;height:100%}"), 
      leafletOutput("map", width = "100%", height = "100%"), 
      absolutePanel(top = 10, right = 10, 
          selectInput(inputId = "productCategoryMonthly", "PRODUCTS",choices = c("CEREALS", "PULSES"), selected = NULL), 
          selectInput("colors", "Color Scheme",rownames(subset(brewer.pal.info, category %in% c("seq", "div"))) 
         ))) 

    server <- function(input, output, session) { 

      df <- reactive({data})  

      # observe({ 
      #   withProgress(message = "Loading data, Please wait...",value = 0.1, { 
      #     updateSelectInput(session,inputId = "productCategoryMonthly", choices = as.character(sort(toupper(colnames(df()[,c(3:4)]))),decreasing = TRUE), selected = "CEREALS", server = TRUE) 
      #   }) 
      # }) 

      filteredData <- reactive({ 
        if(input$productCategoryMonthly == "CEREALS") { 
          df()[,c(1,2,3)] 
        } else if (input$productCategoryMonthly == "PULSES") { 
          df()[,c(1,2,4)] 
        } 
      }) 
      mag <- reactive({ 
        if(input$productCategoryMonthly == "CEREALS") { 
          mag <- (filteredData()[[input$productCategoryMonthly]]/sum(filteredData()[[input$productCategoryMonthly]])) + 5  
        } else if (input$productCategoryMonthly == "PULSES") { 
          mag <- (filteredData()[[input$productCategoryMonthly]]/sum(filteredData()[[input$productCategoryMonthly]])) + 5 
        }  
        mag 
      }) 

      output$map <- renderLeaflet({ 
        leaflet(df()) %>% addTiles() %>% 
          fitBounds(~min(LONGITUDE), ~min(LATITUDE), ~max(LONGITUDE), ~max(LATITUDE)) 
      }) 

      colorpal <- reactive({ 
        colorNumeric(input$colors, filteredData()[[3]]) 
      }) 
      observe({ 
        pal <- colorpal() 
        #mag <- filteredData()[[input$productCategoryMonthly]]^(1/4) 
        leafletProxy("map", data = filteredData()) %>% 
          clearShapes() %>% 
          addCircles(radius = ~10^mag()/10, weight = 1, color = "#777777", fillColor = ~pal(filteredData()[[3]]), 
             fillOpacity = 0.7, popup = ~paste(mag()) 
          ) 
      }) 

    } 

    shinyApp(ui, server)