计算坐标之间的距离并插入光泽
问题描述 投票：1回答：2
[朋友，您能帮我在发光的物体上插入坐标之间的距离吗？基本上，我的闪亮对象具有与所需聚类数量相对应的sliderInput，后跟一个选项，他希望在地图上看到哪个聚类，以及第二个选项，他想要看到所选聚类的哪个行业。到目前为止，它工作正常。请注意，在地图上始终有一个定位点和一个行业，因为为了生成地图，我将数据库df与数据库df1结合在一起。但是，我想添加另一个功能，该功能是计算此定位点与行业之间的距离。我插入了一张图片，以更好地说明我的想法。我相信距离计算公式也是我在下面插入的公式，我只需要帮助闪亮即可在我创建的textInput（Filter3）中显示距离。如果不是textInput，也可以是另一种方式。因此，无论何时选择集群和行业，我都打算展示它们之间的距离。可执行代码如下。
library(shiny)
library(ggplot2)
library(rdist)
library(geosphere)
library(shinythemes)
library(leaflet)
function.cl<-function(df,k,Filter1,Filter2,Filter3){
df<-structure(list(Industries = c(1,2,3,4,5,6),
Latitude = c(-23.8, -23.8, -23.9, -23.7, -23.7,-23.7),
Longitude = c(-49.5, -49.6, -49.7, -49.8, -49.6,-49.9),
Waste = c(526, 350, 526, 469, 534, 346)), class = "data.frame", row.names = c(NA, -6L))
#clusters
coordinates<-df[c("Latitude","Longitude")]
d<-as.dist(distm(coordinates[,2:1]))
fit.average<-hclust(d,method="average")
clusters<-cutree(fit.average, k)
nclusters<-matrix(table(clusters))
df$cluster <- clusters
#Center of mass
center_mass<-matrix(nrow=k,ncol=2)
for(i in 1:k){
center_mass[i,]<-c(weighted.mean(subset(df,cluster==i)$Latitude,subset(df,cluster==i)$Waste),
weighted.mean(subset(df,cluster==i)$Longitude,subset(df,cluster==i)$Waste))}
coordinates$cluster<-clusters
center_mass<-cbind(center_mass,matrix(c(1:k),ncol=1))
#Coverage
coverage<-matrix(nrow=k,ncol=1)
for(i in 1:k){
aux_dist<-distm(rbind(subset(coordinates,cluster==i),center_mass[i,])[,2:1])
coverage[i,]<-max(aux_dist[nclusters[i,1]+1,])}
coverage<-cbind(coverage,matrix(c(1:k),ncol=1))
colnames(coverage)<-c("Coverage_meters","cluster")
#Sum of Waste from clusters
sum_waste<-matrix(nrow=k,ncol=1)
for(i in 1:k){
sum_waste[i,]<-sum(subset(df,cluster==i)["Waste"])
}
sum_waste<-cbind(sum_waste,matrix(c(1:k),ncol=1))
colnames(sum_waste)<-c("Potential_Waste_m3","cluster")
#Tables to join information above and generate df1
data_table <- Reduce(merge, list(df, coverage,sum_waste))
data_table <- data_table[order(data_table$cluster, as.numeric(data_table$Industries)),]
data_table_1 <- aggregate(. ~ cluster + Coverage_meters + Potential_Waste_m3, data_table[,c(1,5,6,7)], toString)
df1<-as.data.frame(center_mass)
colnames(df1) <-c("Latitude", "Longitude", "cluster")
#specific cluster and specific propertie
df_spec_clust <- df1[df1$cluster == Filter1,]
df_spec_prop<-df[df$Industries==Filter2,]
#Color and Icon for map
ai_colors <-c("red","gray","blue","orange","green","beige","darkgreen","lightgreen", "lightred", "darkblue","lightblue",
"purple","darkpurple","pink", "cadetblue","white","darkred", "lightgray","black")
clust_colors <- ai_colors[df$cluster]
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = clust_colors)
leafIcons <- icons(
iconUrl = ifelse(df1$Industries,
"https://image.flaticon.com/icons/svg/542/542461.svg"
),
iconWidth = 45, iconHeight = 40,
iconAnchorX = 25, iconAnchorY = 12)
html_legend <- "<img src='https://image.flaticon.com/icons/svg/542/542461.svg'>"
# Map for specific cluster and propertie
if(nrow(df_spec_clust)>0){
clust_colors <- ai_colors[df_spec_clust$cluster]
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = clust_colors)
m1<-leaflet(df_spec_clust) %>% addTiles() %>%
addMarkers(~Longitude, ~Latitude, icon = leafIcons) %>%
addAwesomeMarkers(leaflet(df_spec_prop) %>% addTiles(), lat=~df_spec_prop$Latitude, lng = ~df_spec_prop$Longitude, icon= icons,label=~cluster)#%>%
plot1<-m1} else plot1 <- NULL
return(list(
"Plot1" = plot1,
"Data" = data_table_1,
"Data1" = data_table
))
}
ui <- bootstrapPage(
navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
"Cl",
tabPanel("Solution",
sidebarLayout(
sidebarPanel(
tags$b(h3("Choose the cluster number?")),
sliderInput("Slider", h5(""),
min = 2, max = 4, value = 3),
selectInput("Filter1", label = h4("Select just one cluster to show"),""),
selectInput("Filter2",label=h4("Select the cluster property designated above"),""),
textInput("Filter3", label = h4("Distance is:"), value = "Enter text..."),
),
mainPanel(
tabsetPanel(
tabPanel("Solution", (leafletOutput("Leaf",width = "95%", height = "600"))))),
))))
server <- function(input, output, session) {
Modelcl<-reactive({
function.cl(df,input$Slider,input$Filter1,input$Filter2,input$Filter3)
})
output$Leaf <- renderLeaflet({
Modelcl()[[1]]
})
observeEvent(c(df,input$Slider),{
abc <- req(Modelcl()$Data)
updateSelectInput(session,'Filter1',
choices=c(sort(unique(abc$cluster))))
})
observeEvent(c(df,input$Slider,input$Filter1),{
abc <- req(Modelcl()$Data1) %>% filter(cluster == as.numeric(input$Filter1))
updateSelectInput(session,'Filter2',
choices = unique(abc$Industries))
})
}
shinyApp(ui = ui, server = server)
非常感谢！
2个回答
1
投票
投票
我认为我对所有内容都理解正确，但是如果我错过了一些内容，请详细说明。
假设这段代码完成了您需要的距离计算：
#Coverage
coverage<-matrix(nrow=k,ncol=1)
for(i in 1:k){
aux_dist<-distm(rbind(subset(coordinates,cluster==i),center_mass[i,])[,2:1])
coverage[i,]<-max(aux_dist[nclusters[i,1]+1,])}
coverage<-cbind(coverage,matrix(c(1:k),ncol=1))
colnames(coverage)<-c("Coverage_meters","cluster")
然后您需要返回coverage矩阵以及其他元素：
return(list(
"Plot1" = plot1,
"Data" = data_table_1,
"Data1" = data_table,
"Cover" = coverage
))
并且索引依赖于服务器中input$Filter1的矩阵：
output$dist <- renderText({
cover <- data.frame(Modelcl()[[4]])
cover$Coverage_meters[cover$cluster == input$Filter1]
})
请注意，您不需要input$Filter3。仅当您期望用户输入距离时？但是，如果目标是显示距离，则需要使用以下内容替换该输入：
h4("Distance is:"),
textOutput("dist"),
然后我们得到这样的东西：
编辑
要索引Data1而不是Cover，请使用以下renderText：
output$dist <- renderText({
data1 <- data.frame(Modelcl()[[3]])
data1$Coverage_meters[data1$cluster == input$Filter1 & data1$Industries == input$Filter2]
})
完整代码：
library(shiny)
library(ggplot2)
library(rdist)
library(geosphere)
library(shinythemes)
library(leaflet)
function.cl<-function(df,k,Filter1,Filter2){
df<-structure(list(Industries = c(1,2,3,4,5,6),
Latitude = c(-23.8, -23.8, -23.9, -23.7, -23.7,-23.7),
Longitude = c(-49.5, -49.6, -49.7, -49.8, -49.6,-49.9),
Waste = c(526, 350, 526, 469, 534, 346)), class = "data.frame", row.names = c(NA, -6L))
#clusters
coordinates<-df[c("Latitude","Longitude")]
d<-as.dist(distm(coordinates[,2:1]))
fit.average<-hclust(d,method="average")
clusters<-cutree(fit.average, k)
nclusters<-matrix(table(clusters))
df$cluster <- clusters
#Center of mass
center_mass<-matrix(nrow=k,ncol=2)
for(i in 1:k){
center_mass[i,]<-c(weighted.mean(subset(df,cluster==i)$Latitude,subset(df,cluster==i)$Waste),
weighted.mean(subset(df,cluster==i)$Longitude,subset(df,cluster==i)$Waste))}
coordinates$cluster<-clusters
center_mass<-cbind(center_mass,matrix(c(1:k),ncol=1))
#Coverage
coverage <- matrix(nrow = k, ncol = 1)
for (i in 1:k) {
aux_dist <-
distm(rbind(subset(coordinates, cluster == i), center_mass[i, ])[, 2:1])
coverage[i, ] <- max(aux_dist[nclusters[i, 1] + 1, ])
}
coverage <- cbind(coverage, matrix(c(1:k), ncol = 1))
colnames(coverage) <- c("Coverage_meters", "cluster")
#Sum of Waste from clusters
sum_waste<-matrix(nrow=k,ncol=1)
for(i in 1:k){
sum_waste[i,]<-sum(subset(df,cluster==i)["Waste"])
}
sum_waste<-cbind(sum_waste,matrix(c(1:k),ncol=1))
colnames(sum_waste)<-c("Potential_Waste_m3","cluster")
#Tables to join information above and generate df1
data_table <- Reduce(merge, list(df, coverage,sum_waste))
data_table <- data_table[order(data_table$cluster, as.numeric(data_table$Industries)),]
data_table_1 <- aggregate(. ~ cluster + Coverage_meters + Potential_Waste_m3, data_table[,c(1,5,6,7)], toString)
df1<-as.data.frame(center_mass)
colnames(df1) <-c("Latitude", "Longitude", "cluster")
#specific cluster and specific propertie
df_spec_clust <- df1[df1$cluster == Filter1,]
df_spec_prop<-df[df$Industries==Filter2,]
#Color and Icon for map
ai_colors <-c("red","gray","blue","orange","green","beige","darkgreen","lightgreen", "lightred", "darkblue","lightblue",
"purple","darkpurple","pink", "cadetblue","white","darkred", "lightgray","black")
clust_colors <- ai_colors[df$cluster]
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = clust_colors)
leafIcons <- icons(
iconUrl = ifelse(df1$Industries,
"https://image.flaticon.com/icons/svg/542/542461.svg"
),
iconWidth = 45, iconHeight = 40,
iconAnchorX = 25, iconAnchorY = 12)
html_legend <- "<img src='https://image.flaticon.com/icons/svg/542/542461.svg'>"
# Map for specific cluster and propertie
if (nrow(df_spec_clust) > 0) {
clust_colors <- ai_colors[df_spec_clust$cluster]
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = clust_colors
)
m1 <- leaflet(df_spec_clust) %>% addTiles() %>%
addMarkers( ~ Longitude, ~ Latitude, icon = leafIcons) %>%
addAwesomeMarkers(
leaflet(df_spec_prop) %>% addTiles(),
lat = ~ df_spec_prop$Latitude,
lng = ~ df_spec_prop$Longitude,
icon = icons,
label = ~ cluster
)#%>%
plot1 <- m1
} else
plot1 <- NULL
return(list(
"Plot1" = plot1,
"Data" = data_table_1,
"Data1" = data_table,
"Cover" = coverage
))
}
ui <- bootstrapPage(
navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
"Cl",
tabPanel("Solution",
sidebarLayout(
sidebarPanel(
tags$b(h3("Choose the cluster number?")),
sliderInput("Slider", h5(""),
min = 2, max = 4, value = 3),
selectInput("Filter1", label = h4("Select just one cluster to show"),""),
selectInput("Filter2",label=h4("Select the cluster property designated above"),""),
h4("Distance is:"),
textOutput("dist"),
),
mainPanel(
tabsetPanel(
tabPanel("Solution", (leafletOutput("Leaf",width = "95%", height = "600"))))),
))))
server <- function(input, output, session) {
Modelcl<-reactive({
function.cl(df,input$Slider,input$Filter1,input$Filter2)
})
output$Leaf <- renderLeaflet({
Modelcl()[[1]]
})
observeEvent(c(df,input$Slider),{
abc <- req(Modelcl()$Data)
updateSelectInput(session,'Filter1',
choices=c(sort(unique(abc$cluster))))
})
observeEvent(c(df,input$Slider,input$Filter1),{
abc <- req(Modelcl()$Data1) %>% filter(cluster == as.numeric(input$Filter1))
updateSelectInput(session,'Filter2', choices = unique(abc$Industries))
})
output$dist <- renderText({
cover <- data.frame(Modelcl()[[4]])
cover$Coverage_meters[cover$cluster == input$Filter1]
})
}
shinyApp(ui = ui, server = server)
1
投票
投票
问题的解决方法
library(shiny)
library(ggplot2)
library(rdist)
library(geosphere)
library(shinythemes)
library(leaflet)
function.cl<-function(df,k,Filter1,Filter2,Filter3){
df<-structure(list(Industries = c(1,2,3,4,5,6),
Latitude = c(-23.8, -23.8, -23.9, -23.7, -23.7,-23.7),
Longitude = c(-49.5, -49.6, -49.7, -49.8, -49.6,-49.9),
Waste = c(526, 350, 526, 469, 534, 346)), class = "data.frame", row.names = c(NA, -6L))
k=3
#clusters
coordinates<-df[c("Latitude","Longitude")]
d<-as.dist(distm(coordinates[,2:1]))
fit.average<-hclust(d,method="average")
clusters<-cutree(fit.average, k)
nclusters<-matrix(table(clusters))
df$cluster <- clusters
#Center of mass
center_mass<-matrix(nrow=k,ncol=2)
for(i in 1:k){
center_mass[i,]<-c(weighted.mean(subset(df,cluster==i)$Latitude,subset(df,cluster==i)$Waste),
weighted.mean(subset(df,cluster==i)$Longitude,subset(df,cluster==i)$Waste))}
coordinates$cluster<-clusters
center_mass<-cbind(center_mass,matrix(c(1:k),ncol=1))
#Coverage
coverage<-matrix(nrow=k,ncol=1)
for(i in 1:k){
aux_dist<-distm(rbind(subset(coordinates,cluster==i),center_mass[i,])[,2:1])
coverage[i,]<-max(aux_dist[nclusters[i,1]+1,])}
coverage<-cbind(coverage,matrix(c(1:k),ncol=1))
colnames(coverage)<-c("Coverage_meters","cluster")
#Sum of Waste from clusters
sum_waste<-matrix(nrow=k,ncol=1)
for(i in 1:k){
sum_waste[i,]<-sum(subset(df,cluster==i)["Waste"])
}
sum_waste<-cbind(sum_waste,matrix(c(1:k),ncol=1))
colnames(sum_waste)<-c("Potential_Waste_m3","cluster")
#Tables to join information above and generate df1
data_table <- Reduce(merge, list(df, coverage,sum_waste))
data_table <- data_table[order(data_table$cluster, as.numeric(data_table$Industries)),]
data_table_1 <- aggregate(. ~ cluster + Coverage_meters + Potential_Waste_m3, data_table[,c(1,5,6,7)], toString)
df1<-as.data.frame(center_mass)
colnames(df1) <-c("Latitude", "Longitude", "cluster")
#specific cluster and specific propertie
df_spec_clust <- df1[df1$cluster == Filter1,]
df_spec_prop<-df[df$Industries==Filter2,]
#Color and Icon for map
ai_colors <-c("red","gray","blue","orange","green","beige","darkgreen","lightgreen", "lightred", "darkblue","lightblue",
"purple","darkpurple","pink", "cadetblue","white","darkred", "lightgray","black")
clust_colors <- ai_colors[df$cluster]
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = clust_colors)
leafIcons <- icons(
iconUrl = ifelse(df1$Industries,
"https://image.flaticon.com/icons/svg/542/542461.svg"
),
iconWidth = 45, iconHeight = 40,
iconAnchorX = 25, iconAnchorY = 12)
html_legend <- "<img src='https://image.flaticon.com/icons/svg/542/542461.svg'>"
# Map for specific cluster and propertie
if(nrow(df_spec_clust)>0){
clust_colors <- ai_colors[df_spec_clust$cluster]
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = clust_colors)
m1<-leaflet(df_spec_clust) %>% addTiles() %>%
addMarkers(~Longitude, ~Latitude, icon = leafIcons) %>%
addAwesomeMarkers(leaflet(df_spec_prop) %>% addTiles(), lat=~df_spec_prop$Latitude, lng = ~df_spec_prop$Longitude, icon= icons,label=~cluster)#%>%
plot1<-m1} else plot1 <- NULL
mydf<- merge(df,df1,by = c("cluster"), suffixes = c("_df","_df1"))
(mydf$distances <- purrr::pmap_dbl(.l = list(mydf$Longitude_df,
mydf$Latitude_df,
mydf$Longitude_df1,
mydf$Latitude_df1),
.f = ~distm(c(..1,..2),c(..3,..4))))
return(list(
"Plot1" = plot1,
"Data" = data_table_1,
"Data1" = data_table,
"Cover" = mydf
))
}
ui <- bootstrapPage(
navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
"Cl",
tabPanel("Solution",
sidebarLayout(
sidebarPanel(
tags$b(h3("Choose the cluster number?")),
sliderInput("Slider", h5(""),
min = 2, max = 4, value = 3),
selectInput("Filter1", label = h4("Select just one cluster to show"),""),
selectInput("Filter2",label=h4("Select the cluster property designated above"),""),
h4("Distance is:"),
textOutput("dist"),
),
mainPanel(
tabsetPanel(
tabPanel("Solution", (leafletOutput("Leaf",width = "95%", height = "600"))))),
))))
server <- function(input, output, session) {
Modelcl<-reactive({
function.cl(df,input$Slider,input$Filter1,input$Filter2,input$Filter3)
})
output$Leaf <- renderLeaflet({
Modelcl()[[1]]
})
observeEvent(c(df,input$Slider),{
abc <- req(Modelcl()$Data)
updateSelectInput(session,'Filter1',
choices=c(sort(unique(abc$cluster))))
})
observeEvent(c(df,input$Slider,input$Filter1),{
abc <- req(Modelcl()$Data1) %>% filter(cluster == as.numeric(input$Filter1))
updateSelectInput(session,'Filter2',
choices = unique(abc$Industries))
})
output$dist <- renderText({
cover <- data.frame(Modelcl()[[4]])
cover$distances[cover$cluster == input$Filter1 & cover$Industries == input$Filter2]
})
}
shinyApp(ui = ui, server = server)
最新问题
- Acumatica 自定义所有者选择器
- 如何按照 cron 计划安排 git 维护？
- 显示地理位置跳出div
- 使用放大手势；如何放大用户手指实际“捏”的位置？
- 如何从流中打印匹配元素，如果不存在则使用默认值？
- 如何从流中打印匹配元素，如果不存在则使用默认值？
- Python 类：NameError：名称“foo”未定义
- 渲染发生的位置，在客户端或服务器上
- 是否可以在azure devops中禁用手动触发发布管道
- 如何使用LifespanManager在FastAPI中测试反向代理（异步测试）
- 如何将 QuestDB 与 Java 8 一起使用？
- 找不到Create-react-app模块：错误：无法解析模块“child_process”
- 获取目录中每个文件的“头”？
- TypeScript：“类型是通用的，只能为阅读建立索引。(2862)”
- 如何修复访问被阻止：授权错误（请求详细信息：redirect_uri=http://web/market/social-auth/complete/google-oauth2/）？
- 创建可以处理 T4 文本模板的 Visual Studio 2022 (VSIX) 扩展
- 未找到 PyAutoGUI 图像
- OSX：关闭后无法打开 mysql workbench 主窗口
- 如何根据文件名中的日期获取最新文件？
- “_func”即使在 __all__
© www.soinside.com 2019 - 2024. All rights reserved.