У меня есть листовка с расположением складских мест в виде маркеров круга. Однако я заметил, что мне нужно навести указатель мыши на определенную область маркера круга, чтобы появилось всплывающее окно. Есть ли код, который я мог бы использовать для увеличения области, позволяющей отображать всплывающее окно?
Ссылка на 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")