Question

我试图按照RSTUDIO＆＃39; S github页面here.中给出的示例在小册子上绘制圆圈。我一直试图让它在过去几天工作，并采用此处给出的各种建议和其他博客一样。但我不断收到以下错误：

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

我不确定我是否遗漏了任何库，或者我的任何软件包是否需要更新。以下是数据集和代码。如果我按照r-studio的github页面运行示例，它运行没有任何问题。我检查数据的结构，两者都是完全相同的类型。不确定问题出在哪里：

所需输出：每个类别（谷物，豆类）的不同大小圆圈的地图，在选择时会发生反应性变化。

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

这是一个经过修改的代码：

我重新调整了mag变量来控制圆形大小，您可能想要使用它来使圆圈区域代表数量而不管产品类别。我对产品下拉列表进行了硬编码，下拉列表的动态创建不起作用。稍后再看看。 leafletProxy调用中缺少填充颜色。这是代码：

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)

Leaflet Shiny：未找到点数据

1 个答案: