如何使用传单、地球球和 R shiny 计算两点之间的距离
How to calculate distance between 2 points with leaflet, geosphere, and R shiny
这是我的代码的简化工作表示。我有两个点位置集合。一个是汽车,一个是经销商。有一个以英里为单位的距离滑块。如果用户单击经销商位置并选择滑块上的距离,则地图上只会显示距所选经销商距离内的汽车位置。我有另一个城市选择列表,效果很好。但是,当我选择经销商时,显示出现错误,我得到 Warning: Error 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, ]
}
这是我的代码的简化工作表示。我有两个点位置集合。一个是汽车,一个是经销商。有一个以英里为单位的距离滑块。如果用户单击经销商位置并选择滑块上的距离,则地图上只会显示距所选经销商距离内的汽车位置。我有另一个城市选择列表,效果很好。但是,当我选择经销商时,显示出现错误,我得到 Warning: Error 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, ]
}