Antonio
Antonio

Reputation: 1111

Insert distance in kilometers and increase text font in Shiny app

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)

enter image description here

Upvotes: 1

Views: 54

Answers (2)

jpdugo17
jpdugo17

Reputation: 7106

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)

Upvotes: 1

lz100
lz100

Reputation: 7340

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)
  1. I faked your function.cl function so it always returns 24751. Change it back in your real case.
  2. Change the font-size: 2rem; to whatever font size you want.
  3. Km calculation is added.
  4. Try not to post your key token in the question next time. It is insecure.

enter image description here

Upvotes: 2

Related Questions