Leaflet Click Area Отзывчивость - PullRequest
       7

Leaflet Click Area Отзывчивость

0 голосов
/ 18 октября 2019

У меня есть листовка с расположением складских мест в виде маркеров круга. Однако я заметил, что мне нужно навести указатель мыши на определенную область маркера круга, чтобы появилось всплывающее окно. Есть ли код, который я мог бы использовать для увеличения области, позволяющей отображать всплывающее окно?

Ссылка на html map на OneDrive Sharepoint. (Вы должны загрузить его, чтобы просмотреть его)

КОД:

# Clear Environment & Set Working Directory ####
rm(list = ls())

# Load Libraries ####
library(dplyr)
library(ggplot2)
library(rjson)
library(jsonlite)
library(leaflet)
library(RCurl)
library(mapview)
library(maps)
library(htmltools)
library(scales)
library(magrittr)

################# LAYERED MAP SCRIPT ################# 
# Import All Cooperative Data
All_data <- read.csv('Cooperative Locations 2019.csv', stringsAsFactors=FALSE, fileEncoding="UTF-8-BOM")
# Convert numeric values in spreadsheet to numeric for R
sapply(All_data, mode) # checks the class of the observations i.e. numeric, character, factor etc
# The Grain.Capacity.bu, CNGL columns are characters. Must be numeric in order to format them later
All_data <- transform(All_data, Grain.Capacity.bu = as.numeric(Grain.Capacity.bu),
                      CNGL = as.numeric(CNGL))
sapply(All_data, mode) # checks the class of the observations i.e. numeric, character, factor etc
# Import Non-Cooperative Data
non_coop_data <- read.csv('Non-Cooperative Locations 2019.csv', stringsAsFactors = FALSE, fileEncoding = "UTF-8-BOM")
sapply(non_coop_data, mode) # checks the class of the observations i.e. numeric, character, factor etc
non_coop_data <- transform(non_coop_data, Grain.Capacity.bu = as.numeric(Grain.Capacity.bu))
sapply(non_coop_data, mode) # checks the class of the observations i.e. numeric, character, factor etc

# Subset Data
Storage_All <- All_data %>%
  filter(HQ == "N")
# Group Cooperatives and create a column that lists all their locations
Locations_All <- Storage_All %>%
  group_by(Cooperative) %>%
  summarise(Locations = toString(unique(City)))
# Append to All_data dataframe
All_data <- merge(All_data, Locations_All, by = 'Cooperative', all = T)
KS_data <- All_data %>%
  filter(State == "Kansas")
# Subset Further
HQ_All <- All_data %>%
  filter(HQ == "Y")
HQ_KS <- HQ_All %>%
  filter(State == "Kansas")
#Need this so that the storage sites point to HQs in Kansas Only
KS_HQ <- HQ_KS$Cooperative

Storage_All <- All_data %>%
  filter(HQ == "N")
Storage_Grain_All <- All_data %>%
  filter(HQ == "N" & Grain == 1)
Storage_Grain_KS <- KS_data %>%
  filter(HQ == "N" & Grain == 1 & Cooperative %in% KS_HQ)

Storage_NonGrain_All <- All_data %>%
  filter(HQ == "N" & Grain == 0)
Storage_NonGrain_KS <- KS_data %>%
  filter(HQ == "N" & Grain == 0 & Cooperative %in% KS_HQ)

# Create an ID Column for every storage location
Storage_All$id <- seq_len(nrow(Storage_All))
Storage_Grain_All$id <- seq_len(nrow(Storage_Grain_All))
Storage_Grain_KS$id <- seq_len(nrow(Storage_Grain_KS))
Storage_NonGrain_All$id <- seq_len(nrow(Storage_NonGrain_All))
Storage_NonGrain_KS$id <- seq_len(nrow(Storage_NonGrain_KS))


# Set up data for connecting lines between HQs and storage locations
line_df_Grain_All <- Storage_Grain_All %>%
  select(Cooperative, lat, lng, Lat_HQ, Lng_HQ)

line_df_Grain_KS <- Storage_Grain_KS %>%
  select(Cooperative, lat, lng, Lat_HQ, Lng_HQ)

line_df_NonGrain_All <- Storage_NonGrain_All %>%
  select(Cooperative, lat, lng, Lat_HQ, Lng_HQ)

line_df_NonGrain_KS <- Storage_Grain_KS %>%
  select(Cooperative, lat, lng, Lat_HQ, Lng_HQ)


# Popup Labels for HQ_All
HQ_All_labels <- sprintf(
  "<strong>Cooperative Headquarters</strong>
  <br/><strong>Cooperative Name:</strong> %s
  <br/><strong>City:</strong> %s
  <br/><strong>State:</strong> %s
  <br/><strong>Number of Grain Storage Locations: </strong> %s
  <br/><strong>Locations: </strong> %s",
  HQ_All$Cooperative,
  HQ_All$City,
  HQ_All$State,
  comma(HQ_All$CNGL),
  HQ_All$Locations
) %>% 
  lapply(HTML)
# Popup Labels for All Grain Storage Locations
stor_Grain_All_labels <- sprintf(
  "<strong>Cooperative Grain Storage </strong>
  <br/><strong>Cooperative Name: </strong> %s
  <br/><strong>Branch Location: </strong> %s
  <br/><strong>Grain Capacity (bu): </strong> %s
  ",
  Storage_Grain_All$Cooperative,
  Storage_Grain_All$Branch,
  comma(Storage_Grain_All$Grain.Capacity.bu)
) %>% 
  lapply(HTML)

# Popup Labels for HQ_KS
HQ_KS_labels <- sprintf(
  "<strong>Cooperative Headquarters</strong>
  <br/><strong>Cooperative Name:</strong> %s
  <br/><strong>City:</strong> %s
  <br/><strong>State:</strong> %s
  <br/><strong>Number of Grain Storage Locations: </strong> %s
  <br/><strong>Locations: </strong> %s",
  HQ_KS$Cooperative,
  HQ_KS$City,
  HQ_KS$State,
  comma(HQ_KS$CNGL),
  HQ_KS$Locations
) %>% 
  lapply(HTML)
# Popup Labels for KS Grain Storage Locations
stor_Grain_KS_labels <- sprintf(
  "<strong>Cooperative Grain Storage </strong>
  <br/><strong>Cooperative Name: </strong> %s
  <br/><strong>Branch Location: </strong> %s
  <br/><strong>Grain Capacity (bu): </strong> %s
  ",
  Storage_Grain_KS$Cooperative,
  Storage_Grain_KS$Branch,
  comma(Storage_Grain_KS$Grain.Capacity.bu)
) %>% 
  lapply(HTML)

# Popup Labels for All NonGrain Storage Locations
stor_NonGrain_All_labels <- sprintf(
  "<strong>Cooperative Non-Grain Storage </strong>
  <br/><strong>Cooperative Name: </strong> %s
  <br/><strong>Branch Location: </strong> %s
  <br/><strong>Capacity (bu): </strong> %s
  ",
  Storage_NonGrain_All$Cooperative,
  Storage_NonGrain_All$Branch,
  comma(Storage_NonGrain_All$Grain.Capacity.bu)
) %>% 
  lapply(HTML)

# Since these observations don't have bushel capacity will not be added to the map
# Popup Labels for KS Non-Grain Storage Locations
stor_NonGrain_KS_labels <- sprintf(
  "<strong>Cooperative Non-Grain Storage </strong>
  <br/><strong>Cooperative Name: </strong> %s
  <br/><strong>Branch Location: </strong> %s
  <br/><strong>Capacity (bu): </strong> %s
  ",
  Storage_NonGrain_KS$Cooperative,
  Storage_NonGrain_KS$Branch,
  comma(Storage_NonGrain_KS$Grain.Capacity.bu)
) %>% 
  lapply(HTML)
# Since these observations don't have bushel capacity will not be added to the map
# Popup Labels for All Non-Cooperative Grain Locations
non_coop_data_labels <- sprintf(
  "<strong>Non-Cooperative</strong>
  <br/><strong>Company: </strong> %s
  <br/><strong>Location: </strong> %s
  <br/><strong>Grain Capacity (bu): </strong> %s
  ",
  non_coop_data$Company,
  non_coop_data$Location,
  comma(non_coop_data$Grain.Capacity.bu)
) %>% 
  lapply(HTML)


# Import Map
mapStates = map("state", fill = F, plot = FALSE)

# Map
star_stor_map <- leaflet(mapStates) %>%
  # Base Groups (Map Layers)
  addProviderTiles(providers$Esri.WorldStreetMap, group = "World Street Map") %>%
  addProviderTiles(providers$OpenRailwayMap, group = "Railway") %>%
  addProviderTiles(providers$Esri.WorldImagery, group = "Satellite") %>%
  addCircleMarkers(lng = ~Storage_Grain_All$lng, lat = ~Storage_Grain_All$lat,
                   popup = stor_Grain_All_labels,
                   color = '#512888', #K-State Purple
                   radius = 2.5,
                   fillColor = '#512888', #K-State Purple
                   fillOpacity = 0.5,
                   opacity = 0.5,
                   weight = 1,
                   stroke = T, group = "All Cooperatives with Grain Locations in Kansas"
  ) %>%
  addCircleMarkers(lng = ~Storage_Grain_KS$lng, lat = ~Storage_Grain_KS$lat,
                   popup = stor_Grain_KS_labels,
                   color = '#512888', #K-State Purple
                   radius = 2.5,
                   fillColor = '#512888', #K-State Purple
                   fillOpacity = 0.5,
                   opacity = 0.5,
                   weight = 1,
                   stroke = T, group = "Kansas Cooperatives with Grain Locations in Kansas"
  ) %>%
  addCircleMarkers(lng = ~HQ_All$lng, lat = ~HQ_All$lat,
                   popup = HQ_All_labels,
                   color = '#1a0034', #Very dark violet
                   radius = 7,
                   opacity = 0.6,
                   weight = 1,
                   stroke = T,
                   fillColor = '#1a0034', #Very dark violet
                   fillOpacity = 0.78,
                   group = "All Cooperatives with Grain Locations in Kansas") %>%
  addCircleMarkers(lng = ~HQ_KS$lng, lat = ~HQ_KS$lat,
                   popup = HQ_KS_labels,
                   color = '#1a0034', #Very dark violet
                   radius = 7,
                   opacity = 0.6,
                   weight = 1,
                   stroke = T,
                   fillColor = '#1a0034', #Very dark violet
                   fillOpacity = 0.78,
                   group = "Kansas Cooperatives with Grain Locations in Kansas") %>%
  addCircleMarkers(lng = ~non_coop_data$lng, lat = ~non_coop_data$lat,
                   popup = non_coop_data_labels,
                   color = '#990000', #crimson
                   radius = 2.5,
                   opacity = 0.5,
                   weight = 0.5,
                   stroke = T,
                   fillColor = '#990000', #crimson
                   fillOpacity = 0.78,
                   group = "Non-Cooperatives") %>%
  addLayersControl( #adds radio buttons to the map using the groups created as options
    baseGroups = c("World Street Map", "Railway", "Satellite"),
    overlayGroups = c("All Cooperatives with Grain Locations in Kansas", "Kansas Cooperatives with Grain Locations in Kansas", 
                      "Non-Cooperatives"),
    options = layersControlOptions(collapsed = FALSE)
  )
# Iteration for Connecting Lines, HQ_All to All Storage
for (i in 1:nrow(Storage_Grain_All)){
  star_stor_map <- addPolylines(star_stor_map,
                                lat = as.numeric(line_df_Grain_All[i, c(2, 4)]),
                                lng = as.numeric(line_df_Grain_All[i, c(3, 5)]),
                                color = '#512888', #K-State Purple
                                weight = 1, group = "All Cooperatives with Grain Locations in Kansas")
}

# Iteration for Connecting Lines, HQ_KS to KS Storage
for (i in 1:nrow(Storage_Grain_KS)){
  star_stor_map <-addPolylines(star_stor_map,
                               lat = as.numeric(line_df_Grain_KS[i, c(2, 4)]),
                               lng = as.numeric(line_df_Grain_KS[i, c(3, 5)]),
                               color = '#512888', #K-State Purple
                               weight = 1, group = "Kansas Cooperatives with Grain Locations in Kansas")

}

# View Map
star_stor_map
# Save as HTML
htmlwidgets::saveWidget(star_stor_map, file="star_stor_map.html")
...