基于不同类别组合的地图上的相交圆

时间:2019-07-22 20:28:19

标签: r-leaflet

我正在尝试构建一个应用,在该应用中,我展示一些圆,这些圆表示从特定坐标开始的工人的半径。但是,我还想包括一些分类变量,例如工人工作的星期几(星期一或星期二说)。选择它们时,我只想在地图上显示具有特定组合的圆。例如,如果我选择“星期一”并且我还选择了“经理安德鲁_XXXXX”,那么我只会看到“星期一”和“经理_XXXXX”的圈子,我无法使这些交叉点高效地发生。

我尝试了Intersecting Circles on a Map based on on different categorical variables。这将给出正确的结果,但是效率极低。

我还尝试使用overlayGroups和baseGroups,如下所示:


# packages load

library(leaflet)
library(shiny)

## Data

Latitude = c(33.79053,34.31533,21.44848,33.89115)
Longitude = c(-84.0348,-83.8166,-158.003, -117.295)
Worker = c('A','A','B','B')
Max.Distance.from.C.or.HB = c(35,55,75,20)
Manager = c('Andrew XXXXX','Andrew XXXXX','Andy YYYY', 'Andy YYYY')
Days = c('Tuesday','Monday','Monday','Tuesday')


coverage_data <- data.frame(Latitude,Longitude,Worker, Max.Distance.from.C.or.HB, Manager,
                            Days)


# Convert to miles


coverage_data <- coverage_data %>%
  mutate(Radius = coverage_data$Max.Distance.from.C.or.HB * 1609.34)


#Show  days Monday to Friday
coverage_Monday <- coverage_data %>%
  filter(Days == "Monday")
coverage_Tuesday <- coverage_data %>%
   filter(Days == 'Tuesday')



#Create label for Monday cases
coverage_Monday$label <- paste("<p>", coverage_Monday$Worker, "</p>",
                               "<p>", coverage_Monday$Manager, "</p>",
                               "<p>", coverage_Monday$Days, "</p>",
                               "<p>", coverage_Monday$Radius, "</p>",
                               sep="")

#Create label for Tuesday cases
coverage_Tuesday$label <- paste("<p>", coverage_Tuesday$Worker, "</p>",
                                "<p>", coverage_Tuesday$Manager, "</p>",
                                "<p>", coverage_Tuesday$Days, "</p>",
                                "<p>", coverage_Tuesday$Radius, "</p>",
                                sep="")





####### map 2  Managers ########

#Show  Managers coverage

coverage_Andrew_XXXXX<- coverage_data %>%
  filter(Manager == "Andrew XXXXX")
coverage_Andy_YYYY <- coverage_data %>%
  filter(Manager == 'Andy YYYY')




#Create label for Managers
 coverage_Andrew_XXXXX$label <- paste("<p>", coverage_Andrew_XXXXX$Worker, "</p>",
                                       "<p>", coverage_Andrew_XXXXX$Manager, "</p>",
                                        "<p>", coverage_Andrew_XXXXX$Days, "</p>",
                                        "<p>", coverage_Andrew_XXXXX$Radius, "</p>",
                                        sep="")


 coverage_Andy_YYYY$label <- paste(  "<p>", coverage_Andy_YYYY$Worker, "</p>", 
                                     "<p>", coverage_Andy_YYYY$Manager, "</p>",
                                        "<p>", coverage_Andy_YYYY$Days, "</p>",
                                        "<p>", coverage_Andy_YYYY$Radius, "</p>",
                                        sep="")




# 
pal <- colorFactor(
  palette = 'Set1',   #Dark2 is another palette option
  domain = coverage_data$Worker
)

  #colorFactor


#add checkbox control.


mapreprex <- leaflet(coverage_data) %>%
  setView(lng = -95.7129, lat = 34.0902, zoom = 4.499) %>%
  addProviderTiles(providers$OpenStreetMap.France, group = 'Monday') %>%
  addProviderTiles(providers$OpenStreetMap.France, group = 'Tuesday') %>%

  ###### DAYS #######
addCircles(lng = coverage_Monday$Longitude,
           lat = coverage_Monday$Latitude,
           color = ~pal(coverage_Monday$Worker),
           weight = 1,
           radius = coverage_Monday$Radius,
           opacity = 0.5,
           #label = lapply(coverage_Monday$label, HTML),
           fillOpacity = 0.55,
           group = "Monday") %>%

   addCircles(lng = coverage_Tuesday$Longitude,
              lat = coverage_Tuesday$Latitude,
              color = ~pal(coverage_Tuesday$Worker),
              weight = 1,
              radius = coverage_Tuesday$Radius,
              opacity = 0.5,
              fillOpacity = 0.55,
             label = lapply(coverage_Tuesday$label, HTML),
              group = "Tuesday") %>%


  ####### MANAGERS ######
 addCircles(lng = coverage_Andrew_XXXXX$Longitude,
            lat = coverage_Andrew_XXXXX$Latitude,
            color = ~pal(coverage_Andrew_XXXXX$Worker),
            weight = 1,
            radius = coverage_Andrew_XXXXX$Radius,
            opacity = 0.5,
            label = lapply(coverage_Andrew_XXXXX$label, HTML),
            fillOpacity = 0.55,
            group = "Andrew XXXXX") %>%

   addCircles(lng = coverage_Andy_YYYY$Longitude,
             lat = coverage_Andy_YYYY$Latitude,
              color = ~pal(coverage_Andy_YYYY$Worker),
              weight = 1,
              radius = coverage_Andy_YYYY$Radius,
              opacity = 0.5,
              fillOpacity = 0.55,
              label = lapply(coverage_Andy_YYYY$label, HTML),
              group = "Andy YYYY") %>%



  addLayersControl(
 overlayGroups= c("Andrew XXXXX", "Andy YYYY"),
    baseGroups =  c("Monday", "Tuesday"),
    options = layersControlOptions(collapsed = FALSE))

mapreprex 



在我的应用中,我希望能够选择日期(星期一)和经理,从而在星期一看到该经理的圈子。

从上面的代码中注意到,当我选择星期一和安德鲁XXXXX时,星期二的数据也会显示,这是错误的!

0 个答案:

没有答案