#Script to calculate Taxonomic Distinctness that fit in RAM

# To run: mpiexec -np 2 ../../bin/Rscript Taxa2DistMPI.r "aggGenera400.csv" "/home/patkos/R-3.1.1/Datasets" "/home/patkos/R-3.1.1/TeoScripts/outputs" TRUE TRUE TRUE "addName"

#clean previous results
rm(list=ls())

# Initial Parameters given by the user
args <- commandArgs(trailingOnly = TRUE)
datasetName <- args[1] # The name of the csv file
datasetPath <- args[2] # The directory (path) where the dataset is stored
outputPath <- args[3] # The directory (path) where we wish the output CSV to be stored
withHeader <- as.logical(args[4]) # File with header?
varstep <- as.logical(args[5]) #
check <- as.logical(args[6]) #
outputName <- args[7] # This string will be attached to the output CSV file

# Start the clock
fullProgramTimer <- proc.time()

# TP: Include library for MPI communication
library(pbdMPI, quiet = TRUE)

init()

# TP: Get the size of the cluster
processors <- comm.size()
myrank <- comm.rank()

# TP: The step will be the number of rows/columns assigned to each node
# TP: The rest are matrices that will be sent to each node
mtx.step <- NULL
agg <- NULL
add <- NULL

#load vegan library
library(vegan)

# TP: Only the master node performs these tasks
if (myrank == 0) {
# set path to files
setwd(datasetPath)

#aggs contains the aggregation file
agg<- read.table(datasetName, header = withHeader, sep=",")

# taxa2dist is the function we want to parallelize
#taxdis <- taxa2dist(agg, varstep=TRUE)
# Lets delve into its code:
#function (x, varstep = FALSE, check = TRUE, labels)
#varstep = TRUE
#check = TRUE

  rich <- apply(agg, 2, function(taxa) length(unique(taxa)))
  S <- nrow(agg)
  if (check) {
    keep <- rich < S & rich > 1
    rich <- rich[keep]
    agg <- agg[, keep]
  }
  i <- rev(order(rich))
  agg <- agg[, i]
  rich <- rich[i]
  if (varstep) {
    add <- -diff(c(nrow(agg), rich, 1))
    add <- add/c(S, rich)
    add <- add/sum(add) * 100
  }
  else {
    add <- rep(100/(ncol(agg) + check), ncol(agg) + check)
  }
  if (!is.null(names(add)))
    names(add) <- c("Base", names(add)[-length(add)])
  if (!check)
    add <- c(0, add)

   addTemp <- add
  #out <- matrix(add[1], nrow(agg), nrow(agg))

# TP: Only matrices can be sent through pbdMPI so we transform 'add' to matrix
add <- matrix(add)
mtx.step <- matrix(ceiling(nrow(agg)/processors),1,1)

}

# TP: Broadcast the two matrices and the step
agg.all <- bcast(agg, rank.source = 0)
add.all <- bcast(add, rank.source = 0)

step <- bcast(mtx.step, rank.source = 0)

# Start the clock
mainCalcTimer <- proc.time()

# TP: Now, each node has a different set of data to work with
start <- myrank*step+1
end <- start+step-1
# TP: The last node has less elements that the rest, i.e., the remaining elements
if (myrank == processors-1) {end<-nrow(agg.all)}

#comm.print(object.size(agg.all), all.rank = TRUE)
#comm.print(start, all.rank = TRUE)
#comm.print(end, all.rank = TRUE)

#out <- matrix(add.all[1], nrow(agg.all), (end-start+1))
out <- matrix(add.all[1], (end-start+1), nrow(agg.all))
#comm.print(dim(out), all.rank = TRUE)

# TP: This is the main loop that is performed on each processor separately
for (i in 1:ncol(agg.all)) {
out <- out + add.all[i + 1] * outer(agg.all[start:end, i], agg.all[, i], "!=")
}

#comm.print(out[1,1], all.rank = TRUE)

# TP: Set the diagonal as 0 (when a distance matrix is transformed into matrix, the diagonal is set to zero)
for (j in 1:nrow(out)) {
   out[j,step*myrank+j] <- 0
}

# Gather everything at processor 0
allData <- allgather(out)
outComplete <- allData[[1]]
if (processors>1) {
	for (j in 2:length(allData)) {
	outComplete <- rbind(outComplete,allData[[j]])
	}
}

setwd(outputPath)

  if (myrank == 0) {
		print(">> LW RvLAB: Saving output file localy under the name:")
		print(outputName)

		write.table(outComplete, file=paste("RvLAB_taxa2Dist",outputName,".csv",sep = ""), row.names=FALSE, col.names=FALSE, , sep=",")
  }

# Stop the clock
#comm.print("Time for each processor to perform the main calculation loop",rank.source = 0)
#comm.print(proc.time() - mainCalcTimer, all.rank=T)

# Stop the clock
comm.print(">> LW RvLAB: Full program execution time for each processor",rank.source = 0)
comm.print(proc.time() - fullProgramTimer, all.rank=T)

#comm.print("Dimension of the matrix stored in each processor",rank.source = 0)
#comm.print(dim(out),all.rank=T)

comm.print(">> LW RvLAB: Size of the matrix stored in each processor (Mb)",rank.source = 0)
comm.print(object.size(out)/1048600,all.rank=T)

if (myrank == 0) {

  outComplete <- as.dist(outComplete)
  attr(outComplete, "method") <- "taxa2dist"
  attr(outComplete, "steps") <- add
  attr(outComplete, "Labels") <- rownames(agg)
  if (!check && any(outComplete <= 0))
    warning("you used 'check=FALSE' and some distances are zero -- was this intended?")
  print(">> LW RvLAB: Size of the output dist matrix (Mb):")
  print(object.size(outComplete)/(1024^2))

  print(head(outComplete))

  # Return the object (we do not want this now)
  #outComplete

}

####### Check that the result is the same as the serial
####### Remove this code when the data is too big to fit in processor 0
#if (myrank == 0) {
#  outSerial <- matrix(addTemp[1], nrow(agg), nrow(agg))

#  for (i in 1:ncol(agg)) {
#      outSerial <- outSerial + addTemp[i + 1] * outer(agg[, i], agg[, i], "!=")
#  }

#outSerial <- as.dist(outSerial)
#outSerial <- as.matrix(outSerial)
#}

# Gather everything at processor 0
#allData <- allgather(out)
#outComplete <- allData[[1]]
#for (j in 2:length(allData)) {
#   outComplete <- rbind(outComplete,allData[[j]])
#}
##comm.print(dim(outComplete))
##comm.print(dim(outSerial))
#comm.print(object.size(outComplete))
#comm.print(object.size(outSerial))
##comm.print(outComplete[1,1])
##comm.print(outSerial[1,1])

## We need to make this cyclic transformation some info is attached when made a distance matrix
## We could compare outComplete with outSerial before becoming a dist, but the latter has a value at the diagonal that is removed when it is made a distance
#outComplete <- as.dist(outComplete)
#outComplete <- as.matrix(outComplete)
#comm.print("Are the serial and distributed matrices equal?",rank.source = 0)
#comm.print(all.equal(outComplete,outSerial))

finalize()


# https://www.r-spatial.org/r/2018/10/25/ggplot2-sf.html
# https://covidtracking.com/api/
# https://covid.ourworldindata.org
library(R0)
library(plotly)
library(rnaturalearth)
library(rnaturalearthdata)
library(rgeos)
library(data.table)
library(countrycode)
library(viridis)
library(gganimate)
library(gifski)
library(tidyverse)
library(lmtest)
library(WDI)
library(plotly)
library(USAboundaries)
library(USAboundariesData)
library(sf)
library(fuzzyjoin)
library(tigris)
library(scales)
library(ggthemes)

# library(usmap)

library(cowplot)
library(RcppRoll)
# library(sqldf)
library(albersusa)

library(RColorBrewer)
library(quantreg)
library(ggrepel)

# library(devtools)
# remotes::install_git("https://git.sr.ht/~hrbrmstr/albersusa")
# https://github.com/hrbrmstr/albersusa

# devtools::install_github("ropensci/USAboundariesData")

# display.brewer.all(n=NULL, type="all", select=NULL, exact.n=TRUE,
#                    colorblindFriendly=FALSE)

# questions to answer:
# how have case / death rates changed recently?
# how have transmission rates changes over time?
# what do we know about mortality rates?
# how many cases are missing?
# what is the geographic distribution of cases, and how does proximity affect transmission?

setwd("~/Public_Policy/Projects/COVID-19")

r0_window_size = 7
est_r0_window = function(new_cases, catch = F) {
  # https://www.ncbi.nlm.nih.gov/pmc/articles/PMC7014672/

  mGT <- generation.time("weibull", c(6.4, 2.3))
  # new_cases = a$the_cases
  if (!catch) {
    r0_est = est.R0.EG(new_cases, mGT, begin=as.integer(1), end=as.integer(length(new_cases)))$R
    return(r0_est)
  } else {
    r0_est = NA
    tryCatch({
      r0_est = est.R0.EG(new_cases, mGT, begin=as.integer(1), end=as.integer(length(new_cases)))$R
    }, error = function(e){
      return(r0_est)
    })

  }

}

### get state and US population data  ###
# fred_sqlite = dbConnect(SQLite(), dbname= "data/fred_sqlite.sqlite")
#
# state_economic_data = dbGetQuery(fred_sqlite, 'select * from state_economic_data') %>%
#   mutate(
#     date = as.Date(date, origin = '1970-01-01'),
#     title_clean = str_extract(title, '(.* in )|(.* for )') %>% str_replace('( in )|( for )', ''),
#     title_for_col = paste0("x_", str_replace_all(title_clean, '[ \\-%,]', '_'))
#   ) %>%
#   arrange(state_name, title_clean, date) %>%
#   data.table() %>%
#   # accidentally inserted duplicate records for Alabama, dedup here (need to index this db later)
#   unique(by = c('state_name', 'title_clean', 'date'))

#
# annual_population_by_state = filter(state_economic_data, title_clean == 'Resident Population') %>%
#   mutate(
#     year = year(date)
#   )
#

# population_by_state = filter(annual_population_by_state, date == max(date))
population_by_state = read_csv('data/state_pop_2018.csv', skip = 1) %>%
  rename(
    state_name = `Geographic Area Name`,
    value = `Estimate!!Total`
  )

us_population = sum(population_by_state$value)

## get shapefile data ##
us_counties_shp = us_counties()
us_states_shp = us_states()
us_map = USAboundaries::us_boundaries()
us_states_tigris = tigris::states()
us_counties_tigris = tigris::counties()

us_sf <- usa_sf("laea")
cty_sf <- counties_sf("aeqd")

state_geo_center = us_states_tigris@data %>%
  mutate(
    lat = as.numeric(INTPTLAT),
    long = as.numeric(INTPTLON)
  ) %>%
  rename(
    state_abbr = STUSPS
  )

### get lockdown dates ###

tryCatch({
  lockdown_dates = read_csv('https://covid19-lockdown-tracker.netlify.com/lockdown_dates.csv') %>%
    rename(location_name = Place, lockdown_start = `Start date`, lockdown_end = `End date`)
  if (nrow(lockdown_dates) > 0) {
    write.csv(lockdown_dates, 'data/lockdown_dates.csv', row.names = F)
  }

}, error = function(e){
  cat('error reading lockdown dates\n')
  print(e)

}, finally = {
  if (!'lockdown_dates' %in% ls()) {
    lockdown_dates = read_csv('data/lockdown_dates.csv')
  }

})

us_lockdown_dates = filter(lockdown_dates, Country == 'United States', Level == 'State') %>%
  select(-Country, -Confirmed, -Level)
names(us_lockdown_dates) = names(us_lockdown_dates) %>% str_replace_all(' ', '_')

#### load and clean state covid data ####
us_covid_data = read_csv('https://covidtracking.com/api/us/daily.csv') %>%
  mutate(
    date = as.Date(as.character(date), format = '%Y%m%d'),
    location = 'United States',
    location_type = 'country',
    data_source = 'covidtracking.com',
    location_key = paste(location, location_type, data_source, sep = '|')
  ) %>%
  arrange(date) %>%
  rename(
    total_cases = positive,
    total_deaths = death,
    total_tests = total
  ) %>%
  mutate(
    percent_positive_cases = total_cases / (total_cases + negative),
    tests_with_results = negative + total_cases,
    case_fatality_rate = total_deaths / total_cases
  )

state_name_mappings = tibble(state_name = state.name, state_abbr = state.abb)

us_states_covid_data = read_csv('http://covidtracking.com/api/states/daily.csv') %>%
  mutate(
    date = as.Date(as.character(date), format = '%Y%m%d'),
    location_type = 'US State',
    data_source = 'covidtracking.com',
    location_key = paste(state, location_type, data_source, sep = '|')
  ) %>%
  arrange(location_key, date) %>%
  rename(
    total_cases = positive,
    total_deaths = death,
    total_tests = total,
    location = state
  ) %>%
  mutate(
    percent_positive_cases = total_cases / (total_cases + negative),
    tests_with_results = negative + total_cases,
    case_fatality_rate = total_deaths / total_cases
  )

all_covid_data_stacked = bind_rows(us_covid_data, us_states_covid_data) %>%
  arrange(location_key, date) %>%
  pivot_longer(cols = c('total_cases', 'total_deaths', 'total_tests',
                        'percent_positive_cases', 'case_fatality_rate', 'tests_with_results'),
               names_to = c('measure'), values_to = 'value') %>%
  data.table()

# compute first differences, pct changes, etc. by state
all_covid_data_diffs =
  all_covid_data_stacked[, {

    lag_value = lag(value, 1)
    diff_value = value - lag_value
    pct_change_value = diff_value / lag_value

    cum_diff_value = value - lag_value
    cum_diff_value[is.na(cum_diff_value)] = value[1]

    lag_4_value = lag(value, 4)
    lag_5_value = lag(value, 5)
    lag_6_value = lag(value, 6)

    cum_lag_4_diff_value = lag(cum_diff_value, 4)
    cum_lag_5_diff_value = lag(cum_diff_value, 5)
    cum_lag_6_diff_value = lag(cum_diff_value, 6)

    value_avg_3 = c(rep(NA, 2), roll_mean(value, 3))
    diff_value_avg_3 = c(rep(NA, 2), roll_mean(diff_value, 3))

    list(
      time = as.integer(date - min(date)),
      date = date,
      value = value,
      lag_value = lag_value,
      diff_value = diff_value,
      pct_change_value = pct_change_value,
      value_avg_3 = value_avg_3,
      diff_value_avg_3 = diff_value_avg_3,
      lag_4_value = lag_4_value,
      lag_5_value = lag_5_value,
      lag_6_value = lag_6_value,
      cum_diff_value = cum_diff_value,
      cum_lag_4_diff_value = cum_lag_4_diff_value,
      cum_lag_5_diff_value = cum_lag_5_diff_value,
      cum_lag_6_diff_value = cum_lag_6_diff_value,
      first_value = date[date == min(date)],
      last_value = date[date == max(date)],
      value_past_100 = min(date[value >= 100])
    )

  }, by = list(location_key, location, location_type, data_source, measure)] %>%
  pivot_wider(
    id_cols = c('location_key', 'location', 'location_type','data_source', 'date', 'time'),
    names_from = 'measure',
    values_from = c('value', 'lag_value', 'diff_value',
                    'pct_change_value', 'lag_4_value', 'lag_5_value',
                    'lag_6_value', 'value_avg_3', 'diff_value_avg_3',
                    'cum_lag_4_diff_value', 'cum_lag_5_diff_value',
                    'cum_lag_6_diff_value', 'cum_diff_value')
  ) %>%
  left_join(
    state_name_mappings, by = c('location' = 'state_abbr')
  ) %>%
  left_join(
    select(population_by_state, state_name, state_pop = value)
  ) %>%
  left_join(
    tibble(location = 'United States', us_pop = us_population), by = 'location'
  ) %>%
  mutate(
    location_name = ifelse(is.na(state_name), location, state_name),
    population = ifelse(is.na(state_pop), us_pop, state_pop),
    pop_100k = population/100000,
    state_pop = NULL, us_pop = NULL
  )

### get timing of when the 20th case occurred ###
case_20_dates = group_by(all_covid_data_diffs, location_key) %>%
  summarize(
    date_case_20 = min(date[value_total_cases >= 20]),
    has_30_days = as.numeric(max(date[value_total_cases >= 20]) - min(date[value_total_cases >= 20]) >= 30)
  )

all_covid_data_diffs_dt = data.table(all_covid_data_diffs)

### one more set of by-state computations, to get r0 and other stats ###
effective_r0_dat = all_covid_data_diffs_dt[, {
  # ny = filter(all_covid_data_diffs_dt, location == 'NY')
  # attach(ny)
  cum_diff_value_total_cases[value_total_cases == 0] = NA

  # what is the r0 of cases on a rolling 6 day basis? This uses the last six days, computes r0, and then pushes the computations
  # forward six days to show the r0 of the cases themselves
  new_cases_zoo = zoo(cum_diff_value_total_cases, 1:length(cum_diff_value_total_cases))
  r0_rolling = rep(NA, length(new_cases_zoo)) %>% as.numeric()

  # tryCatch({
  #   r0_rolling = c(rep(NA, r0_window_size-1), rollapply(new_cases_zoo %>% na.approx(new_cases_zoo, na.rm = F), r0_window_size, est_r0_window)) %>%
  #     lead(r0_window_size) %>% as.numeric()
  # }, error = function(e){
  #   print( e)
  #
  # })
  #

  # Median is 5.1 days, mean is 6.4 days
  # https://annals.org/aim/fullarticle/2762808/incubation-period-coronavirus-disease-2019-covid-19-from-publicly-reported
  # https://www.ncbi.nlm.nih.gov/pmc/articles/PMC7014672/
  effective_r0 = cum_diff_value_total_cases / cum_lag_6_diff_value_total_cases
  #
  # # there are NAs because of the lags, there are infinite values because of missing data
  effective_r0_nas = ifelse(is.infinite(effective_r0) | effective_r0 == 0, NA, effective_r0) %>% as.numeric()
  #
  # # interpolate the cases
  effective_r0_interpolated = zoo(effective_r0_nas, 1:length(effective_r0_nas)) %>% na.approx(na.rm = F) %>% as.numeric()
  #
  # # there are data integrity issues. Limit max r0 to 20 and min to 0
  effective_r0_interpolated = pmin(effective_r0_interpolated, 20)
  effective_r0_interpolated = pmax(effective_r0_interpolated, 0)

  # this needs to be pushed back to where the cases originated
  effective_r0_interpolated_lead = lead(effective_r0_interpolated, 6)

  # get rolling average positive tests for last seven days
  percent_positive_new_tests = cum_diff_value_total_cases / cum_diff_value_tests_with_results
  rolling3_tests_with_results = c(rep(NA, 2), roll_mean(cum_diff_value_tests_with_results, 3))
  rolling7_tests_with_results = c(rep(NA, 6), roll_mean(cum_diff_value_tests_with_results, 7))
  rolling3_new_cases = c(rep(NA, 2), roll_mean(cum_diff_value_total_cases, 3))

  lag_percent_positive_new_tests = lag(percent_positive_new_tests, 1)
  delta_percent_positive_new_tests = percent_positive_new_tests - lag_percent_positive_new_tests

  rolling3_percent_positive_new_tests = c(rep(NA, 2), roll_mean(percent_positive_new_tests, 3))
  rolling7_percent_positive_new_tests = c(rep(NA, 6), roll_mean(percent_positive_new_tests, 7))
  delta_roll_3_7 = rolling3_percent_positive_new_tests - rolling7_percent_positive_new_tests

  # there is some thinking that there is a severe lag in case reporting, use a weeklong lag
  # the reason we use lead
  r0_rolling_lead_7 = lead(r0_rolling, 7)
  effective_r0_interpolated_lead_7 = lead(effective_r0_interpolated, 7)

  new_deaths_per_100k = cum_diff_value_total_deaths / pop_100k
  new_deaths_per_100k_roll7 = c(rep(NA, 6), roll_mean(new_deaths_per_100k, 7))

  list(
    date = date,
    new_deaths_per_100k = new_deaths_per_100k,
    new_deaths_per_100k_roll7 = new_deaths_per_100k_roll7,
    effective_r0_interpolated = effective_r0_interpolated_lead,
    effective_r0_interpolated_lead_7 = effective_r0_interpolated_lead_7,
    r0_rolling = r0_rolling,
    r0_rolling_lead_7 = r0_rolling_lead_7,
    percent_positive_new_tests = percent_positive_new_tests,
    lag_percent_positive_new_tests = lag_percent_positive_new_tests,
    delta_percent_positive_new_tests = delta_percent_positive_new_tests,
    rolling3_new_cases = rolling3_new_cases,
    rolling3_tests_with_results = rolling3_tests_with_results,
    rolling7_tests_with_results = rolling7_tests_with_results,
    rolling3_percent_positive_new_tests = rolling3_percent_positive_new_tests,
    rolling7_percent_positive_new_tests = rolling7_percent_positive_new_tests,
    delta_roll_3_7_percent_positive_new_tests = delta_roll_3_7
  )
}, by = list(location_key, location)]

# what is the r0 of cases on a rolling 6 day basis? This uses the last six days, computes r0, and then pushes the computations
# forward six days to show the r0 of the cases themselves

# final, clean dataset with all sorts of calculations complete #
all_covid_data_diffs_dates = left_join(all_covid_data_diffs, case_20_dates) %>%
  left_join(effective_r0_dat) %>%
  left_join(us_lockdown_dates) %>%
  mutate(
    days_since_lockdown_start = as.numeric(date - lockdown_start),
    lockdown_period = ifelse(is.na(lockdown_start), 'No Lockdown', ifelse(days_since_lockdown_start < 0, 'Pre-Lockdown', 'Post-Lockdown')) %>%
      factor() %>% relevel(ref = 'Pre-Lockdown'),
    days_since_case_20 = as.numeric(date - date_case_20),
    days_since_first_state_lockdown = as.numeric(date - min(lockdown_start, na.rm = T)),
    post_first_lockdown = days_since_first_state_lockdown >= 0,
    new_tests_per_100k = cum_diff_value_total_tests / pop_100k,
    deaths_per_100k = value_total_deaths / pop_100k,
    tests_per_100k = value_total_tests / pop_100k,
    cases_per_100k = value_total_cases / pop_100k,
    new_cases_per_100k = cum_diff_value_total_cases / pop_100k,
    diff_value_avg_3_total_tests_per_100k = diff_value_avg_3_total_tests / pop_100k,
    week_day = lubridate::wday(date),
    weekend_ind = ifelse(week_day %in% c(7, 1), 'Weekend', "Week Day"),
    cum_diff_value_total_cases_adj = pmax(cum_diff_value_total_cases, 0),
    cum_diff_value_tests_with_results_adj = pmax(cum_diff_value_total_cases_adj, cum_diff_value_tests_with_results, 0),
    cum_diff_value_tests_with_results_adj = ifelse(cum_diff_value_tests_with_results_adj == 0, NA, cum_diff_value_tests_with_results_adj)
  ) %>%
  arrange(location_key, date) %>%
  filter(
    location %in% c(state.abb, 'United States')
  )

write.csv(all_covid_data_diffs_dates, 'data/us_covid_data_by_state_with_calcs.csv', row.names = F)

all_covid_data_diffs_dates %>% filter(location_name %in% c('Florida', 'California', 'Texas', 'New York', 'Arizona',
                                                           'Michigan', 'Georgia', 'South Carolina')) %>%
ggplot(aes(date, new_deaths_per_100k_roll7)) +
  facet_wrap(~location_name, ncol = 4) +
  geom_line()

r0_stats_by_date = group_by(all_covid_data_diffs_dates, date, lockdown_period) %>%
  summarize(
    obs = n(),
    median_r0 = median(r0_rolling_lead_7, na.rm = T),
    mean_r0 = mean(r0_rolling_lead_7, na.rm = T),
    q25 = quantile(r0_rolling_lead_7, probs = 0.25, na.rm = T),
    q75 = quantile(r0_rolling_lead_7, probs = 0.75, na.rm = T)
  ) %>%
  filter(!is.na(median_r0)) %>%
  mutate(
    pct_of_states = obs/sum(obs)
  )

ggplot(r0_stats_by_date, aes(date, median_r0, colour = lockdown_period)) +
  geom_hline(aes(yintercept = 1), colour = 'firebrick', size = 0.75, linetype = 'dashed') +
  # geom_ribbon(aes(ymin = q25, ymax = q75, fill = lockdown_period), alpha = 0.3) +
  # facet_wrap(~lockdown_period, ncol = 1) +
  theme_bw() +
  geom_line(size = 0.75) +

  # geom_point(aes(size = pct_of_states)) +
  labs(
    x = '', y = 'Median Rolling 7-Day R0',
    caption = 'Chart: Taylor G. White\nData: covidtracking.com',
    title = 'COVID-19 Rolling 7-Day Reproduction Number (R0) by Lockdown Status',
    subtitle = sprintf('U.S. states, through %s. Data is lagged by one week for case delay and one week to observe follow-on cases for R0 computation. R0 < 1 means the rate of new cases is decreasing.',
                       max(all_covid_data_diffs_dates$date) %>% format('%B %d')
    ) %>% str_wrap(115)
  ) +
  theme(
    panel.grid.minor = element_blank(),
    legend.text = element_text(size = 12),
    title = element_text(size = 14),
    plot.subtitle = element_text(size = 11, face = 'italic'),
    plot.caption = element_text(size = 10, face = 'italic', hjust = 0),
    legend.position = 'right'
  ) +
  scale_size(name = '% of States', range = c(1, 4), labels = percent) +
  scale_colour_hue(name = 'Period') +
  scale_y_continuous(breaks = seq(0, 15, by = 1))

ggsave('output/rolling_ro_trend_by_lockdown_status.png', height = 8, width = 10, units = 'in', dpi = 800)

latest_state_data = filter(all_covid_data_diffs_dates, location != 'United States', date == max(date)) %>%
  arrange(-value_total_cases) %>%
  mutate(
    location_factor = factor(location, levels = location)
  )

all_covid_data_diffs_dates$location_factor = factor(all_covid_data_diffs_dates$location,
                                                    levels = latest_state_data$location)

filter(all_covid_data_diffs_dates,
       location %in% head(latest_state_data, 50)$location, date >= as.Date('2020-03-11')) %>%
  ggplot() +
  facet_wrap(~location_factor, scales = 'free_y', ncol = 5) +
  geom_area(aes(date, rolling7_tests_with_results/pop_100k), fill = 'black', alpha = .4) +
  # geom_area(aes(date, rolling7_percent_positive_new_tests), fill = 'black', alpha = .4) +
  geom_line(aes(date, rolling3_new_cases/pop_100k), colour = 'blue', size = 0.75) +
  # geom_point(aes(date, rolling3_percent_positive_new_tests), colour = 'blue') +
  # geom_point(aes(date, rolling3_percent_positive_new_tests, size = new_cases_per_100k), colour = 'red') +
  theme_bw() +
  theme(strip.background = element_blank(), panel.grid = element_blank()) +
  scale_size(range = c(1, 5)) +
  scale_x_date(date_breaks = '7 days', date_labels = '%b %d') +
  scale_y_continuous(labels = comma) +
  labs(
    y = '3 Day Average of New Cases Per 100k', x = '',
    title = 'Daily Average Testing Per Week Versus Positive Test Results, Per 100k Population'
  )
ggsave('output/three_vs_seven_day_avg_positive_tests.png', height = 16, width = 18, units = 'in', dpi = 800)

latest_state_data = filter(all_covid_data_diffs_dates, location != 'United States', date == max(date)) %>%
  arrange(-value_total_cases) %>%
  mutate(
    location_factor = factor(location, levels = location)
  )

all_covid_data_diffs_dates$location_factor = factor(all_covid_data_diffs_dates$location,
                                                    levels = latest_state_data$location)

filter(all_covid_data_diffs_dates,
       days_since_case_20 > 14,
       location %in% head(latest_state_data, 50)$location, date >= as.Date('2020-03-11')) %>%
  ggplot() +
  facet_wrap(~location_factor, scales = 'free_y', ncol = 5) +
  # geom_area(aes(date, rolling7_percent_positive_new_tests), fill = 'black', alpha = .4) +
  geom_line(aes(date, rolling3_new_cases/rolling7_tests_with_results), colour = 'blue', size = 0.75) +
  # geom_point(aes(date, rolling3_percent_positive_new_tests), colour = 'blue') +
  # geom_point(aes(date, rolling3_percent_positive_new_tests, size = new_cases_per_100k), colour = 'red') +
  theme_bw() +
  theme(strip.background = element_blank(), panel.grid = element_blank()) +
  scale_size(range = c(1, 5)) +
  scale_x_date(date_breaks = '14 days', date_labels = '%b %d') +
  geom_hline(aes(yintercept = 0)) +
  scale_y_continuous(labels = percent) +
  labs(
    y = '3 Day Avg. of New Cases / 7-Day Avg. Testing', x = '',
    title = 'U.S. COVID-19 Positive Test Rate, by State'
  )
ggsave('output/positive_test_rate_by_state.png', height = 16, width = 20, units = 'in', dpi = 600)

## compute stats by lockdown period
state_lockdown_period_calcs = group_by(all_covid_data_diffs_dates, location, lockdown_period) %>%
  summarize(
    period_start = min(date[value_total_cases > 0]),
    period_end = max(date[value_total_cases > 0]),
    period_length = as.numeric(period_end - period_start),
    starting_cases = min(value_total_cases[value_total_cases > 0]),
    ending_cases = max(value_total_cases[value_total_cases > 0]),
    period_r0 = est_r0_window(cum_diff_value_total_cases, catch = T),
    period_daily_geometric_growth = (ending_cases / starting_cases)^(1/length(value_total_cases[value_total_cases > 0])) - 1
  ) %>%
  filter(location != 'United States', !is.na(lockdown_period), !is.na(ending_cases), location %in% state.abb)

# push wide
wide_state_lockdown_period_calcs = pivot_wider(state_lockdown_period_calcs,
                                               id_cols = c('location'),
                                               names_from = lockdown_period,
                                               values_from = c('period_r0', 'period_end','period_daily_geometric_growth', 'starting_cases', 'ending_cases'))
names(wide_state_lockdown_period_calcs) = str_replace_all(names(wide_state_lockdown_period_calcs), '[ \\-]', '_')

#### compute stats by lockdown status #####

lockdown_period_stats = group_by(all_covid_data_diffs_dates, lockdown_period) %>%
  summarize(
    obs = length(r0_rolling_lead_7[!is.na(r0_rolling_lead_7)]),
    median_r0_rolling_7 = median(r0_rolling_lead_7, na.rm = T),
    mean_r0_rolling_7 = mean(r0_rolling_lead_7, na.rm = T)
  )

lockdown_period_stats_days = group_by(all_covid_data_diffs_dates, days_since_lockdown_start, lockdown_period) %>%
  summarize(
    obs = length(r0_rolling_lead_7[!is.na(r0_rolling_lead_7)]),
    median_r0_rolling_7 = median(r0_rolling_lead_7, na.rm = T),
    q25 = quantile(r0_rolling_lead_7, probs = 0.25, na.rm = T),
    q75 = quantile(r0_rolling_lead_7, probs = 0.75, na.rm = T),
    q10 = quantile(r0_rolling_lead_7, probs = 0.10, na.rm = T),
    q90 = quantile(r0_rolling_lead_7, probs = 0.90, na.rm = T)
  ) %>%
  filter(obs > 0)

pal_3 = brewer.pal(3, 'Set1')
r0_boxplot =
  all_covid_data_diffs_dates %>% filter(lockdown_period != 'No Lockdown') %>%
  ggplot(aes(lockdown_period, r0_rolling_lead_7, fill = lockdown_period)) +
  theme_minimal() +
  geom_boxplot(colour = 'gray', size =  0.25) +
  # geom_text(data = lockdown_period_stats, aes(y = median_r0_rolling_7, label = paste('Median:', round(median_r0_rolling_7, 2))), fontface = 'bold', size = 2.5)  +
  labs(
    x = '', y = 'Rolling 7-Day R0'
    # ,title = 'COVID-19 Rolling 7-Day R0 by Lockdown Status',
    # subtitle = sprintf('U.S. states, through %s', max(all_covid_data_diffs_dates$date) %>% format('%B %d'))
    # caption = 'Chart: Taylor G. White\nData: covidtracking.com'
  ) +
  scale_y_continuous(limits = c(0, 15)) +
  theme(
    plot.margin = margin(0.25, 0.25, 0.25, 0.25, "cm"),
    text = element_text(colour = 'white'),
    title = element_text(colour = 'white'),
    axis.text = element_text(colour = 'white'),
    plot.caption = element_text(hjust = 0, face = 'italic', size = 10),
    plot.subtitle = element_text(face = 'italic', size = 11),
    plot.background = element_rect(fill = 'black'),
    panel.background = element_rect(fill = 'black'),
    panel.grid = element_line(size = 0.25, colour = 'white')
  ) +
  scale_fill_manual(guide = F, values = c('Pre-Lockdown' = pal_3[1], 'Post-Lockdown' = pal_3[2], 'No Lockdown' = pal_3[3]))

lockdown_states = lockdown_period_stats_days %>%
  filter(lockdown_period != 'No Lockdown')

lockdown_effects_wide = pivot_wider(lockdown_period_stats %>% select(lockdown_period, median_r0_rolling_7), names_from =  c('lockdown_period'), values_from = c('median_r0_rolling_7'))

lockdown_effect = 1 - lockdown_effects_wide$`Post-Lockdown`/lockdown_effects_wide$`Pre-Lockdown`

ggplot(lockdown_states, aes(days_since_lockdown_start, median_r0_rolling_7, fill = lockdown_period)) +
  # theme_classic() +
  theme_bw() +
  # geom_ribbon(aes(ymin = q10, ymax = q90), alpha = 0.3, size = 0) +
  geom_ribbon(aes(ymin = q25, ymax = q75), alpha = 0.3, size = 0) +
  geom_line(aes(colour = NULL, fill = NULL), colour = 'gray') +
  geom_line(aes(colour = lockdown_period)) +
  geom_point(aes(size = obs, colour = lockdown_period))  +
  labs(
    x = 'Days Pre/Post Lockdown', y = 'Rolling 7-Day R0',
    caption = 'Chart: Taylor G. White\nData: covidtracking.com',
    title = 'COVID-19 Rolling 7-Day Reproduction Number (R0) by Lockdown Status',
    subtitle = sprintf('U.S. states, through %s. State lockdowns are associated with a %s decrease in COVID-19 transmission (median R0 of %s down to %s), though many areas experienced decreased transmission pre-lockdown because other states shut down. Lines show median R0 and ribbons represent the 25th and 75th percentiles.',
                       max(all_covid_data_diffs_dates$date) %>% format('%B %d'),
                       percent(lockdown_effect, accuracy = 1),
                       round(lockdown_effects_wide$`Pre-Lockdown`, 2),
                       round(lockdown_effects_wide$`Post-Lockdown`, 2)
                       ) %>% str_wrap(115)
  ) +
  theme(
    panel.grid.minor = element_blank(),
    legend.text = element_text(size = 12),
    title = element_text(size = 14),
    plot.subtitle = element_text(size = 11, face = 'italic'),
    plot.caption = element_text(size = 10, face = 'italic', hjust = 0),
    legend.position = 'bottom'
  ) +
  scale_colour_manual(name = '', values = c('Pre-Lockdown' = pal_3[1], 'Post-Lockdown' = pal_3[2], 'No Lockdown' = pal_3[3])) +
  scale_fill_manual(name = '', values = c('Pre-Lockdown' = pal_3[1], 'Post-Lockdown' = pal_3[2], 'No Lockdown' = pal_3[3])) +
  scale_size(name = '# of States', range = c(0.5, 3)) +
  scale_y_continuous(breaks = seq(0, 20, by = 1)) +
  scale_x_continuous(limits = c(-30, max(lockdown_states$days_since_lockdown_start, na.rm = T)),
                     breaks = seq(-30, max(lockdown_states$days_since_lockdown_start, na.rm = T), by = 2)) +
  annotation_custom(ggplotGrob(r0_boxplot), xmin = -10, xmax = 18, ymin = 8, ymax = 17)

ggsave('output/rolling_r0_by_lockdown_period.png', height = 7, width = 9, units = 'in', dpi = 800)

#### plot across date scale ####

post_ending_cases = filter(state_lockdown_period_calcs, lockdown_period != 'Pre-Lockdown') %>%
  arrange(-ending_cases)

state_lockdown_period_calcs = state_lockdown_period_calcs %>%
  mutate(
    location_factor = factor(location, levels = rev(post_ending_cases$location))
  )

##### show relationship between geometric daily growth vs R0 ####
ggplot(state_lockdown_period_calcs, aes(period_daily_geometric_growth, period_r0)) +
  # geom_path(colour = 'white') +
  # theme_dark() +
  geom_point(aes(colour = lockdown_period, size = ending_cases, alpha = period_length)) +
  # theme_classic() +
  theme_bw() +
  theme(
    # plot.background = element_rect(fill= 'black'),
    # panel.background = element_rect(fill = 'black'),
    # panel.grid = element_line(colour = 'white')
    # panel.border = element_rect(colour='white')
    # axis.line = element_line(colour = 'white')
  ) +
  scale_y_continuous(breaks = seq(0, 13, by = 1)) +
  scale_alpha(guide = F) +
  scale_x_continuous(labels = percent, breaks = seq(0, 0.6, by = 0.1), limits = c(0, 0.6)) +
  labs(
    x = '\nDaily Average Growth', y = 'Reproduction Number (R0)\n',
    title = 'COVID-19 Daily Average Case Growth and R0, Pre vs. Post Lockdown',
    subtitle = sprintf('U.S. States, through %s', max(state_lockdown_period_calcs$period_end) %>% format('%B %d'))
  ) +
  scale_colour_hue(name = 'Period') +
  scale_size(name = 'Ending Cases', labels = comma)

ggsave('output/daily_average_case_growth_versus_r0.png', height = 6, width = 8, units = 'in', dpi = 800)

##### plot effective r0 versus lockdown dates #####
#
# selected_locations = c(
#   head(latest_state_data, 10)$location
# )
#
# # location_levels = filter(latest_stat  e_data_sub, location %in% selected_locations) %>% pull(location_name)
# location_sub = filter(all_covid_data_diffs_dates, location %in% selected_locations) %>%
#   mutate(
#     location_name = factor(location_name, levels = location_levels)
#   )
#
# selected_early_states = filter(all_covid_data_diffs_dates, location %in% c('CA', 'NY', 'WA'))
#
#
#
# all_covid_data_diffs_dates %>% filter(location %in% c('NY', 'CA', 'WA'), !is.na(r0_rolling), days_since_case_20 >= 5) %>%
#   ggplot(aes(date, r0_rolling)) +
#   geom_hline(aes(yintercept = 0)) +
#   geom_hline(aes(yintercept = 1), colour = 'red') +
#   geom_hline(aes(yintercept = 2.28), linetype = 'dashed') +
#   facet_wrap(~location_name) +
#   scale_size(range = c(0.5, 4)) +
#   # scale_alpha(range = c(0.5, 1)) +
#   geom_line(colour = 'blue') +
#   geom_point(aes(size = cum_diff_value_total_cases,  colour = weekend_ind)) +
#
#   labs(y = 'Seven-Day R0 of New Cases', x = '') +
#   # stat_smooth(method = 'gam') +
#   geom_vline(data = latest_state_data %>% filter(location %in% c('NY', 'CA', 'WA')), aes(xintercept = lockdown_start))
# ggsave('output/rolling_ro_by_early_states.png', height = 4, width = 9, units = 'in', dpi = 800)
#
#
#
#
#
# main_plot =
# filter(location_sub, days_since_case_20 >= 5) %>%
#   ggplot() +
#   geom_hline(aes(yintercept = 0)) +
#   geom_hline(aes(yintercept = 1), colour = 'red') +
#   geom_hline(aes(yintercept = 2.28), linetype = 'dashed') +
#   geom_vline(data = us_lockdown_dates %>% filter(location_name %in% unique(location_sub$location_name)), aes(xintercept = lockdown_start)) +
#   geom_point(aes(date, effective_r0_interpolated, colour = weekend_ind)) +
#   stat_smooth(aes(date, effective_r0_interpolated), se = F, method = 'gam') +
#   scale_colour_manual(name = '', values = c('Week Day' = 'steelblue', 'Weekend' = 'orange')) +
#   theme_bw() +
#   theme(
#     title = element_text(size = 14),
#     axis.title = element_text(size = 14),
#     legend.text = element_text(size = 12),
#     plot.caption = element_text(size = 10, hjust = 0, face = 'italic'),
#     plot.subtitle = element_text(size = 11, face = 'italic'),
#     axis.text.x = element_text(angle = 45),
#     plot.margin = unit(c(0.25, 0.5, 0.25, 0.25), 'in'),
#     legend.position = 'bottom',
#     strip.text = element_text(face = 'bold')
#   ) +
#   labs(
#     x = NULL, y = 'Daily Effective COVID-19 Reproduction Number (r0)\n(New Cases / New Cases Generated 5 Days Later)\n',
#     title = 'Lockdown Effects: COVID-19 Daily Effective R0 by State',
#     subtitle = sprintf('Top 12 U.S. states by cases, through %s. Vertical lines show state lockdown dates. Dashed line shows average COVID-19 r0 and red line shows r0=1, below which is decreasing case growth.\nNote that each state has its own scale.', max(location_sub$date) %>% format('%B %d')),
#     caption = 'Chart: Taylor G. White\nData: covidtracking.com, auravision.ai, CNN'
#   )
#
# free_plot = main_plot +
#   facet_wrap(~factor(location_name, levels = location_levels), ncol = 4, scales = 'free_y')
# # ggsave('output/effective_r0_top_12_states_free.png', height= 11, width = 14.5, units = 'in', dpi = 800, plot = free_plot)
#
# same_scale_plot = main_plot +
#   facet_wrap(~factor(location_name, levels = location_levels), ncol = 4)
# # ggsave('output/effective_r0_top_12_states.png', height= 11, width = 14.5, units = 'in', dpi = 800, plot = same_scale_plot)
#
# # select(all_covid_data_diffs_dates, has_30_days, date, location_name, diff_value_total_tests, value_total_tests, new_tests_per_100k) %>% View()
#
# ##### plot new cases per 100k vs percent positive new cases #####

all_covid_data_diffs_dates %>%
  filter(days_since_case_20 >= 0, location %in% c('NY', 'LA', 'CA', 'MI')) %>%
  ggplot(aes(days_since_case_20, new_cases_per_100k)) +
  geom_point(aes(alpha = days_since_case_20, colour = location, size = new_tests_per_100k))
# coord_cartesian(xlim = c(0, 1))

##### plot tests per 100k #####
all_covid_data_diffs_dates$new_tests_per_100k
all_covid_data_diffs_dates %>%
  filter(days_since_case_20 >= 0, location == 'United States') %>%
  ggplot(aes(date, new_tests_per_100k)) +
  theme_bw() +
  geom_bar(stat = 'identity') +
  geom_line(aes(y = rolling7_tests_with_results/pop_100k), colour = 'red', size = 1) +
  labs(
    x = 'Date',
    y = 'Daily Tests Per 100k Population',
    title = 'COVID-19 Tests Per 100k Population',
    subtitle = sprintf('United States, through %s. Red line is the rolling 7-day average.', max(all_covid_data_diffs_dates$date) %>% format('%B %d')),
    caption = 'Chart: Taylor G. White\nData: covidtracking.com'
  ) +
  # geom_hline(aes(yintercept = 152)) +
  scale_y_continuous(breaks = seq(0, max(all_covid_data_diffs_dates$new_tests_per_100k, na.rm = T)+5, by = 10)) +
  scale_x_date(date_breaks = '7 days', date_labels = '%b %d') +
  theme(
    title = element_text(size = 16),
    plot.subtitle = element_text(size = 11),
    plot.caption = element_text(hjust = 0, face = 'italic', size = 10)
  )
ggsave('output/us_daily_covid_tests_per_day.png', height = 6, width = 8, units = 'in', dpi = 800)

##### plot states with earliest infections #####

all_covid_data_diffs_dates %>%
  filter(days_since_case_20 >= 0, has_30_days, location != 'United States') %>%
  ggplot(aes(days_since_case_20, cases_per_100k, colour = location_name)) +
  theme_bw() +
  geom_line(data = filter(all_covid_data_diffs_dates, days_since_case_20 >= 0, !has_30_days), aes(group = location_name), colour = 'black', alpha = 0.5) +
  geom_line(size = 1) +
  geom_point() +
  labs(
    x = '\nDays Since Case 20',
    y = 'Cases Per 100k Population\n',
    title = 'COVID-19 Cases Per 100k Population',
    subtitle = sprintf('Selected U.S. states, through %s.', max(all_covid_data_diffs_dates$date) %>% format('%B %d')),
    caption = 'Chart: Taylor G. White\nData: covidtracking.com'
  ) +
  scale_y_continuous(breaks = seq(0, 6000, by = 1000), labels = comma) +
  scale_x_continuous(breaks = seq(0, 30, by = 5)) +
  theme(
    title = element_text(size = 16),
    plot.subtitle = element_text(size = 11),
    plot.caption = element_text(hjust = 0, face = 'italic', size = 10)
  ) +
  scale_colour_hue(name = '')
ggsave('output/cases_per_100k_early_states.png', height = 6, width = 8, units = 'in', dpi = 800)

# check to make sure the population data looks good
select(all_covid_data_diffs_dates, location, population) %>%
  data.table() %>%
  unique(by = 'location')

#### plot daily deaths (smoothed) by state ####
ggplot(all_covid_data_diffs_dates, aes(date, new_deaths_per_100k)) +
  facet_wrap(~location_factor, scales = 'free_y') +
  stat_smooth(span = 0.3, se = F) +
  theme_minimal() +
  labs(
    y = 'New Deaths per 100k Population',
    x = '',
    title = 'New Deaths per 100k Population by U.S. State',
    subtitle = sprintf('Data through %s', max(all_covid_data_diffs_dates$date) %>% format('%b %d'))
  )
ggsave('output/daily_deaths_per_100k_by_state.png', height = 10, width = 14, units = 'in', dpi= 600)

##### create map for all 50 states #####
US_state_data = left_join(us_sf, latest_state_data, by = c('iso_3166_2' = 'location')) %>% left_join(state_geo_center, by = c('iso_3166_2' = 'state_abbr'))

ggplot() +
  geom_sf(data = US_state_data, aes(fill = log(cases_per_100k)), alpha = 0.75, size = 0.25) +
  scale_fill_viridis(guide = F, option = 'C') +
  geom_sf_text(data = US_state_data, aes(long, lat, label = comma(cases_per_100k, accuracy = 1)),
               colour = 'black', fontface='bold', size = 2) +
  theme_map() +
  labs(x = '', y = '',
       caption = 'Chart: Taylor G. White\nData: covidtracking.com',
       title = 'U.S. COVID-19 Cases by State, Per 100k Population', subtitle = sprintf('As of %s',
                                                                                unique(format(latest_state_data$date, '%B %d')))) +
  theme(
    axis.ticks = element_blank(),
    axis.text = element_blank(),
    title = element_text(size = 16),
    plot.subtitle = element_text(size = 11),
    plot.caption = element_text(hjust = 0, face = 'italic', size = 10)
  )

ggsave('output/latest_cv_state_map_50.png', height = 6, width = 8, units = 'in', dpi = 800)
#### deaths by state #####

ggplot() +
  geom_sf(data = US_state_data, aes(fill = log(deaths_per_100k)), alpha = 1, size = 0.25) +
  scale_fill_viridis(guide = F, option = 'A') +
  geom_sf_text(data = US_state_data, aes(long, lat, label = comma(deaths_per_100k, accuracy = 1)),
               colour = 'black', fontface='bold', size = 2) +
  theme_map() +
  labs(x = '', y = '',
       caption = 'Chart: Taylor G. White\nData: covidtracking.com',
       title = 'U.S. COVID-19 Deaths by State, Per 100k Population', subtitle = sprintf('As of %s',
                                                                                unique(format(latest_state_data$date, '%B %d')))) +
  theme(
    axis.ticks = element_blank(),
    axis.text = element_blank(),
    title = element_text(size = 16),
    plot.subtitle = element_text(size = 11),
    plot.caption = element_text(hjust = 0, face = 'italic', size = 10)
  )
ggsave('output/deaths_per_100k_by_state.png', height = 6, width = 8, units = 'in', dpi = 800)

#### map of new deaths by state #####

# ggplot() +
#   geom_sf(data = US_state_data, aes(fill = log(new_cases_per_100k)), alpha = 1, size = 0.25) +
#   scale_fill_viridis(guide = F, option = 'A') +
#   geom_sf_text(data = US_state_data, aes(long, lat, label = comma(new_cases_per_100k, accuracy = 1)),
#                colour = 'black', fontface='bold', size = 2) +
#   theme_map() +
#   labs(x = '', y = '',
#        caption = 'Chart: Taylor G. White\nData: covidtracking.com',
#        title = 'New U.S. COVID-19 Cases by State, Per 100k Population', subtitle = sprintf('As of %s',
#                                                                                unique(format(latest_state_data$date, '%B %d')))) +
#   theme(
#     axis.ticks = element_blank(),
#     axis.text = element_blank(),
#     title = element_text(size = 16),
#     plot.subtitle = element_text(size = 11),
#     plot.caption = element_text(hjust = 0, face = 'italic', size = 10)
#   )

# world <- ne_countries(scale = "medium", returnclass = "sf")
# usa <- subset(world, admin == "United States of America")

##### take a look at testing data, normed by population information #####

#### plot overall cfr and positive tests ####

ggplot(latest_state_data, aes(value_percent_positive_cases, value_case_fatality_rate, size = cases_per_100k)) +
  theme_bw() +
  geom_text(aes(label = location), show.legend = F) +
  scale_alpha(range = c(0.2, 1)) +
  scale_size(guide = F, range = c(2, 6)) +
  geom_hline(aes(yintercept = 0.01)) +
  scale_y_continuous(breaks = seq(0, 0.1, by = 0.01), labels = percent) +
  scale_x_continuous(labels = percent, breaks = seq(0, 0.5, by = 0.05)) +
  labs(
    x = 'Percent Positive Tests', y = 'Case Fatality Rate',
    title = 'COVID-19 Case Fatality Rates vs. Percent Positive Tests',
    subtitle = sprintf('U.S. states, through %s. Latest data shown for each state.', max(all_covid_data_diffs_dates$date) %>% format('%B %d')),
    caption = 'Chart: Taylor G. White\nData: covidtracking.com, FRED'
  ) +
  theme(
    title = element_text(size = 14),
    axis.title = element_text(size = 14),
    legend.text = element_text(size = 12),
    plot.caption = element_text(size = 10, hjust = 0, face = 'italic'),
    plot.subtitle = element_text(size = 11, face = 'italic')
  ) +
  # stat_smooth(method = 'lm', formula = y ~ poly(x, 4), show.legend = F, se = F) +
  stat_smooth(method = 'gam', se=F)
ggsave('output/all_states_positive_cases_vs_case_fatality_rate.png', height = 6, width = 8, units = 'in', dpi = 800)

#### plot paths of selected states' CFR versus positive tests ####

#
# cfr_path_dat = filter(all_covid_data_diffs_dates, location %in%  selected_locations, days_since_case_20 >= 15)
# last_cfr_path_dat = filter(cfr_path_dat, date == max(date))
#
# cfr_path_plot = cfr_path_dat %>%
#   ggplot(aes(value_percent_positive_cases, value_case_fatality_rate, colour = location_factor)) +
#   scale_size(guide = F, range = c(0, 3)) +
#   scale_alpha(guide = F, range = c(0.3, 0.8)) +
#   geom_point(aes(alpha = days_since_case_20, size = log(value_total_cases))) +
#   geom_path(aes(alpha = days_since_case_20), size = 0.75) +
#   geom_text_repel(data = last_cfr_path_dat, aes(label = location_factor)) +
#   scale_y_continuous(breaks = seq(0, 0.1, by = 0.01), labels = percent) +
#   scale_x_continuous(labels = percent, breaks = seq(0, 0.7, by = 0.1)) +
#   theme(
#     strip.background = element_rect(fill = 'darkgray'),
#     strip.text = element_text(face = 'bold'),
#     text = element_text(colour = 'white'),
#     axis.text = element_text(colour = 'white'),
#     title = element_text(size = 16, colour = 'white'),
#     axis.title = element_text(size = 14),
#     legend.text = element_text(size = 12),
#
#     legend.title = element_text(size = 14),
#     plot.caption = element_text(size = 10, hjust = 0, face = 'italic'),
#     plot.subtitle = element_text(size = 11, face = 'italic'),
#     plot.background = element_rect(fill = 'black'),
#     legend.background = element_rect(fill = 'black'),
#     panel.background = element_rect(fill = 'black'),
#     panel.grid.minor  = element_blank(),
#     panel.grid.major = element_line(size = 0.25),
#     legend.position = 'bottom'
#   ) +
#   guides(colour = guide_legend(override.aes = list(size = 2))) +
#   scale_colour_hue(name = '') +
#   labs(
#     x = '\nPercent Positive Tests', y = 'Case Fatality Rate\n',
#     title = 'Paths of Case Fatality Rates and Positive Test Rates',
#     subtitle = sprintf('U.S. and selected states, through %s. Data shown from 15 days following 20th case.', max(all_covid_data_diffs_dates$date) %>% format('%B %d')),
#     caption = 'Chart: Taylor G. White\nData: covidtracking.com'
#   )
# ggsave('output/positive_cases_vs_case_fatality_rate.png', height = 8, width = 10, units = 'in', dpi = 800, plot = cfr_path_plot)

dark_theme = theme(
  strip.background = element_rect(fill = 'darkgray'),
  strip.text = element_text(face = 'bold'),
  text = element_text(colour = 'white'),
  axis.text = element_text(colour = 'white'),
  title = element_text(size = 16, colour = 'white'),
  axis.title = element_text(size = 14),
  legend.text = element_text(size = 12),
  plot.caption = element_text(size = 10, hjust = 0, face = 'italic'),
  legend.title = element_text(size = 14),
  plot.subtitle = element_text(size = 11, face = 'italic'),
  plot.background = element_rect(fill = 'black'),
  legend.background = element_rect(fill = 'black'),
  panel.background = element_rect(fill = 'black'),
  panel.grid.minor  = element_blank(),
  panel.grid.major = element_line(size = 0.25),
  panel.grid.major.x = element_blank(),
  legend.position = 'bottom',
  axis.ticks = element_line(colour = 'white')
)

case_fatality_lines_by_state = filter(all_covid_data_diffs_dates, days_since_case_20 >= 0, location_type == 'US State') %>%
  ggplot( aes(days_since_case_20, value_case_fatality_rate)) +
  theme_bw() +
  geom_hline(aes(yintercept = 0.01), colour = '#1b9e77', size = 0.75, linetype='dashed') +
  geom_line(aes(group = location, alpha = days_since_case_20),  colour = 'white') +
  scale_alpha(guide = F, range = c(0.15, 0.5)) +
  scale_y_continuous(labels = percent, breaks = seq(0, 0.17, by = 0.02), limits = c(0, 0.17)) +
  scale_x_continuous(breaks = seq(5, 30, by = 5), limits = c(5, max(all_covid_data_diffs_dates$days_since_case_20))) +
  geom_line(data = filter(all_covid_data_diffs_dates, days_since_case_20 >= 0, location_type != 'US State'),  aes(colour = location), size = 1) +
  geom_point(data = filter(all_covid_data_diffs_dates, days_since_case_20 >= 0, location_type != 'US State'), aes(colour = location), size = 1) +
  labs(
    x = 'Days Since Case 20', y = 'Case Fatality Rate',
    title = 'COVID-19 Case Fatality Rates Over Time',
    subtitle = sprintf('By U.S. state, through %s', max(all_covid_data_diffs_dates$date) %>% format('%B %d')),
    caption = 'Chart: Taylor G. White\nData: covidtracking.com'
  ) +
  # theme(
  #   title = element_text(size = 16),
  #   axis.title = element_text(size = 14),
  #   legend.text = element_text(size = 12),
  #   plot.caption = element_text(size = 10, hjust = 0),
  #   legend.title = element_text(size = 14),
  #   plot.subtitle = element_text(size = 11, face = 'italic'),
  #   legend.position = 'bottom'
  # ) +
  dark_theme +
  scale_colour_manual(name = '', labels = c('United States' = 'U.S. Overall'), values = c('#d95f02'))
# ggsave('output/case_fatality_rate_by_state.png', height = 7, width = 7, units = 'in', dpi = 800, plot = case_fatality_lines_by_state)

#### estimate effects of reduced transmission on case load ####

# ny_data = all_covid_data_diffs_dates %>% filter(location %in% c('CA'))

# https://stats.stackexchange.com/questions/160552/why-is-nls-giving-me-singular-gradient-matrix-at-initial-parameter-estimates
# https://www.ncbi.nlm.nih.gov/pmc/articles/PMC6962332/
# https://www.medrxiv.org/content/10.1101/2020.04.02.20051466v1.full.pdf
# get_r0_nls = function(df) {
#   model.0 = lm(log(value_total_cases) ~ I(time/6.4), data = df)
#   simple_exponential_model = nls(value_total_cases ~  case_networks * r0^(time/6.4), data = df,
#                                  start = list(case_networks = exp(coef(model.0)[1]), r0 = coef(model.0)[2]))
#   return(simple_exponential_model)
# }
#
# pre_lockdown = get_r0_nls(ny_data)
# # summary(pre_lockdown)
# # est_r0_window(ny_data$cum_diff_value_total_cases)
#
# ny_data$pred = predict(pre_lockdown)
# ggplot(ny_data, aes(time)) +
#   geom_line(aes(y=pred)) +
#   geom_line(aes(y = value_total_cases), colour = 'red')
#

# Solve and plot.

# pars vector with 2 values: the transmission and recovery rates. The names of these
# values must be "beta", and "gamma", respectively.
# init vector with 3 values: the initial proportion of susceptibles, infectious and recovered. The names of these values must be "S", "I" and "R", respectively.
# time time sequence for which output is wanted; the first value of times must be the
# initial time.
# ... further arguments passed to ode function.

##### load and clean county covid data #####

# https://transportgeography.org/?page_id=8565
# https://en.wikipedia.org/wiki/Gravity_model_of_trade
# use county by county commute flows as distance estimate or input to gravitational model
# what proportion of the combined counties' population flows between the two counties?
# what proportion of the combined counties' commuters flows between the two counties?
# flights between cities
# https://www.researchgate.net/profile/N_Pavlis/publication/226883469_A_Preliminary_Gravitational_Model_to_Degree_2160/links/53ff0a6c0cf283c3583c3ff9.pdf

nyt_county_data = read_csv('https://raw.githubusercontent.com/nytimes/covid-19-data/master/us-counties.csv') %>%
  arrange(county, state, fips, date)

latest_county_data = group_by(nyt_county_data, county, state, fips) %>%
  summarize(
    latest_date = max(date),
    latest_cases = tail(cases, 1),
    latest_deaths = tail(deaths, 1)
  )

all_county_data_geo = left_join(us_counties_tigris@data, nyt_county_data, by = c('GEOID' = 'fips')) %>%
  mutate(
    lat = as.numeric(INTPTLAT),
    long = as.numeric(INTPTLON)
  )

latest_county_data_geo = left_join(us_counties_tigris@data, latest_county_data, by = c('GEOID' = 'fips')) %>%
  mutate(
    lat = as.numeric(INTPTLAT),
    long = as.numeric(INTPTLON)
  )


###################### BEGIN R STUFF ##########################
library(reshape2)
library(data.table)
library(ggplot2)
library(scales)
library(grid)
library(plyr)
###################### END R STUFF ##########################

#########################
## Parameters that can be modified for the plot.
#########################

## We plot between n_kp_min and n_kp
n_kp_min =1
n_kp =15

n_expes = 10 #number of expes

img="evol_k'.pdf" #location where image is saved

#########################
## Plotting impact of k'
#########################

#N_XX is for XX normalized with respect to the best one attainable (when K' is maximum).
DF <- data.frame(Kprime=rep(NA,0),id=rep(NA,0),N_SysEff=rep(NA, 0),N_Dilation=rep(NA, 0),stringsAsFactors=FALSE)

for (j in 1:n_expes) {
	x <-paste("study_kp/simu_all_set",j,sep = "")
	dat = read.table(x, header = TRUE)
	#We compute K'. To do this we take only three significant numbers (otherwise there are roundup errors, even with this, but we filter them later).
	setDT(dat)[]

	#Next step is to compute the max as a function of Kprime
	df <- data.frame(
			SysEff=rep(NA, nrow(dat)),
			Dilation=rep(NA, nrow(dat)),
			Kprime=rep(NA, nrow(dat)),
			id=rep(NA,nrow(dat)),
			stringsAsFactors=FALSE)

	for (i in 1:nrow(dat)) {
		if(i == 1) {
			df[1,] <- c(dat[1,SysEff],dat[1,Dilation],dat[1,Kprime],j)
		} else {
			if(dat[i,SysEff] > df[i-1,"SysEff"]) {
				df[i,] <- c(dat[i,SysEff],dat[i,Dilation],dat[i,Kprime],j)
			}
			if(dat[i,SysEff] < df[i-1,"SysEff"]) {
				df[i,] <- c(df[i-1,"SysEff"],df[i-1,"Dilation"],dat[i,Kprime],j)
			}
			if(dat[i,SysEff] == df[i-1,"SysEff"]) {
				df[i,] <- c(dat[i,SysEff],min(df[i-1,"Dilation"],dat[i,Dilation]),dat[i,Kprime],j)
			}
		}
	}
	setDT(df)[ , N_SysEff := SysEff/SysEff[nrow(dat)]]
	setDT(df)[ , N_Dilation := Dilation/Dilation[nrow(dat)]]

	#Removing columns useless for this plot (syseff+Dilation, we only need the normalized versions).
	dat <- subset( df, select = -c(SysEff, Dilation) )
	DF <-rbind(DF,dat)
}
#DF now contains everything :)

#We want to do averages over all sets for all values of K'.

dat_S <-  subset( DF, select = c(Kprime, N_SysEff) )
dat_D <-  subset( DF, select = c(Kprime, N_Dilation) )

# Run the functions length, mean, and sd on the value of "N_SysEff/N_Dilation" for each Kprime
tgc_S <- ddply(dat_S, c("Kprime"), summarise,
               N    = length(N_SysEff),
               mean = mean(N_SysEff),
               sd   = sd(N_SysEff),
               se   = sd / sqrt(N)
)
tgc_D <- ddply(dat_D, c("Kprime"), summarise,
               N    = length(N_Dilation),
               mean = mean(N_Dilation),
               sd   = sd(N_Dilation),
               se   = sd / sqrt(N)
)

# We now filter roundup errors: we only take the elements when we have all expe values (n_expes)
tgc_S_Filtered=subset(tgc_S, (N==n_expes & Kprime <n_kp & Kprime >= n_kp_min))
tgc_D_Filtered=subset(tgc_D, (N==n_expes & Kprime <n_kp & Kprime >= n_kp_min))

###NOW WE PLOT !!

pSysEff = ggplot(data=tgc_S_Filtered, aes(x=Kprime,y=mean))+
    geom_errorbar(aes(ymin=mean-se, ymax=mean+se), width=.1,colour="grey30",alpha=0.3) +#theme_bw()+
	xlab("K' = Tmax / Tmin")+scale_x_continuous(breaks=n_kp_min:n_kp)+
	ylab("Normalized SysEff")+
	geom_line(size=1, colour="#000099")+ geom_point(colour="#000099")+
	theme(axis.text=element_text(size=12),
	axis.title.x = element_text(size=14, face="bold"),
	axis.title.y = element_text(size=14, face="bold")
	)

pDil = ggplot(data=tgc_D_Filtered, aes(x=Kprime,y=mean))+
    geom_errorbar(aes(ymin=mean-se, ymax=mean+se), width=.1,colour="grey30",alpha=0.3) + theme(legend.text=element_text(size=20))+
	xlab("K' = Tmax / Tmin")+scale_x_continuous(breaks=n_kp_min:n_kp)+
	ylab("Normalized Dilation")+
	geom_line(size=1, colour="#FF9999")+ geom_point(colour="#FF9999")+
	theme(axis.text=element_text(size=12),
	axis.title.x = element_text(size=14, face="bold"),
	axis.title.y = element_text(size=14, face="bold")
	)

#This is to print both figures as one, sharing xlab.
#To print individually, remove all commented text above.
cairo_pdf(file =img, width=13, height=3)
pushViewport(viewport(layout = grid.layout(1, 2)))
print(pSysEff, vp = viewport(layout.pos.row = 1, layout.pos.col = 1))
print(pDil, vp = viewport(layout.pos.row = 1, layout.pos.col = 2))
dev.off()


#################
### SH functions
#################

#' Wrapper function for limitless regression discontinuity testing and estimation
#'
#' In a regression discontinuity design, this function tests for an effect using \code{testSH},
#' and inverts the test to estimate a confidence interval and Hodges-Lehmann point estimate.
#' The test is the test associated with the Z coefficient after fitting
#' a model from the robustbase suite that uses Z and R as independent variables.
#' Covariance adjustment is via robust logistic regression if
#' ytilde is binary, robust linear regression otherwise. In the latter case,
#' since we're using `robustbase::lmrob` with the `MM` method, the SE used
#' in the test is of the Huber-White type, allowing for heteroskedasticity
#' and accounting for  propagation of errors from the preliminary fitting
#' done by the robust regression routine.
#'
#' This is the method recommended in version 2 of Limitless
#' Regression Discontinuity
#'
#' @param dat Data set with columns \code{Z}, \code{R}, an outcome variable, and (optionally)
#' an indicator for treatment received, in the case of partial compliance.
#' @param BW An optional bandwidth \code{b>0}. The test uses data for subjects with |R|<b. When
#' \code{BW} is omitted, the function uses sequential covariate balance tests to choose a
#' data-driven bandwidth.
#' @param outcome A string specifying the name of the outcome variable
#' @param Dvar An optional string specifying the name of the treatment-received variable in the
#' case of partial compliance.
#' @param alpha The level of the confidence interval
#' @param rhs A string specifying the \eqn{\mu_\beta(\cdot)} model relating the outcome to
#' \code{R}. Defaults to \code{"R+Z"}
#'
#' @return a list consisting of
#' \describe{
#'  \item{p.value} The p-value testing no effect
#'  \item{CI} a vector of confidence limits and the HL treatment effect
#'  \item{BW} the RDD bandwidth
#'  \item{bal.pval} a p-value testing for covariate balance
#'  \item{n} the number of subjects in the window of analysis
#'  \item{W} the range of R values in the window of analysis
#' }
#' @import robustbase
#' @export

sh <- function(dat,BW,outcome,Dvar='probation_year1',alpha=0.05,rhs=NULL,...){
    if(missing(BW)) BW <- bwMult(dat,...)
    if(!is.null(Dvar)) dat$D <- dat[[Dvar]]
    bal.pval <- balMult(dat,BW,method='sh',reduced.covars=FALSE,rhs=rhs)
    p.value <- testSH(dat=dat,BW=BW,outcome=outcome,rhs=rhs)
    est <- HLsh(dat=dat,BW=BW,outcome=outcome,rhs=rhs)
    CI <- CIsh(dat=dat,BW=BW,outcome=outcome,est=est,alpha=alpha,rhs=rhs)
    list(p.value=p.value,CI=CI,BW=BW,bal.pval=bal.pval,W=c(min(abs(dat$R)),BW),n=sum(abs(dat$R)<BW))
}

#' Univariate covariance-adjusted balance test, using Huber-White SE
#'
#' The test is the test associated with the Z coefficient after fitting
#' a linear or logistic-linear model with Z and R as independent variables.
#' The Huber-White SE is the one provided by the sandwich package.
#' #'
#'
#' @param dat Data set with columns \code{Z}, \code{R} and a covariate
#' @param BW The bandwidth within which to test balance.
#' @param varb The character name of the variable to test balance on.
#' @param rhs  A string specifying the \eqn{\mu_\beta(\cdot)} model relating the outcome to
#' \code{R}. Defaults to \code{"R+Z"}
#'
#' @return scalar, the p-value associated w/ coefficient on Z
#' @import sandwich
#' @export
balOneSH <- function(dat,BW,varb,rhs=NULL){

    if(sum(dat$R<0 & -BW<dat$R)<2 || sum(dat$R>0 & dat$R<BW)<2) return(NA)
    dat <- dat[abs(dat$R)<BW,]
    dat$ytilde <- dat[[varb]]

    form <- if(is.null(rhs)) as.formula('ytilde~Z+R') else
                   as.formula(paste0('ytilde',rhs))

    if(length(unique(dat$ytilde))>2)
        mod <- lm(form,dat=dat)
    else mod <- glm(form,dat=dat,family=binomial)
    vcv <- sandwich::sandwich(mod)
    Z.pos.c <- pmatch("Z", names(coef(mod)))
    Z.pos.v <- pmatch("Z", colnames(vcv))
    tstat <- coef(mod)[Z.pos.c]/sqrt(vcv[Z.pos.v, Z.pos.v])
    2 * pt(-abs(tstat), df=mod$df.residual, lower.tail=T)
}

#' Robust balance test following robust covariate adjustment
#'
#' The test is the test associated with the Z coefficient after fitting
#' a model from the robustbase suite that uses Z and R as independent variables.
#' Covariance adjustment is via robust logistic regression if
#' ytilde is binary, robust linear regression otherwise. In the latter case,
#' since we're using `robustbase::lmrob` with the `MM` method, the SE used
#' in the test is of the Huber-White type, allowing for heteroskedasticity
#' and accounting for  propagation of errors from the preliminary fitting
#' done by the robust regression routine.
#'
#' This is the method recommended in version 2 of Limitless
#' Regression Discontinuity
#'
#' @param dat Data set with columns \code{Z}, \code{R}, and an outcome variable
#' @param BW A bandwidth \code{b>0}. The test uses data for subjects with |R|<b
#' @param tau A hypothetical treatment effect. Defaults to 0
#' @param outcome A string specifying the name of the outcome variable
#' @param return.coef If TRUE return the Z-coefficient from the model; if FALSE return
#' the p-value
#' @param rhs A string specifying the \eqn{\mu_\beta(\cdot)} model relating the outcome to
#' \code{R}. Defaults to \code{"R+Z"}
#'
#' @return scalar, if return.coef the coefficient on Z; otherwise the p-value associated
#' w/ coefficient on Z
#' @import robustbase
#' @export
testSH <- function(dat,BW,tau=0,outcome='Y',return.coef=FALSE,rhs=NULL){
    if(sum(dat$R<0 & -BW<dat$R)<2 || sum(dat$R>0 & dat$R<BW)<2) return(NA)
    dat <- dat[abs(dat$R)<BW,]

    if('D'%in%names(dat)) dat$ytilde <- dat[[outcome]]-tau*dat$D
    else dat$ytilde <- dat[[outcome]]-tau*dat$Z

    ctl <- if (exists('lmrob_seed')) {
        lmrob.control(seed=lmrob_seed, k.max=500, maxit.scale=500)
    } else lmrob.control(          k.max=500, maxit.scale=500)

    form <- if(is.null(rhs)) as.formula('ytilde~Z+R') else
                   as.formula(paste0('ytilde',rhs))

    mod <- lmrob(form,data=dat,method='MM',control=ctl)

    newcov <- try(LRDsandwich(mod))
    mod$cov <- if (inherits(newcov, "try-error")) NA else newcov
    Z.pos = pmatch("Z", names(coef(mod)))
    if(return.coef) return(coef(mod)[Z.pos])
    coef(summary(mod))[Z.pos,4]

}

#' Hodges-Lehmann estimate of a treatment effect for limitless regression discontinuity
#'
#' Inverts the test in \code{testSH()} to find the Hodges-Lehmann point estimate
#'
#'
#' @param dat Data set with columns \code{Z}, \code{R}, and an outcome variable
#' @param BW A bandwidth \code{b>0}. The test uses data for subjects with |R|<b
#' @param outcome A string specifying the name of the outcome variable
#' @param rhs A string specifying the \eqn{\mu_\beta(\cdot)} model relating the outcome to
#' \code{R}. Defaults to \code{"R+Z"}
#'
#' @return scalar, the Hodges-Lehmann estimate
#' @import robustbase
#' @export

HLsh <- function(dat,BW,outcome='Y',rhs=NULL){

    shortFunction <- function(tau)
        testSH(dat=dat,BW=BW,tau=tau,outcome=outcome,return.coef=TRUE,rhs=rhs)
    out <- try(uniroot(shortFunction,interval=c(-2,2),extendInt='yes')$root)
    ifelse(inherits(out, 'try-error'),NA,out)
}

#' Confidence Interval and Hodges-Lehmann estimate of a treatment effect for limitless
#' regression discontinuity
#'
#' Inverts the test in \code{testSH()} to find the Confidence Interval and Hodges-Lehmann
#' point estimate
#'
#'
#' @param dat Data set with columns \code{Z}, \code{R}, and an outcome variable
#' @param BW A bandwidth \code{b>0}. The test uses data for subjects with |R|<b
#' @param outcome A string specifying the name of the outcome variable
#' @param est A point estimate generated by \code{HLsh}. If not provided it will be estimated
#' automatically.
#' @param alpha the level of the confidence interval.
#' @param rhs A string specifying the \eqn{\mu_\beta(\cdot)} model relating the outcome to \code{R}. Defaults to \code{"R+Z"}
#'
#' @return a vector including
#' \describe{
#'  \item{CI1} and
#'  \item{CI2}, the lower and upper bounds of the confidence interval;
#'  \item{est}, the HL point estimate
#' }
#' @import robustbase
#' @export
CIsh <- function(dat,BW,outcome='Y',est,alpha=0.05,rhs=NULL){

    shortFunction <- function(tau) testSH(dat=dat,BW=BW,tau=tau,outcome=outcome,rhs=rhs)-alpha
    if(missing(est)) est <- HLsh(dat=dat,BW=BW,outcome=outcome)
    CI1 <- uniroot(shortFunction,interval=c(-2,est),extendInt='upX')$root
    CI2 <- uniroot(shortFunction,interval=c(est,2),extendInt='downX')$root
    c(CI1=CI1,CI2=CI2,est=est)
}

###############
### IK method
#############

#' Wrapper for Imbens-Kalyanaraman style RDD analysis
#'
#' Uses OLS to estimate the RDD Local Average Treatment Effect (LATE) as in
#' Imbens, G. and Kalyanaraman, K. (2012). Uses a "rectangular" kernal.
#' Tests balance on a set of pre-treatment covariates using \code{balMult} and either the
#' provided bandwidth or the bandwidth calculated with the IK procedure.
#'
#'
#' @param dat Data set with columns \code{Z}, \code{R}, and an outcome variable
#' @param BW (Optional) A bandwidth \code{b>0}. If not provided it will be estimated from the
#' data
#' @param outcome A string specifying the name of the outcome variable
#'
#' @return a list consisting of
#' \describe{
#'  \item{p.value} The p-value testing no effect
#'  \item{CI} a vector of confidence limits and the HL treatment effect
#'  \item{BW} the RDD bandwidth
#'  \item{bal.pval} a p-value testing for covariate balance
#'  \item{n} the number of subjects in the window of analysis
#'  \item{W} the range of R values in the window of analysis
#' }
#' @import rdd
#' @export

ik <- function(dat,BW=NULL,outcome){
    mod <- ikTest(dat,BW,varb=outcome,justP=FALSE)
    BW <- mod$bw[1]
    bal.pval=balMult(dat=dat,BW=BW,method='sh',reduced.covars=FALSE)
    list(p.value=mod$p[1],CI=c(mod$ci[1,],est=mod$est[1]),bal.pval=bal.pval,
         W=c(min(abs(dat$R)),BW),n=sum(abs(dat$R)<BW))
}

#' Imbens-Kalyanaraman style RDD analysis
#'
#' Uses OLS to estimate the RDD Local Average Treatment Effect (LATE) as in
#' Imbens, G. and Kalyanaraman, K. (2012). Uses a "rectangular" kernal.
#' Tests balance on a set of pre-treatment covariates using \code{balMult} and either the
#' provided bandwidth or the bandwidth calculated with the IK procedure.
#'
#'
#' @param dat Data set with columns \code{Z}, \code{R}, and an outcome variable
#' @param BW (Optional) A bandwidth \code{b>0}. If not provided it will be
#' estimated from the data
#' @param varb A string specifying the name of the outcome or covariate variable
#' @param rhs Ignored
#' @param justP if TRUE only returns the p-value
#'
#' @return if justP=TRUE, returns the p-value for an effect. if justP=FALSE,
#' returns the fitted RDD model (an object of class "RD").
#' @import rdd
#' @export

ikTest <- function(dat,BW=NULL,varb,rhs=NULL,justP=TRUE,cutpoint=-0.005){
    if(!missing(varb)) dat$Y <- -dat[[varb]]
    if(missing(BW) | is.null(BW))
        mod <- try(RDestimate(Y~R,kernel='rectangular',
                              data=dat,cutpoint=cutpoint))
    else  mod <- try(RDestimate(Y~R,kernel='rectangular',
                                data=dat,bw=BW,cutpoint=cutpoint))
    if(class(mod)=='try-error') return(rep(NA,ifelse(justP,1,5)))
    if(justP) return(mod$p[1])
    mod
}

ikMultBal <- function(dat,BW,xvars,int=FALSE){
    require(systemfit)
    xeq <- if(int) lapply(xvars,function(xx) as.formula(paste0(xx,'~R+Z+R:Z'))) else
    lapply(xvars,function(xx) as.formula(paste0(xx,'~R+Z')))
    names(xeq) <- gsub('_','',xvars)

    sur <- systemfit(xeq,data=subset(dat,abs(R)<BW))

    rest <- paste(names(xeq),'Z',sep='_')
    rest <- paste(rest,'=0')

    linearHypothesis(sur,rest,test='Chisq')$Pr[2]
}

###############
### CCT method
#############

#' @export

cct <- function(dat,BW=NULL,outcome){
    mod <- cctTest(dat,BW,varb=outcome,justP=FALSE)
    BW <- mod$bws['h','left']
    bal.pval=balMult(dat=dat,BW=BW,method='sh',reduced.covars=FALSE)
    list(p.value=mod$pv['Robust',1],CI=c(mod$ci['Robust',],est=mod$coef['Robust','Coeff']),bal.pval=bal.pval,
         W=c(min(abs(dat$R)),BW),n=sum(mod$Nh))
}

#' @export

cctTest <- function(dat,BW=NULL,varb,rhs=NULL,justP=TRUE){
    if(!missing(varb)) dat$Y <- -dat[[varb]]
    if(missing(BW) | is.null(BW))
        mod <- try(with(dat,rdrobust(Y,R,-0.005,kernel='uniform')))
    else  mod <- try(with(dat,rdrobust(Y,R,-0.005,kernel='uniform',h=BW)))
    if(class(mod)=='try-error') return(rep(NA,ifelse(justP,1,5)))
    if(justP) return(mod$pv['Robust',1])
    mod
}

cctMultBal <- function(dat,BW,xvars,int=FALSE){
    balPs <- lapply(xvars,function(xx) rdrobust(xx,dat$R,-0.005,h=BW))
    names(xeq) <- gsub('_','',xvars)

    sur <- systemfit(xeq,data=subset(dat,abs(R)<BW))

    rest <- paste(names(xeq),'Z',sep='_')
    rest <- paste(rest,'=0')

    linearHypothesis(sur,rest,test='Chisq')$Pr[2]
}

################
### CFT Method
##############
##' RDD analysis method modeled on Cattaneo et al 2014, J Causal Inference
##'
##'
##' @title CFT analysis method
##' @param dat Data set with columns \code{Z}, \code{R}, and an outcome variable
##' @param BW (Optional) A bandwidth \code{b>0}. If not provided it will be estimated from the data
##' @param outcome A string specifying the name of the outcome or covariate variable
##' @param alpha 1-confidence interval level
##' @param rhs Ignored
##' @return list of
##' \describe{
##'  \item{p.value} of Fisher-style no effect hypothesis
##'  \item{CI} vector of confidence limits, estimate
##'  \item{bal.pval} balance p-value
##'  \item{n} number of observations inselected window
##'  \item{W}  window
##' }
##' @author lrd author 1
##' @export
cft <- function(dat,BW,outcome,alpha=0.05,rhs=NULL){
    if(missing(BW) |is.null(BW))
        BW <- bwMult(dat,balMult.control=list(method='cft',reduced.covars=FALSE))

    if(sum(dat$R<0 & -BW<dat$R)<2 || sum(dat$R>0 & dat$R<BW)<2) return(NA)

    bal.pval=balMult(dat=dat,BW=BW,method='cft',reduced.covars=FALSE)

    estAll <- cftTest(dat=dat,BW=BW,varb=outcome,alpha=alpha,justP=FALSE)

    list(estAll$p.value,CI=c(estAll$conf.int,est=estAll$estimate),bal.pval=bal.pval,
         n=sum(abs(dat$R)<BW),W=c(min(abs(dat$R)),BW))
}

cftTest <- function(dat,BW,varb,alpha=0.05,rhs=NULL,justP=TRUE){
    if(sum(dat$R<0 & -BW<dat$R)<2 || sum(dat$R>0 & dat$R<BW)<2) return(NA)
    dat <- dat[abs(dat$R)<BW,]

    if(!missing(varb)) dat$Y <- dat[[varb]]
    if(length(unique(dat$Y))==2){
        wilcox <- with(dat,fisher.test(Y,Z,conf.int=!justP,conf.level=1-alpha))
    }
    else wilcox <- with(dat,wilcox.test(Y[Z==1],Y[Z==0],conf.int=!justP,conf.level=1-alpha))
    if(justP) return(wilcox$p.value)
    return(wilcox[c('p.value','conf.int','estimate')])
}

##############################
### data-driven bandwidths
############################

balMult <- function(dat,BW,method='sh',reduced.covars=TRUE,rhs=NULL,bonferonni=TRUE){
    ps <- NULL
    balTest <- switch(method, "sh"=balOneSH,"cft"=cftTest,"ik"=ikTest)

    xvars <- c('lhsgrade_pct','totcredits_year1','male','loc_campus1','loc_campus2',
               'bpl_north_america','english')
    xvars <- if (reduced.covars) c(xvars, 'age') else c(xvars, 'age_at_entry')

    if(method=='ik') return(ikMultBal(dat,BW,xvars))

    for(varb in xvars){
        ps <- c(ps,balTest(dat=dat,BW=BW,varb=varb,rhs=rhs))

    }
    if(bonferonni) ps <- ps*length(ps)
    min(1,min(ps))
}

#' Choose a bandwidth using either Limitless or Permutations method with one covariate, or the IK method
#'
#' @param dat a data.frame. must contain variables `R` (the running variable) and `Z`
#' (treatment) and, if method='ik', `Y` (outcome)
#' @param covname a character string, the name of the covariate to test balance on
#' (unless method='ik')
#' @param method a character string. either 'sh' for Limitless, 'ik' for IK, or 'cft' for
#' Permutations
#'
#' @return bandwidth choice (scalar)
#' @export
bw <- function(dat,covname='x',method='sh',alphax=0.15,plt=FALSE){

    if(method=='ik') return(IKbandwidth(dat$R,dat$Y,kernel='rectangular'))
    else test <- switch(method,"sh"= balOneSH, "cft"=cftTest)
    short <- function(w) test(dat=dat,BW=w,varb=covname)# - alphax
    #uniroot(short,interval=c(min(max(dat$R),-min(dat$R))-0.1,min(max(dat$R),-min(dat$R))),
    #                  extendInt='downX')$root
    bws <- seq(0.02,min(max(dat$R),-min(dat$R)),0.01)
    ps <- vapply(bws,short,1)
    if(plt) plot(ps)
    bws[max(which(ps>alphax))]
}

#' Choose a bandwidth using one of several methods
#'
#' Method options include Limitless, a permutation-testing method, or the IK method
#'
#' @param dat a data.frame. must contain variables `R` (the running variable) and `Z`
#' (treatment) and, if method='ik', `Y` (outcome) along with these covariates: 'lhsgrade_pct',
#' 'totcredits_year1','male','loc_campus1','loc_campus2','bpl_north_america','english',
#' and 'age'
#' @param alpha the level of the balance test
#' @param newbal.control list of optional arguments to `newBal`
#' @param bsw numeric, a sequence of bandwidths to try (in increasing order)
#'
#' @return bandwidth choice (scalar)
#' @export
bwMult <- function(dat,alpha=0.15,balMult.control=list(method='sh',reduced.covars=FALSE), bws = seq(0,2,0.01)){
    stopifnot(is.list(balMult.control),
              !any(c('dat', 'BW') %in% names(balMult.control)),
              is.numeric(bws) && all(bws >=0),
              length(bws)==1 || !is.unsorted(bws))
    short <- function(w) {
        nbargs <- c(list(dat=dat, BW=w), balMult.control)
        try(do.call(balMult, nbargs))
    }

    p <- 0
    i <- length(bws)+1
    while(p<alpha){
        i <- i-1
        if(i==0) return(i)
        bw <- bws[i]
        pval <- short(bw)
        p <- ifelse(is.numeric(pval)&is.finite(pval),pval,0)
    }
    bws[i]
}

##############################
### Frandsen Manipulation Test
############################
frandsenK <- function(R,BW){
    if(!missing(BW)) R <- R[abs(R)<BW]
    rvals <- sort(unique(R))
    delta <- min(c(rvals,NA)-c(NA,rvals),na.rm=TRUE)
    delta <- delta/sd(R,na.rm=TRUE)

    delta^3*dnorm(delta/2)/(2*(pnorm(3*delta/2)-pnorm(delta/2)))
}

frandsenTest <- function(N0,Nplus,Nminus,k){
    m <- N0+Nplus+Nminus
    results <- data.frame(k=k,p=NA)
    for(k in results$k){
        results$p[results$k==k] <- 2*min(pbinom(N0,m,(1-k)/(3-k)),1-pbinom(N0,m,(1+k)/(3+k)))
    }
    results
}

#' Frandsen Manipulation Test
#'
#'
#'
#' @param R a discrete running variable
#' @param cutoff the value of the running variable at the boundary between treatment and control---in Frandsen (2016), the maximum (minimum) R at which subjects are assigned to treatment; alternatively, the minimum (maximum) R at which subjects are assigned to control.
#' @param BW an optional bandwidth, helpful for choosing a benchmark for k
#' @param k a vector of possible values of k, a tuning parameter for the test. The function automatically computes the benchmark value Frandsen (2016) suggests based on normal theory, and adds it to this list.
#'
#' @return a p-value
#'
#' @export
frandsen <- function(R,cutoff,BW,k=c(0,0.01,0.02,0.1)){
    if(missing(BW)) BW <- max(abs(R),na.rm=TRUE)
    k.bench <- frandsenK(R,BW)
    k <- sort(c(k,k.bench))

    N0 <- sum(R==cutoff,na.rm=TRUE)
    rplus <- min(R[R>cutoff],na.rm=TRUE)
    rminus <- max(R[R<cutoff],na.rm=TRUE)
    Nplus <- sum(R==rplus,na.rm=TRUE)
    Nminus <- sum(R==rminus,na.rm=TRUE)

    frandsenTest(N0,Nplus,Nminus,k)
}


#set working directory
setwd("~/Documents/dataScience/myDSproject/movieRecommandation/ml-20m")

#load datasets
#links <- read.csv("links.csv")
movies<- read.csv("movies.csv", stringsAsFactors = FALSE)
ratings <- read.csv("ratings.csv")
#tags <- read.csv("tags.csv")

#Data Pre-processing
genres <- as.data.frame(movies$genres, stringsAsFactors = FALSE)
library(data.table)

genres2 <- as.data.frame(tstrsplit(genres[,1], '[|]',
                                   type.convert = TRUE),
                         stringsAsFactors = FALSE)
colnames(genres2) <- c(1:10)
str(genres2)

#lets find total genres
total_genre <- setNames(data.frame(NA), "genre")
for(i in 1:ncol(genres2)){
  total_genre <- rbind(total_genre,setNames(data.frame(unique(genres2[,i])), "genre"))
}
genre_list  <- unique(total_genre)[-1,]

#empty matrix
genre_matrix <- matrix(0,27279,length(genre_list))
genre_matrix[1,]<- genre_list #set first row to genre list
colnames(genre_matrix) <- genre_list

#iterate through matrix
for(i in 1:nrow(genres2)){
  for(c in 1:ncol(genres2)){
    genmat_col <- which(genre_matrix[1,]==genres2[i,c])
    genre_matrix[i+1,genmat_col] <- 1
  }
}

#convert into data frame
genre_matrix <- as.data.frame(genre_matrix[-1,], stringsAsFactors = FALSE)
#convert char into integer
for (i in 1:ncol(genre_matrix)){
  genre_matrix[,i] <-as.integer(genre_matrix[,i])
}
#create a searchable csv file
#Create a matrix to search for a movie by genre:
years <- as.data.frame(movies$title, stringsAsFactors=FALSE)
library(data.table)
substrRight <- function(x, n){
  substr(x, nchar(x)-n+1, nchar(x))
}
years <- as.data.frame(substr(substrRight(substrRight(years$`movies$title`, 6),5),1,4))

search_matrix <- cbind(movies[,1], substr(movies[,2],1,nchar(movies[,2])-6), years, genre_matrix)
colnames(search_matrix) <- c("movieId", "title", "year", genre_list)

write.csv(search_matrix, "search.csv")
search_matrix <- read.csv("search.csv", stringsAsFactors=FALSE)

#Example of search an Action movie produced in 1995.
subset(search_matrix, Action= 1& year ==1995)$title

#create a user profile
binrating <- ratings[1:100000,]

#ratings are converted into likes and dislikes 4,5->1 otherwise ->-1

for (i in 1:nrow(binrating)) {
  binrating[i,3]<- ifelse(binrating[i,3]>3,1,-1)
}

#convert binary matrix to correct format:
binrating2 <- dcast(binrating,movieId~userId, value.var= "rating", na.rm=FALSE)
for(i in 1:ncol(binrating2)){
  binrating2[which(is.na(binrating2[,i])==TRUE),i]<-0
}
binrating2 <- binrating2[,-1] #remove movieId

#Remove rows that are not rated from movies dataset
movieIds <- length(unique(movies$movieId)) #27278
ratingmovieIds <- length(unique(ratings$movieId)) #26744
movies2 <- movies[-which((movies$movieId %in% ratings$movieId) == FALSE),]
rownames(movies2) <- NULL

#Remove rows that are not rated from genre_matrix2
genre_matrix1 <- genre_matrix[-which((movies$movieId %in% ratings$movieId) == FALSE),]
rownames(genre_matrix1) <- NULL

#calculate the dot product of the genre matrix and
#the ratings matrix and obtain the user profiles

#Calculate dot product for User Profiles
result = matrix(0,20,703) # here, 668=no of users/raters, 18=no of genres
for (c in 1:ncol(binrating2)){
  for (i in 1:ncol(genre_matrix1)){
    result[i,c] <- sum((genre_matrix1[,i]) * (binrating2[,c])) #ratings per genre
  }
}

#convert to binary scale
for(c in 1:ncol(result)){
  for(i in 1:nrow(result)){
    result[i,c]<- ifelse(result[i,c]<0,0,1)
  }
}

#Assume that user like similar items, and retrieve movies
#that are closest in similarity to a user's profile, which
#represents a user's preference for an item's feature.
#use Jaccard Distance to measure the similaritybetween user profiles

#The User-Based collaborative Filtering Approach

library(reshape2)
#Create ratings matrix. Rows=userId, Columns = movieId
rat <- ratings[1:100000,]
ratingmat <- dcast(rat, userId ~movieId, value.var = "rating", na.rm=FALSE)
ratingmat <- as.matrix(ratingmat[,-1]) #remove userIds

#Method: UBCF
#Similarity Calculation Method: Cosine Similarity
#Nearest Neighbors : 30

library(recommenderlab)
#convert rating matrix into a recommenderlab sparse matrix
ratingmat <- as(ratingmat, "realRatingMatrix")

# Determine how similar the first four users are with each other
# create similarity matrix
similarity_users <- similarity(ratingmat[1:4, ],
                               method = "cosine",
                               which = "users")
as.matrix(similarity_users)
image(as.matrix(similarity_users), main = "User similarity")

# compute similarity between
# the first four movies
similarity_items <- similarity(ratingmat[, 1:4], method =
                                 "cosine", which = "items")
as.matrix(similarity_items)
image(as.matrix(similarity_items), main = "Item similarity")

# Exploring values of ratings:
vector_ratings <- as.vector(ratingmat@data)
unique(vector_ratings) # what are unique values of ratings

table_ratings <- table(vector_ratings) # what is the count of each rating value
table_ratings

# Visualize the rating:
vector_ratings <- vector_ratings[vector_ratings != 0] # rating == 0 are NA values
vector_ratings <- factor(vector_ratings)

library(ggplot2)
qplot(vector_ratings) +
  ggtitle("Distribution of the ratings")

# Exploring viewings of movies:
views_per_movie <- colCounts(ratingmat) # count views for each movie

table_views <- data.frame(movie = names(views_per_movie),
                          views = views_per_movie) # create dataframe of views
table_views <- table_views[order(table_views$views,
                                 decreasing = TRUE), ] # sort by number of views

ggplot(table_views[1:6, ], aes(x = movie, y = views)) +
  geom_bar(stat="identity") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_x_discrete(labels=subset(movies2, movies2$movieId == table_views$movie)$title) +
  ggtitle("Number of views of the top movies")

#Visualizing the matrix:
image(ratingmat, main = "Heatmap of the rating matrix") # hard to read-too many dimensions
image(ratingmat[1:10, 1:15], main = "Heatmap of the first rows and columns")
image(ratingmat[rowCounts(ratingmat) > quantile(rowCounts(ratingmat), 0.99),
                colCounts(ratingmat) > quantile(colCounts(ratingmat), 0.99)],
      main = "Heatmap of the top users and movies")

#Normalize the data
ratingmat_norm <- normalize(ratingmat)
image(ratingmat_norm[rowCounts(ratingmat_norm) > quantile(rowCounts(ratingmat_norm), 0.99),
                     colCounts(ratingmat_norm) > quantile(colCounts(ratingmat_norm), 0.99)],
      main = "Heatmap of the top users and movies")

#Create UBFC Recommender Model. UBCF stands for User-Based Collaborative Filtering
recommender_model <- Recommender(ratingmat_norm,
                                 method = "UBCF",
                                 param=list(method="Cosine",nn=30))

model_details <- getModel(recommender_model)
model_details$data

recom <- predict(recommender_model,
                 ratingmat[1],
                 n=10) #Obtain top 10 recommendations for 1st user in dataset

recom

#recc_matrix <- sapply(recom@ite
#                      function(x){ colnames(ratingmat)[x] })
#dim(recc_matrix)

recom_list <- as(recom,
                 "list") #convert recommenderlab object to readable list

#Obtain recommendations
recom_result <- matrix(0,10)
for (i in 1:10){
  recom_result[i] <- as.character(subset(movies,
                                         movies$movieId == as.integer(recom_list[[1]][i]))$title)
}

# Evaluation:
evaluation_scheme <- evaluationScheme(ratingmat,
                                      method="cross-validation",
                                      k=5, given=3,
                                      goodRating=5) #k=5 meaning a 5-fold cross validation. given=3 meaning a Given-3 protocol
evaluation_results <- evaluate(evaluation_scheme,
                               method="UBCF",
                               n=c(1,3,5,10,15,20))
eval_results <- getConfusionMatrix(evaluation_results)[[1]]


##############################################################################
#                                                                            #
# R script to partition tree files into 1-NNI islands, as per Maddison, 1991 #
#                                                                            #
#                     Parallel version                                       #
#                                                                            #
##############################################################################

#######libraries######

library(devtools)
install_github("anaserrasilva/islandNeighbours")
library(islandNeighbours)
library(foreach)
library(doParallel)

######################

######load trees######

t<-read.nexus("PardoCharacters.nex.trprobs")

######get 1-NNI islands######

#extract NNI-neighbourhoods
#parallel analysis run on Windows, other packages for parallelisation may perform better in Mac and Unix systems

#set number of cores
numCores<-detectCores() - 2
cl <- makeCluster(numCores)
registerDoParallel(cl)

NNIneighbours <- nniNeighbourhoods(t, verbose = F)

stopCluster(cl)

#extract islands
NNIislands<-neighbourhoodMerger(NNIneighbours)

#write islands to newick files
write.islands(NNIislands)


##CTE534_Índices=group
##Imagen=raster
##Green=number 2
##SWIR1=number 8
##MNDWI=output raster
##showplots

MNDWI <- raster::overlay(Imagen[[Green]],
                         Imagen[[SWIR1]],
                         fun=function(x,y){(x-y)/(x+y)})
plot(MNDWI)


library(dplyr)
library(leaflet)
library(htmltools)
library(plotly)
library(styler)
library(lintr)

# SUMMARY INFO
shootings_df <- read.csv("data/shootings-2018.csv", stringsAsFactors = FALSE)

num_shootings <- nrow(shootings_df)

num_deaths <- sum(shootings_df$num_killed)

# Impact measured as total killed and injured
most_impact_city <- shootings_df %>%
  mutate(impact = num_killed + num_injured) %>%
  mutate(city_state = paste0(city, ", ", state)) %>%
  group_by(city_state) %>%
  summarize(total_impact = sum(impact)) %>%
  filter(total_impact == max(total_impact)) %>%
  pull(city_state)

chicago_impact <- shootings_df %>%
  mutate(impact = num_killed + num_injured) %>%
  group_by(city) %>%
  summarize(total_impact = sum(impact)) %>%
  filter(total_impact == max(total_impact)) %>%
  pull(total_impact)

# Insight #1: Most impacted state
most_impact_state <- shootings_df %>%
  mutate(impact = num_killed + num_injured) %>%
  group_by(state) %>%
  summarize(total_impact = sum(impact)) %>%
  filter(total_impact == max(total_impact)) %>%
  pull(state)

california_impact <- shootings_df %>%
  mutate(impact = num_killed + num_injured) %>%
  group_by(state) %>%
  summarize(total_impact = sum(impact)) %>%
  filter(total_impact == max(total_impact)) %>%
  pull(total_impact)

# Insight #2: State with most shootings
highest_freq_states <- shootings_df %>%
  group_by(state) %>%
  summarize(total = n()) %>%
  filter(total == max(total)) %>%
  pull(state)

# SUMMARY TABLE
shootings_state_df <- shootings_df %>%
  select(state, num_killed, num_injured) %>%
  group_by(state) %>%
  summarize(
    total_killed = sum(num_killed),
    total_injured = sum(num_injured)
  ) %>%
  arrange(desc(total_killed))

# INCIDENT REPORT
date <- shootings_df %>%
  filter(address == "635 S Clinton Ave") %>%
  pull(date)

location <- shootings_df %>%
  filter(address == "635 S Clinton Ave") %>%
  mutate(location = paste0(city, ", ", state)) %>%
  pull(location)

address <- shootings_df %>%
  filter(address == "635 S Clinton Ave") %>%
  pull(address)

longitude <- shootings_df %>%
  filter(address == "635 S Clinton Ave") %>%
  pull(long)

latitude <- shootings_df %>%
  filter(address == "635 S Clinton Ave") %>%
  pull(lat)

deaths <- shootings_df %>%
  filter(address == "635 S Clinton Ave") %>%
  pull(num_killed)

injuries <- shootings_df %>%
  filter(address == "635 S Clinton Ave") %>%
  pull(num_injured)

# INTERACTIVE MAP
# Labels
labs <- paste0(
  "Location: ", shootings_df$city, ", ", shootings_df$state, "
",
  "Deaths: ", shootings_df$num_killed, "
",
  "Injuries: ", shootings_df$num_injured
)

# Shootings dataframe with impact column
shootings_df_impact <- shootings_df %>%
  mutate(impact = num_killed + num_injured)

shootings_map <- leaflet(data = shootings_df_impact) %>%
  addProviderTiles("CartoDB.Positron") %>%
  setView(lng = -95.71, lat = 37.09, zoom = 4) %>%
  addCircleMarkers(
    lat = ~lat,
    lng = ~long,
    radius = ~impact,
    label = lapply(labs, htmltools::HTML)
  )

# PLOT OF CHOICE (scatter plot)
# Function to determine season
seasons_2018 <- function(date) {
  date <- as.Date(date, format = "%Y-%m-%d")
  spring <- as.Date("2018-03-21", format = "%Y-%m-%d")
  summer <- as.Date("2018-06-21", format = "%Y-%m-%d")
  autumn <- as.Date("2018-09-21", format = "%Y-%m-%d")
  winter <- as.Date("2018-12-21", format = "%Y-%m-%d")
  if (date >= spring && date < summer) {
    season <- "Spring"
  }
  else if (date >= summer && date < autumn) {
    season <- "Summer"
  }
  else if (date >= autumn && date < winter) {
    season <- "Autumn"
  }
  else if (date >= winter || date < spring) {
    season <- "Winter"
  }
  return(season)
}

seasons_2018 <- Vectorize(seasons_2018)

# Shootings dataframe with season column
shootings_df_date <- shootings_df %>%
  mutate(rdate = as.Date(date, "%B %d, %Y")) %>%
  group_by(rdate) %>%
  summarize(frequency = n()) %>%
  mutate(seasons = seasons_2018(rdate))

freq_by_date_plot <- plot_ly(
  data = shootings_df_date,
  x = ~rdate,
  y = ~frequency,
  color = ~seasons,
  colors = c("darkorange", "deeppink", "limegreen", "deepskyblue"),
  type = "scatter",
  mode = "markers",
  alpha = 0.8
) %>%
  layout(
    title = "Daily Frequency of Mass Shootings by Season",
    xaxis = list(title = "Date", tickformat = "%b"),
    yaxis = list(title = "Frequency")
  )


library(rstan)

rstan_options(auto_write = TRUE)

stan_model(file = 'epimap/stan_files/Rmap-clean.stan')
stan_model(file = 'epimap/stan_files/Rmap.stan')
stan_model(file = 'epimap/stan_files/Rmap-latent.stan')


## for each cell type (CT) calculate variance characteristic score
## first adjust betas for differences in mean level of DNAm
## second use levene's test to compare variance in one cell type against all others
## one sided test

library(car)
library(parallel)
cl <- makeCluster(16)
clusterExport(cl,"leveneTest")

adjustCT<-function(row, sampleType){
	return(residuals(lm(row ~ sampleType)))
}

varCharScore<-function(row, indVar){
	return(leveneTest(row ~ indVar, center = "median")[1,3])
}

source("rmdConfig.mrc")
setwd(dataDir)
load(normData)

## remove rs probes
celltypenormbeta<-celltypenormbeta[grep("rs", rownames(celltypenormbeta), invert = TRUE),]

## exclude IRF8+ve as not present in sufficient sample numbers
pheno<-pheno[pheno$Cell.type %in% c("Double -ve","NeuN +ve","Sox10 +ve"),]
celltypenormbeta<-celltypenormbeta[,pheno$Basename]
pheno$Cell.type<-factor(pheno$Cell.type)

betasAdj<-t(apply(celltypenormbeta, 1, adjustCT, pheno$Cell.type))

pheno$Cell.type<-as.factor(as.character(pheno$Cell.type))

out<-matrix(data = NA, nrow = nrow(betasAdj), ncol = 3)
colnames(out)<-levels(pheno$Cell.type)
rownames(out)<-rownames(celltypenormbeta)
for(each in levels(pheno$Cell.type)){
	indVar<-rep(0, ncol(betasAdj))
	indVar[which(pheno$Cell.type == each)]<-1
	indVar<-as.factor(indVar)
	tmp<-parApply(cl, betasAdj, 1, varCharScore, indVar)
	out[,each]<-tmp
	out[,each]<--log10(out[,each])
	## as non-parametric test can test for spcific direction so instead will use sign to indicate direction of effect
	## calculate difference in sd to determine sign
	coef<-sign(parApply(cl, betasAdj[,which(indVar == 1)], 1, sd)-parApply(cl,betasAdj[,which(indVar == 0)], 1, sd))
	out[,each]<-out[,each]*coef
}

save(out, file = "Analysis/CellType/VarianceCharacteristicScores.rdata")


#name: RCaretNBTrain
#meta.mlname: RCaretNB
#meta.mlrole: train
#description: Custom R Train func for Naive Bayes using Caret
#language: r
#input: dataframe df
#input: string predict_column
#output: blob model

#>>> Initialize local environment and install/require necessary packages

library(caret)
library(e1071)
renv::init()
install.packages("naivebayes")
library(naivebayes)
install.packages("MLmetrics")
library(MLmetrics)
#install.packages("klaR")
#library(klaR)

#>>> Extract/Prepare train features and target variable
trainY <- df[[predict_column]]
trainX <- df[, -grep(predict_column, colnames(df))]

#>>> Prepare parameters for model training
tuneGrid <- expand.grid(laplace = 0,  usekernel = FALSE, adjust=1)
#tuneGrid <- expand.grid(usekernel = TRUE,  fL = 1, adjust=3)  #<-- Uncomment for method='nb'
ctrl <- trainControl(method="repeatedcv", repeats=5, summaryFunction=multiClassSummary,
  classProbs=TRUE, savePredictions=FALSE, returnResamp="final", returnData=FALSE, trim=TRUE)

#>>> Train model
trained_model <- caret::train(
  x=trainX,
  y=trainY,
  method='naive_bayes',
#  method='nb',
  preProcess=c("center", "scale"),
  trControl=ctrl,
  tuneGrid = tuneGrid
  )

#>>> Save trained model
saveRDS(trained_model, file=model)


library(genalg)

#Infinite Loop
while( TRUE ){
#set working directory
setwd("~/Desktop/mercy600")
#import csv file of miner data [account,stake,trust]
miners <- read.csv("blockchainminers.csv")

#set the budget
stake.limit <- 60000
#sets the number of miner accounts
potenial_miners <- length(miners[,1])
#set the amount of times we evaluate
iterations = 500
#set population size
popSize = 500
#set mutationChance
mutationChance = 0.02

#GA eval function
trustedminerBuilder <- function(GA) {
  #use selected potenial_miners
  trustedminer <- which(GA==1)

   #add up the projected points of the selected potenial_miners and store in trustedminer_trust
  trustedminer_trust <- sum(miners[trustedminer,3])
  #add up the stake of selected potenial_miners and store in trustedminer_stake
  trustedminer_stake <- sum(miners[trustedminer,2])
   print(trustedminer_stake)
   print(trustedminer_trust)

   #check to see if there are not 11 potenial_miners , this is ineligible
   if(sum(GA) != 11 )  return(200*(abs(sum(GA)-11)))

   #check to see if trustedminer is over the budget limit
   if(trustedminer_stake > stake.limit) return(abs(60000 - trustedminer_stake))
   return(-trustedminer_trust)
}

#Create a Genetic Algorithm Model for draft kings trustedminers
GAmodel <- rbga.bin(size = potenial_miners, popSize = popSize, iters = iterations, mutationChance = mutationChance,  evalFunc = trustedminerBuilder, showSettings=FALSE, verbose=FALSE)

cat(genalg:::summary.rbga(GAmodel,echo=T))

out = c(genalg:::summary.rbga(GAmodel,echo=T))
#isolate the binary solution of the output using regex
s1=gsub("\\D||500","",out)
string=gsub("^\\d{8}","",s1)
#print(s1)

#to python
#send the binary solution of the trustedminer values to python
command = "python3.5"

# Note the single + double quotes in the string (needed if paths have spaces)
path2script='"/root/Desktop/mercy600/genalg.py"'

args = c(string)

# Add path to script as first arg
allArgs = c(path2script, args)

#print output from python back to screen
output = system2(command, args=allArgs, stdout=TRUE)

print(paste(output))

}


context("boundie matrix")

test_that("fit using expression matrix", {
    f1 = runif(100)
    f2 = 1 - f1
    c1 = stats::rnbinom(n=100, size=10, mu=1000)
    c2 = stats::rnbinom(n=100, size=20, mu=10)
    mix1 = round(f1 * c1 + f2 * c2)
    mix2 = round(f2 * c1 + f1 * c2)

    ctl1 = MASS::glm.nb(mix1 ~ 0 + f1 + f2)
    ctl2 = MASS::glm.nb(mix2 ~ 0 + f1 + f2)

    both = rbind(mix1, mix2)
    rownames(both) = c("mix1", "mix2")
    res = boundie(both, ~ 0 + f1 + f2)

    expect_true(all(c(res[1,'f1'], res[1,'f2']) - coef(ctl1) < 1e-4))
    expect_true(all(c(res[2,'f1'], res[2,'f2']) - coef(ctl2) < 1e-4))
})