user13047398
Reputation:
Calculate the distance between coordinates and insert in shiny
Friends, could you help me to insert the distance between coordinates in my shiny. Basically my shiny has a sliderInput that corresponds to the desired number of clusters, followed by an option of which cluster he wants to see on the map, and the second option which industry of the selected cluster he wants to see. So far it is working properly. Note that on the map there is always a location point and an industry, because for the generation of the map I am joining database df with database df1. However, I would like to add another feature, which is to calculate the distance between this location point and the industry. I inserted an attached image to better illustrate my idea. The distance calculation formula that I believe is the one I inserted below too, I just need help for shiny to display the distance in the textInput (Filter3) that I made. If not to be textInput it can be another way too. So, whenever he selects a cluster and the industry, I intend to show the distance between them too. The executable code is below.
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)
Thank you very much!
Upvotes: 0
Views: 427
Answers (2)
user13047398
Reputation:
Resolution for the question
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)
Upvotes: 0
teofil
Reputation: 2384
I think I understood everything correctly, but please elaborate if I missed something.
Assuming this bit of code does the distance calculation you need:
#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")
Then you need to return the coverage matrix along with the other elements:
return(list(
"Plot1" = plot1,
"Data" = data_table_1,
"Data1" = data_table,
"Cover" = coverage
))
and index that matrix dependent on input$Filter1 in the server:
output$dist <- renderText({
cover <- data.frame(Modelcl()[[4]])
cover$Coverage_meters[cover$cluster == input$Filter1]
})
Note that you don't need input$Filter3. This is only if you expect the user to input a distance? But if the goal is to display the distance, you need to replace that input with something like:
h4("Distance is:"),
textOutput("dist"),
Then we get something like this:
Edit
To index Data1 instead of Cover, use the following renderText:
output$dist <- renderText({
data1 <- data.frame(Modelcl()[[3]])
data1$Coverage_meters[data1$cluster == input$Filter1 & data1$Industries == input$Filter2]
})
Full code:
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)
Upvotes: 1
Related Questions
- How to calculate distance between two points with leaflet, geosphere, and R shiny
- extract and store coordinates in the dataframe using shiny
- Adjust the way to calculate the distance between two points in shiny code
- Insert distance in kilometers and increase text font in Shiny app
- Calculating distance between coordinates and reference point
- Calculating distance of multiple coordinates in R
- How to Calculate Distance between points from a reference point using R?
- Calculating eucledian distance inside reactive dataframe in shiny
- Find Distance Between Locations in R Data Frame
- Add a column of distances of two coordinates in R