library("rvest")
library("purrr")
library("stringi")
library("lubridate")
library("tidyverse")

# using purrr::safely is cool because if the page 
# is broken you get NULL as an output
s_read_html <- purrr::safely(read_html)

# helper for brevity
xtract_nodes <- function(node, css) {
  html_nodes(node, css) %>% html_text(trim = TRUE)
}

get_one_day_program <- function(date=Sys.Date(),
                                base_url="http://www.radioswissclassic.ch/en/music-programme/search/%s",
                                pb=NULL) {
  # progress bar magic!
  if (!is.null(pb)) pb$tick()$print()

  # that's the part where you're nice towards the website
  Sys.sleep(sample(seq(0,1,0.25), 1)) # ideally, make this sample(5,1)

  date <- ymd(date) # handles case where input is character ISO date

  pg <- s_read_html(sprintf(base_url, format(date, "%Y%m%d")))

  if (!is.null(pg$result)) {
# go read Bob Rudis' post, in particular to read about
# the extra selector for "playlist"
    dplyr::data_frame(

      date = date,
      time = xtract_nodes(pg$result, 'div[class="playlist"] *
                                            span[class="time hidden-xs"]') %>% hm(),
      datetime = update(date, hour = hour(time), minute = minute(time)),
      artist = xtract_nodes(pg$result, 'div[class="playlist"] * span[class="titletag"]'),
      title = xtract_nodes(pg$result, 'div[class="playlist"] * span[class="artist"]')

    )

  } else {
    closeAllConnections()
    NULL
  }

}

search_dates <- seq(from = ymd("2008-09-01"), to = ymd("2017-04-22"), by = "1 day")

# how you can make the progress bar work,
# estimate the time necessary for 5 requests
pb <- dplyr::progress_estimated(length(search_dates))
programs_df <- map_df(search_dates, get_one_day_program, pb=pb)
programs_df <- programs_df %>%
   dplyr::select(- time) %>%
   dplyr::mutate(datetime = force_tz(datetime, tz = "Europe/Zurich"))
programs_df

save(programs_df, file = "data/radioswissclassic_programs_radioedit.RData")

load("data/radioswissclassic_programs_radioedit.RData")
search_dates <- seq(from = lubridate::ymd("2008-09-01"), to = lubridate::ymd("2017-04-22"), by = "1 day")

library("magrittr")
programs_df <- dplyr::arrange(programs_df, datetime)
programs_df <- dplyr::mutate(programs_df,
                          duration = difftime(lead(datetime, 1),
                                       datetime,
                                       units = "min"))

programs_df <- dplyr::mutate(programs_df,
                          duration = ifelse(duration > 60,
                                            NA, duration))
programs_df <- dplyr::mutate(programs_df,
                          hour = as.factor(lubridate::hour(datetime)))

programs_df <- dplyr::mutate(programs_df,
                             night = (lubridate::hour(datetime) <= 4 | lubridate::hour(datetime) >= 20))


quantiles <- function(x){
  probs <- seq(from = 0.5, to = 0.95, by = 0.05)
  quantiles_names <- paste0("q", probs*100)
  quantiles <- purrr::map_dbl(probs, function(p, v = x){
    quantile(v, probs = p, na.rm = TRUE)
  })
  df <- tibble::as.tibble(t(quantiles))
  names(df) <- quantiles_names
  return(df)
}

programs_df %>%
  dplyr::group_by(night) %>%
  dplyr::summarize(duration_q = list(quantiles(duration))) %>%
  tidyr::unnest(duration_q) %>%
  knitr::kable()

library("ggplot2")
library("hrbrthemes")
ggplot(programs_df) +
  geom_histogram(aes(duration)) +
  facet_grid(night ~ .) +
  theme_ipsum() +
  xlab("Duration (minutes)")

library("quantreg")

model <- rq(duration ~ night, 
            tau = seq(from = 0.5, to = 0.95, by = 0.05), 
           data = programs_df,
           method = "pfn")
summaries <- summary(model, se = "ker")

transform_summary <- function(summ){
  coeffs <- tibble::as.tibble(summ$coefficients)
  coeffs <- dplyr::mutate_(coeffs, tau = ~summ$tau)
  coeffs[2,]
}

purrr::map(summaries, transform_summary) %>%
  dplyr::bind_rows() %>%
  knitr::kable()

tempos <- tolower(c("Larghissimo", "Grave", "Largo",
    "Lento", "Larghetto", "Adagio",
    "Adagietto", "Andante", "Andantino",
    "Marcia moderato", "Andante moderato",
    "Moderato", "Allegretto", "Allegro moderato",
    "Allegro", "Vivace", "Vivacissimo",
    "Allegrissimo", "Presto", "Prestissimo"))
tempos <- tibble::tibble(tempo = tempos,
                         speed = 1:length(tempos))

programs <- dplyr::mutate(programs_df,
                          title = tolower(title))

library("fuzzyjoin")
programs <- regex_inner_join(programs, tempos,
                            by = c(title = "tempo"))

set.seed(1)
nrow(programs)

programs <- split(programs, programs$datetime)

clean_tempos <- function(df){
  if(nrow(df) > 1){
    if(any(stringr::str_detect(df$tempo, " moderato"))){
      df <- dplyr::filter_(df, lazyeval::interp(~ stringr::str_detect(df$tempo, " moderato")))
    }else{
      df <- dplyr::sample_n(df, size = 1)
    }
    
  }
  return(df)
  
}

programs <- purrr::map(programs, clean_tempos)
programs <- dplyr::bind_rows(programs)
nrow(programs)

programs %>%
  dplyr::group_by(night) %>%
  dplyr::summarize(mean_speed = mean(speed),
            median_speed = median(speed)) %>%
  knitr::kable()

programs <- dplyr::mutate(programs, speed = as.factor(speed))

library("viridis")

ggplot(programs) +
  geom_bar(aes(hour, fill = speed),
           position = "fill") +
  scale_fill_viridis(discrete = TRUE) +
  theme_ipsum()

ggplot(programs) +
  geom_bar(aes(night, fill = speed),
           position = "fill") +
  scale_fill_viridis(discrete = TRUE) +
  theme_ipsum()