Holiday ideas

Yes, it is a first world problem, but we always struggle with holiday destinations. I prefer flying upside down to somewhere different, whilst my wife and boy aren’t keen on heat or long flights. For that reason, I made this app to find somewhere that suits us all.

Robin Penfold
2019-02-15

For completeness (and reproducibility), here’s the code that I used to calculate what’s above.

Holiday calculations


library(airportr)
library(DT)
library(leaflet)
library(rvest)
library(shiny)
library(tidyverse)
library(xml2)
 
# temp_max <- 270
# time_max <- 7200

# index_page_LHR <- 'https://www.flightsfrom.com/LHR/destinations'
# index_page_LGW <- 'https://www.flightsfrom.com/LGW/destinations'

# airports_LHR <- read_html(index_page_LHR) %>%
#   html_nodes(".airport-content-destination-list-name") %>%
#   html_text() %>%
#   str_trim()

# times_LHR <- read_html(index_page_LHR) %>%
#   html_nodes(".airport-content-destination-list-time") %>%
#   html_text() %>%
#   str_trim()

# airports_LGW <- read_html(index_page_LGW) %>%
#   html_nodes(".airport-content-destination-list-name") %>%
#   html_text() %>%
#   str_trim()

# times_LGW <- read_html(index_page_LGW) %>%
#   html_nodes(".airport-content-destination-list-time") %>%
#   html_text() %>%
#   str_trim()

# data <- bind_rows(
#   tibble(
#     airports = airports_LHR, 
#     times = times_LHR, 
#     home = 'LHR'
#     ),
#   tibble(
#     airports = airports_LGW, 
#     times = times_LGW, 
#     home = 'LGW'
#     )
#   ) %>%
#   arrange(home) %>%
#   group_by(airports) %>%
#   slice(1) %>%
#   ungroup() %>%
#   arrange(airports) %>%
#   rowwise() %>%
#   mutate(
#     code = str_extract(
#       airports, 
#       '[[:upper:]][[:upper:]][[:upper:]]'
#       ),
#     position = str_locate_all(
#       airports, 
#       '[[:upper:]][[:upper:]][[:upper:]]'
#       )
#     ) %>%
#   separate(
#     col = times, 
#     into = c('split', 'detail'), 
#     sep = ": "
#     ) %>%
#   separate(
#     col = detail, 
#     into = c('hours', 'mins'), 
#     sep = "h "
#     ) %>%
#   rowwise() %>%
#   mutate(
#     mins = as.integer(
#       str_sub(mins, start = 1L, end = -2L)
#       ),
#     hours = as.integer(hours),
#     minutes = (60 * hours) + mins,
#     position1 = position[[1]] - 2,
#     position2 = position[[2]] + 2,
#     city = str_trim(
#       str_to_lower(
#         str_sub(
#           string = airports, 
#           start = 1L, 
#           end = position1)
#         )
#       ),
#     country = str_trim(
#       str_to_lower(
#         str_sub(
#           string = airports, 
#           start = position2, 
#           end = -1L)
#         )
#       )
#     )
  
# airport_data <- airportr::airports
  
# output <- data[, c('code', 'city', 'home', 'country', 
#                    'minutes')] %>%
#   left_join(airport_data, by = c('code' = 'IATA')) %>%
#   filter(!is.na(ICAO)) %>%
#   rowwise() %>%
#   mutate(
#     distance = airport_distance(home, code),
#     City = str_to_lower(City)
#     ) %>%
#   filter(code != "YYT")

# temp_data <- read_html(
#   'https://en.m.wikipedia.org/wiki/List_of_cities_by_average_temperature'
#   ) %>%
#   html_nodes("table") %>%
#   html_table(header = TRUE) %>%
#   bind_rows() %>%
#   select(-Year, -Ref.) %>%
#   mutate_at(
#     vars(-Country, -City), 
#     str_remove, 
#     '\\s*\\([^\\)]+\\)'
#     ) %>%
#   mutate_at(
#     vars(-Country, -City), 
#     as.numeric
#     ) %>%
#   mutate(
#     City = str_to_lower(City),
#     Country = str_to_lower(Country)
#     ) %>%
#   arrange(City)
  
# overall <- output %>%
#   left_join(temp_data, by = c('City' = 'City')) %>%
#   select(code, City, Country.x, minutes, ICAO, Latitude,
#          Longitude, UTC, distance, Aug) %>%
#   filter(
#     !is.na(Aug),
#     minutes <= time_max,
#     Aug <= temp_max
#     ) %>%
#   arrange(code) %>%
#   group_by(Country.x, City) %>%
#   slice(1) %>%
#   ungroup() %>%
#   arrange(City)

# write_rds(x = output, path = "output.rds")

output <- read_rds("output.rds")

pal <- colorNumeric(
    palette = "Reds",
    domain = overall$Aug)

ui <- fluidPage(

    titlePanel("What's the best holiday destination
               from London?"),
    br(),
    br(),

    fluidRow(
        column(
            width = 4,
            offset = 1,
            sliderInput("temp",
                        "Temperature", 
                        min = 0,
                        max = 40,
                        value = c(15, 25), 
                        step = 1, 
                        dragRange = TRUE)
            ),
        column(
            width = 4, 
            offset = 1,
            sliderInput("duration",
                        "Flight Time (mins)",
                        min = 0,
                        max = 1080,
                        value = c(60, 300), 
                        step = 30, 
                        dragRange = TRUE)
            )
        ),
        fluidRow(
            column(
                width = 8,
                leafletOutput("map_output")
            ),
            column(
                width = 4, 
                dataTableOutput("table_output")
            )
        ), 
    br()
    )

server <- function(input, output) {
    
    new_data <- reactive({
        overall %>% 
            filter(
                between(
                    Aug, input$temp[1], input$temp[2]
                    ),
                between(
                    minutes, input$duration[1], input$duration[2]
                    )
                )
    })

    output$map_output <- renderLeaflet({
        leaflet(new_data()) %>% 
            addTiles() %>% 
            setView(
                lng = -25, 
                lat = 45, 
                zoom = 3) %>% 
            addCircles(
                lng = ~Longitude, 
                lat = ~Latitude, 
                weight = 2,
                radius = ~sqrt(minutes) * 10000, 
                popup = ~paste(
                  City, 
                  "- time: ", 
                  round(minutes/60, 1), 
                  "hrs; temp: ", 
                  Aug, 
                  "C"
                  ), 
                color = ~pal(Aug)
            )
    })
    
    output$table_output <- renderDataTable ({
        datatable(
            new_data() %>% 
                select(
                    City = 'City', 
                    Time = 'minutes', 
                    Temp = 'Aug'
                    ), 
            rownames = FALSE,
            options=list(
                pageLength = 3,
                dom = 'tp',
                deferRender=TRUE, 
                scrollY=300, 
                scroller=TRUE
                )
        )
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

System settings


R version 3.6.0 (2019-04-26)
Platform: x86_64-apple-darwin15.6.0 (64-bit)
Running under: macOS  10.15

Matrix products: default
BLAS:   /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRblas.0.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRlapack.dylib

locale:
[1] en_GB.UTF-8/en_GB.UTF-8/en_GB.UTF-8/C/en_GB.UTF-8/en_GB.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods  
[7] base     

loaded via a namespace (and not attached):
 [1] compiler_3.6.0  magrittr_1.5    tools_3.6.0     htmltools_0.4.0
 [5] yaml_2.2.0      Rcpp_1.0.2      distill_0.7     stringi_1.4.3  
 [9] rmarkdown_1.16  knitr_1.25      stringr_1.4.0   xfun_0.9       
[13] digest_0.6.20   rlang_0.4.0     evaluate_0.14