如何使用传单、地球球和 R shiny 计算两点之间的距离

How to calculate distance between 2 points with leaflet, geosphere, and R shiny

这是我的代码的简化工作表示。我有两个点位置集合。一个是汽车,一个是经销商。有一个以英里为单位的距离滑块。如果用户单击经销商位置并选择滑块上的距离,则地图上只会显示距所选经销商距离内的汽车位置。我有另一个城市选择列表,效果很好。但是,当我选择经销商时,显示出现错误,我得到 Warning: E​​rror in .pointsToMatrix: points should be vectors of length 2, matrices with 2 columns, or inheritance from a SpatialPoints object* 我看过其他一些有同样错误的问题,但它们是非常不同的问题。提前致谢!



library(shiny)
library(DT)
library(ggplot2)
library(dplyr)
library(leaflet)
library(geosphere)
r = 3959

City <- c("Boston","Boston", "Boston", "Lowell","Lowell", "Lowell","Worcestor", "Worcestor","Worcestor","Springfield","Springfield","Springfield")
lat <- c(42.35, 42.355, 42.345, 42.63,42.625,42.635,42.27,42.265,42.275, 42.1,42.105,42.095)
lng <- c(-71.05,-71.045,-71.055,-71.316,-71.315,-71.317,-71.79,-71.785,-71.795,-72.6,-72.595,-72.605)

MassLocations <- data.frame(City, lat,lng)
# MassLocations has 4 cities with 3 locations each


Dealer <- c("West","Central", "East")
lat <- c(42.1, 42.0, 42.2)
lng <- c(-72.5,-71.8, -71.1)

MassDealers <- data.frame(Dealer, lat, lng)
#massDelaers has 3 dealers in West, Central, and East


ui <- fluidPage(titlePanel("Mass mpg by location"),
                
                # Create a new Row in the UI for selectInputs
                fluidRow(
                    column(4,
                           selectInput("Dealer",
                                       "Dealer:",
                                       c("All",
                                         unique(as.character(MassDealers$Dealer)))),
                           sliderInput("Distance", 
                                       "Distance from Dealer:", 
                                       min = 1,
                                       max = 100, 
                                       value = 100),
                           selectInput("City",
                                       "City:",
                                       c("All",
                                         unique(as.character(MassLocations$City))))
                    ),
                            ),
                # Create a new row for the table.
                leafletOutput("map01"),
                DT::dataTableOutput("table")
                
)


    

# Define server logic required to draw a histogram
server <- function(input, output) {
    
    
            # Filter data based on selections
            dataShow <- reactive({
                data <- MassLocations
                Ddata <- MassDealers
                if (input$Dealer != "All") {
                    Ddata <- Ddata[Ddata$Dealer == input$Dealer]
                    data$Distance <- (distHaversine((cbind(Ddata$lng,Ddata$lat)),cbind(data$lng,data$lat)))/1600
                    data <- data[data$Distance < input$Distance, ]
                }
                
                
                
                
                if (input$City != "All") {
                    data <- data[data$City == input$City, ]
                }
                data
            })
            
            # Display
            output$table <- DT::renderDataTable(
                DT::datatable(dataShow()))      
        
        
        
        
        # map
        output$map01 <- renderLeaflet({
            #pal <- colorNumeric("YlOrRd", domain=c(min(quakes$mag), max(quakes$mag)))
            qMap <- leaflet(data = (dataShow())) %>% 
                addTiles() %>%
                addCircles(radius =3, color="red")
            qMap
        })
        
} 
        
# Run the application 
shinyApp(ui = ui, server = server)


在第 63 行,您漏掉了一个逗号,因此 Ddata 数据框无法响应子集操作。这是一个简单的修复,如下所示。

  # Filter data based on selections
  dataShow <- reactive({
    data <- MassLocations
    Ddata <- MassDealers
    if (input$Dealer != "All") {
      Ddata <- Ddata[Ddata$Dealer == input$Dealer, ]
      data$Distance <- (distHaversine((cbind(Ddata$lng,Ddata$lat)),cbind(data$lng,data$lat)))/1600
      data <- data[data$Distance < input$Distance, ]
    }