The code below calculates the distance in meters from one property to another. Note that the distance is in meters, but in addition to generating the distance in meters, I would like to generate the distance in kilometers (Km) as well. So, considering the example in the image below, it could look like this:
Road distance calculation: 24751 meters (approximately 24 Km)
Also, if possible, I would like the font size of the text Road distance calculation: Road distance calculation: 24751 meters
Code executable below:
library(shiny)
library(dplyr)
library(geosphere)
library(shinythemes)
library(googleway)
k=3
set_key( "AIzaSyBD6kgTlgcTa6iwLwoWtKrKQI6QNodEkmo")
function.cl<-function(Filter1,Filter2){
df<-structure(list(Properties = c(1, 2, 3, 4, 5, 6, 7), Latitude = c(-23.8,
-23.8, -23.9, -23.9, -23.9, -23.4, -23.5), Longitude = c(-49.6,
-49.3, -49.4, -49.8, -49.6, -49.4, -49.2),
cluster = c(1L, 2L, 2L, 1L, 1L, 3L,3L)), row.names = c(NA, -7L), class = "data.frame")
df1<-structure(list(Latitude = c(-23.8666666666667, -23.85, -23.45
), Longitude = c(-49.6666666666667, -49.35, -49.3), cluster = c(1,
2, 3)), class = "data.frame", row.names = c(NA, -3L))
#specific cluster and specific propertie
df_spec_clust <- df1[df1$cluster == Filter1,]
df_spec_prop<-df[df$Properties==Filter2,]
#Table to join
data_table <- df[order(df$cluster, as.numeric(df$Properties)),]
data_table_1 <- aggregate(. ~ cluster, df[,c("cluster","Properties")], toString)
# Map for route
if(nrow(df_spec_clust>0) & nrow(df_spec_prop>0)) {
df2<-google_directions(origin = df_spec_clust[,1:2],
destination = df_spec_prop[,2:3], mode = "driving")
distance_road <- sum(as.numeric(direction_steps(df2)$distance$value))
} else {
distance_road <- NA
}
return(list(
"distance_road" = distance_road,
"Data" = data_table_1,
"Data1" = data_table
))
}
ui <- bootstrapPage(
navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
"Cl",
tabPanel("Solution",
sidebarLayout(
sidebarPanel(
selectInput("Filter1", label = h4("Select just one cluster to show"),""),
selectInput("Filter2",label=h4("Select the cluster property designated above"),""),
textOutput("distance_road")
),
mainPanel(
tabsetPanel(
tabPanel(""))
)))))
server <- function(input, output, session) {
Modelcl<-reactive({
function.cl(input$Filter1,input$Filter2)
})
observeEvent(k, {
abc <- req(Modelcl()$Data)
updateSelectInput(session,'Filter1',
choices=sort(unique(abc$cluster)))
})
observeEvent(c(k,input$Filter1),{
abc <- req(Modelcl()$Data1) %>% filter(cluster == as.numeric(input$Filter1))
updateSelectInput(session,'Filter2',
choices=sort(unique(abc$Properties)))})
output$distance_road <- renderText({
paste0("Road distance calculation: ",Modelcl()$distance_road," meters")
})
}
shinyApp(ui = ui, server = server)
CodePudding user response：
Here you go:
library(shiny)
library(dplyr)
# library(geosphere)
library(shinythemes)
# library(googleway)
k=3
# set_key( "AIzaSyBD6kgTlgcTa6iwLwoWtKrKQI6QNodEkmo")
function.cl<-function(Filter1,Filter2){
list(distance_road = 24751)
}
ui <- bootstrapPage(
navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
"Cl",
tabPanel("Solution",
sidebarLayout(
sidebarPanel(
selectInput("Filter1", label = h4("Select just one cluster to show"),""),
selectInput("Filter2",label=h4("Select the cluster property designated above"),""),
textOutput("distance_road"),
tags$style(HTML(
'
#distance_road {
font-size: 2rem;
}
'
))
),
mainPanel(
tabsetPanel(
tabPanel(""))
)
)
)
)
)
server <- function(input, output, session) {
Modelcl<-reactive({
function.cl(input$Filter1,input$Filter2)
})
observeEvent(k, {
abc <- req(Modelcl()$Data)
updateSelectInput(session,'Filter1',
choices=sort(unique(abc$cluster)))
})
observeEvent(c(k,input$Filter1),{
abc <- req(Modelcl()$Data1) %>% filter(cluster == as.numeric(input$Filter1))
updateSelectInput(session,'Filter2',
choices=sort(unique(abc$Properties)))})
output$distance_road <- renderText({
paste0(
"Road distance calculation: ", Modelcl()$distance_road," meters ",
"(approximately ", floor(Modelcl()$distance_road/1000), " Km)"
)
})
}
shinyApp(ui = ui, server = server)
- I faked your
function.clfunction so it always returns24751. Change it back in your real case. - Change the
font-size: 2rem;to whatever font size you want. - Km calculation is added.
- Try not to post your key token in the question next time. It is insecure.
CodePudding user response：
We can increase the size of the font by surrounding the textOutput with a div and using the style argument, for example:
div(textOutput("distance_road"), style = "font-size: 20px;")
For displaying the distance in km we can use the glue function like this:
output$distance_road <- renderText({
glue::glue("Road distance calculation: {Modelcl()$distance_road} meters (approximately {round(Modelcl()$distance_road / 1000)} km)")
})
app code:
library(shiny)
library(dplyr)
library(geosphere)
library(shinythemes)
library(googleway)
k <- 3
set_key("your_api_key")
function.cl <- function(Filter1, Filter2) {
df <- structure(list(
Properties = c(1, 2, 3, 4, 5, 6, 7), Latitude = c(
-23.8,
-23.8, -23.9, -23.9, -23.9, -23.4, -23.5
), Longitude = c(
-49.6,
-49.3, -49.4, -49.8, -49.6, -49.4, -49.2
),
cluster = c(1L, 2L, 2L, 1L, 1L, 3L, 3L)
), row.names = c(NA, -7L), class = "data.frame")
df1 <- structure(list(Latitude = c(-23.8666666666667, -23.85, -23.45), Longitude = c(-49.6666666666667, -49.35, -49.3), cluster = c(
1,
2, 3
)), class = "data.frame", row.names = c(NA, -3L))
# specific cluster and specific propertie
df_spec_clust <- df1[df1$cluster == Filter1, ]
df_spec_prop <- df[df$Properties == Filter2, ]
# Table to join
data_table <- df[order(df$cluster, as.numeric(df$Properties)), ]
data_table_1 <- aggregate(. ~ cluster, df[, c("cluster", "Properties")], toString)
# Map for route
if (nrow(df_spec_clust > 0) & nrow(df_spec_prop > 0)) {
df2 <- google_directions(
origin = df_spec_clust[, 1:2],
destination = df_spec_prop[, 2:3], mode = "driving"
)
distance_road <- sum(as.numeric(direction_steps(df2)$distance$value))
} else {
distance_road <- NA
}
return(list(
"distance_road" = distance_road,
"Data" = data_table_1,
"Data1" = data_table
))
}
ui <- bootstrapPage(
navbarPage(
theme = shinytheme("flatly"), collapsible = TRUE,
"Cl",
tabPanel(
"Solution",
sidebarLayout(
sidebarPanel(
selectInput("Filter1", label = h4("Select just one cluster to show"), ""),
selectInput("Filter2", label = h4("Select the cluster property designated above"), ""),
div(textOutput("distance_road"), style = "font-size: 20px;")
),
mainPanel(
tabsetPanel(
tabPanel("")
)
)
)
)
)
)
server <- function(input, output, session) {
Modelcl <- reactive({
function.cl(input$Filter1, input$Filter2)
})
observeEvent(k, {
abc <- req(Modelcl()$Data)
updateSelectInput(session, "Filter1",
choices = sort(unique(abc$cluster))
)
})
observeEvent(c(k, input$Filter1), {
abc <- req(Modelcl()$Data1) %>% filter(cluster == as.numeric(input$Filter1))
updateSelectInput(session, "Filter2",
choices = sort(unique(abc$Properties))
)
})
output$distance_road <- renderText({
glue::glue("Road distance calculation: ", Modelcl()$distance_road, " meters ", "(approximately {round(Modelcl()$distance_road / 1000)} km)")
})
}
shinyApp(ui = ui, server = server)