我是R Shiny的新手，并且想要创建一个显示两层点的应用程序。对于第1层中的任何点，当用户单击它时，我将显示一个弹出窗口，其中包含第1层中点的名称，第2层中最近点的名称以及这些点之间的距离。这可行。
我也想从选定的点到最近的点画一条线，以明确第2层中的点在哪里。我的产生弹出部分的代码在这里：
m = leaflet(random.points.interviewers) %>% addTiles()
m<-m %>% addCircleMarkers(radius = ~size, color = ~"blue", fill = FALSE )
m<-m %>% addCircleMarkers(data=temp,radius = ~1, color = ~"grey", fill = FALSE,
popup = (paste("<b>Name: </b>",temp$Name,"<br>",
"<b>Nearest Layr2Points: </b>",temp$ClosestLayr2Points,"<br>",
"<b>Distance to nearest Layr2Points: </b>",round(temp$Distance2NearestLayr2Points,2)," (kms)","<hr>"))
) )
m<-m %>% addCircles(data=random.points.interviewers,radius = ~50000, color = ~"red", fill = FALSE )
m<-m %>% addCircles(data=random.points.interviewers,radius = ~100000, color = ~"blue", fill = FALSE )
m<-m %>% addCircles(data=random.points.interviewers,radius = ~200000, color = ~"brown", fill = FALSE )
m<-m %>% setView(-98.556061, 39.810492, zoom = 4)
我不确定要包括什么内容才能划出一条线，并且无法在线找到任何内容。
整个应用程序的代码在这里：
#### Shiny app for mapping ####
#### Read in necessary libraries
library(geosphere)
library(shiny)
library(leaflet)
library(htmltools)
library(htmlwidgets)
library(rgdal)
library(knitr)
library(rmarkdown)
library(markdown)
library(webshot)
#webshot::install_phantomjs()
library(flexdashboard)
library(randomNames)
library(stringi)
library(shinydashboard)
library(leaflet.extras)
library(spdep)
library(sp)
library(maptools)
library(raster)
library(rgeos)
library(shinythemes)
library(DT)
#### Make a data set we can use #####
## Read in US boundaries
US<-readOGR("US boundaries/cb_2017_us_county_5m.shp")
## Make date sequence
date.seq<-seq.Date(as.Date("2016/1/1"),as.Date(format(Sys.time()), "%Y-%m-%d"),by="week")
## Create random points
random.points.samples<-(spsample((US),n=10000,type="random"))
## Create random points
random.points.interviewers<-(spsample((US),n=100,type="random"))
## Convert to normal spatial data frame
random.points.samples<-as.data.frame(random.points.samples)
random.points.interviewers<-as.data.frame(random.points.interviewers)
## make some random data
k<-10000
#x <- c(rep("A class",0.1*k),rep("B class",0.2*k),rep("C class",0.65*k),rep("D class",0.05*k))
#random.points$Class <- as.factor(sample(x, k))
random.points.samples$Name<-randomNames(k,gender=sample(1:2,k,replace = TRUE))
random.points.samples$Notes<-stri_rand_lipsum(k)
#random.points$Class <- as.factor(sample(x, k))
random.points.interviewers$Name<-randomNames(100,gender=sample(1:2,100,replace = TRUE))
random.points.interviewers$Notes<-stri_rand_lipsum(100)
#random.points$Age<-round(abs(rnorm(100,40,30)))
#random.points$Year<-date.seq[i]
## tie it in ##
#if(i!=1)
#{out<-rbind(out,random.points)}else{out<-random.points}
#}
## Convert to spatial objects
coordinates(random.points.samples)<-~x+y
coordinates(random.points.interviewers)<-~x+y
## Fix coord system
crs(random.points.interviewers)<-crs(US)
crs(random.points.samples)<-crs(US)
## Find out how many points are in a 50 mile radius of every surveyor point
random.points.interviewers$Radius50<-rowSums(distm (random.points.interviewers,random.points.samples,
fun = distHaversine) / 1000 <= 50)
random.points.interviewers$Radius100<-rowSums(distm (random.points.interviewers,random.points.samples,
fun = distHaversine) / 1000 <= 100)
random.points.interviewers$Radius200<-rowSums(distm (random.points.interviewers,random.points.samples,
fun = distHaversine) / 1000 <= 200)
random.points.interviewers$RadiusOutofRange<-rowSums(distm (random.points.interviewers,random.points.samples,
fun = distHaversine) / 1000 > 200)
random.points.interviewers$RadiusNone<-NA
## Mark points within a 50k radius of an interviewer
random.points.samples$Within50kofLayr2Points<-rowSums(distm (random.points.samples, random.points.interviewers,
fun = distHaversine) / 1000 <= 50)
random.points.samples$Within100kofLayr2Points<-rowSums(distm (random.points.samples, random.points.interviewers,
fun = distHaversine) / 1000 <= 100)
random.points.samples$Within200kofLayr2Points<-rowSums(distm (random.points.samples, random.points.interviewers,
fun = distHaversine) / 1000 <= 200)
# random.points.samples$OutsideofLayr2Points<-rowSums(distm (random.points.samples, random.points.interviewers,
# fun = distHaversine) / 1000 > 200)
random.points.samples$Distance2NearestLayr2Points<-apply(distm (random.points.samples, random.points.interviewers,fun = distHaversine) / 1000 ,1,min)
random.points.samples$OutsideofLayr2Points<-0
random.points.samples$OutsideofLayr2Points[random.points.samples$Distance2NearestLayr2Points>200]<-1
## Get name of closest field worker
distances<-distm (random.points.samples, random.points.interviewers, fun = distHaversine) / 1000
for (i in 1:dim(random.points.samples)[1]){
random.points.samples$ClosestLayr2Points[i]<-random.points.interviewers$Name[which(distances[i,]==random.points.samples$Distance2NearestLayr2Points[i])]
}
###### Define UI for app that draws a histogram ---- ####
ui <- fluidPage(
theme = shinytheme("darkly"),
# App title ----
titlePanel(" Mapping Tool"),
h4("Description: this tool represents a randomly created dataset of field workers and sample lines"),
# Sidebar panel for inputs ----
sidebarPanel(
h5("Use the radio buttons to show all sample lines, select a radius around an Layr2Points to show
points within or select out of range to show all points outside the working range of Layr2Pointss."),
radioButtons("RadiusInput", "Select sample lines:",
c("All" = "All",
"50 kms" = "50k",
"100 kms" = "100k",
"200 kms" = "200k",
"Out of range" = "Out of range"),
selected = c("All"))
),
# Main panel for displaying outputs ----
mainPanel(
tabsetPanel(
tabBox(
title = tagList("Results"),
tabPanel("Map",
h2("Locations of sample lines and Layr2Pointss", align="center"),
h5("Click on sample lines to show names and name of nearest Point in Layer 2", align="center"),
# Output: Map
leafletOutput("mymap")
),
tabPanel("Table","Data table",
div(DT::dataTableOutput("mytable"), style=c("color:black"))
)
)
))
)
# Define server logic required to draw a histogram ----
server <- function(input, output) {
output$mymap <- renderLeaflet({
## Set size and color of dots
size<-3
color<-c('red')
temp<-random.points.samples
if(input$RadiusInput=="All"){
temp<-temp}
if(input$RadiusInput=="50k"){
temp<-subset(temp,temp$Within50kofLayr2Points>0)}
if(input$RadiusInput=="100k"){
temp<-subset(temp,temp$Within100kofLayr2Points>0)}
if(input$RadiusInput=="200k"){
temp<-subset(temp,temp$Within200kofLayr2Points>0)}
if(input$RadiusInput=="Out of range"){
temp<-subset(temp,temp$OutsideofLayr2Points>0)}
m = leaflet(random.points.interviewers) %>% addTiles()
m<-m %>% addCircleMarkers(radius = ~size, color = ~"blue", fill = FALSE )
m<-m %>% addCircleMarkers(data=temp,radius = ~1, color = ~"grey", fill = FALSE,
popup = (paste("<b>Name: </b>",temp$Name,"<br>",
"<b>Nearest Layr2Points: </b>",temp$ClosestLayr2Points,"<br>",
"<b>Distance to nearest Layr2Points: </b>",round(temp$Distance2NearestLayr2Points,2)," (kms)","<hr>"))
) )
m<-m %>% addCircles(data=random.points.interviewers,radius = ~50000, color = ~"red", fill = FALSE )
m<-m %>% addCircles(data=random.points.interviewers,radius = ~100000, color = ~"blue", fill = FALSE )
m<-m %>% addCircles(data=random.points.interviewers,radius = ~200000, color = ~"brown", fill = FALSE )
m<-m %>% setView(-98.556061, 39.810492, zoom = 4)
})
output$mytable = DT::renderDataTable({
temp<-data.frame(random.points.interviewers)
if(input$RadiusInput=="All"){
temp<-temp[,c("Name","RadiusNone","Notes")]}
if(input$RadiusInput=="50k"){
temp<-subset(temp,temp$Radius50>0)[,c("Name","Radius50","Notes")]}
if(input$RadiusInput=="100k"){
temp<-subset(temp,temp$Radius50>0)[,c("Name","Radius100","Notes")]}
if(input$RadiusInput=="200k"){
temp<-subset(temp,temp$Radius50>0)[,c("Name","Radius200","Notes")]}
if(input$RadiusInput=="Out of range"){
temp<-subset(temp,temp$Radius50>0)[,c("Name","RadiusOutofRange","Notes")]}
names(temp)<-c("Layr2Points Name","Number of sample lines","Notes")
colnames(temp)[c(1:3)] <- paste0('<span style="color:',c("white","white","white"),'">',colnames(temp)[c(1:3)],'</span>')
DT::datatable(temp,escape=F) %>%
formatStyle(columns = 1, color = "black") %>%
formatStyle(columns = 3, color = "black", width=200)
},
options = list(
autoWidth = TRUE
#,
#columnDefs = list(list(width = '300px', targets = "_all"))
))
}
shinyApp(ui = ui, server = server)