library(tidyverse)
library(data.table)
library(readxl)
library(scales)
library(ggrepel)
library(ggforce)
library(gganimate)
library(gifski)
library(xts)
library(roll)
library(rnaturalearth)
library(rnaturalearthdata)
library(countrycode)
library(cowplot)
options(na.action = na.exclude)

setwd("~/Public_Policy_Upd/Projects/Inequality")

get_period_growth = function(start, end, periods) {
  period_avg_growth = (end / start)^(1/periods) - 1
  return(period_avg_growth)
}

##### get polity data #####
polity_political_violence = read_excel('data/MEPVv2018.xls')
polity_coups = read_excel('data/CSPCoupsAnnualv2018 (1).xls')
polity_v = read_excel( "data/polity iv data.xls" )

filter(polity_political_violence, str_detect(country %>% tolower(), 'vietnam')) %>% pull(country) %>% unique()
filter(polity_political_violence, str_detect(country %>% tolower(), 'cambodia')) %>% pull(country) %>% unique()
filter(polity_political_violence, str_detect(country %>% tolower(), 'laos')) %>% pull(country) %>% unique()

polity_v_fin =
  left_join(polity_v, polity_coups) %>%
  left_join(polity_political_violence) %>%
  mutate(
    country = recode(country,
                     UAE = 'United Arab Emirates',
                     Bosnia =  "Bosnia and Herzegovina",
                     `Congo Brazzaville` = 'Congo',
                     `Congo Kinshasa` = 'D.R. of the Congo',
                     `Korea South` = 'South Korea',
                     `Korea North` = 'North Korea',
                     `USSR` = 'Former USSR')
  )

world_map <- ne_countries(scale = "medium", returnclass = "sf") %>%
  mutate(
    name = recode(name,
                  `Dem. Rep. Korea` = 'South Korea',
                  `Czech Rep.` = 'Czech Republic',
                  `Slovakia` = 'Slovak Republic',
                  `Bosnia and Herz.` = 'Bosnia and Herzegovina',
                  `Macedonia` = 'North Macedonia',
                  `Dem. Rep. Congo` = "D.R. of the Congo",
                  `S. Sudan` = 'South Sudan',
                  `Eq. Guinea`="Equatorial Guinea",
                  `Central African Rep.` = "Central African Republic",
                  `North Macedonia` = 'Macedonia',
                  `Myanmar` = 'Myanmar (Burma)',
                  `N. Cyprus` = 'Cyprus',
                  `Lao PDR` = 'Laos'
                  )
  )
world_map$name = ifelse(str_detect(world_map$name, 'Ivoire'), "Cote D'Ivoire", world_map$name)

#### get historical gdp stats and join everything #####
historical_gdp_stats = read_excel("data/angus maddison historical gdp statistics.xlsx", 'Full data') %>%
  mutate(
    country = recode(country,
                     `Bolivia (Plurinational State of)` = 'Bolivia',
                     `Russian Federation` = 'Russia',
                     `Viet Nam` = 'Vietnam',
                     `D.P.R. of Korea` = 'North Korea',
                     `Republic of Korea` = 'South Korea',
                     `Syrian Arab Republic` = 'Syria',
                     `Iran (Islamic Republic of)` = 'Iran',
                     `Lao People's DR` = 'Laos',
                     # `Former USSR` = 'USSR',
                     `Sudan (Former)` = 'Sudan',
                     `Myanmar` = 'Myanmar (Burma)',
                     `Slovakia` = 'Slovak Republic',
                     `Venezuela (Bolivarian Republic of)` = 'Venezuela',
                     `Taiwan, Province of China` = 'Taiwan',
                     `TFYR of Macedonia` = 'Macedonia',
                     # `D.R. of the Congo`='Congo Kinshasa',
                     # `Congo` = 'Congo-Brazzaville',
                     `Republic of Moldova` = 'Moldova',
                     `Dominica` = 'Dominican Republic',
                     `U.R. of Tanzania: Mainland` = 'Tanzania',
                     `China, Hong Kong SAR` = 'Hong Kong'
                     )
  ) %>%
  arrange(countrycode, year) %>%
  data.table()

historical_gdp_stats_growth = historical_gdp_stats[, {
  # china = filter(historical_gdp_stats, country == 'China')
  # attach(china)
  # detach(china)
  #
  the_dat = data.frame(year, cgdppc, rgdpnapc, pop)

  full_year_df = data.frame(
    year = min(year, na.rm = T):max(year, na.rm = T)
  ) %>%
    left_join(
      the_dat
    ) %>%
    mutate(
      rgdpnapc_interpolated = na.approx(rgdpnapc, na.rm = F),
      lag_1_rgdpnapc = lag(rgdpnapc, 1),
      lag_2_rgdpnapc = lag(rgdpnapc, 2),
      lag_5_rgdpnapc = lag(rgdpnapc, 5),
      lag_10_rgdpnapc = lag(rgdpnapc, 10),
      lag_10_rgdpnapc_interpolated = lag(rgdpnapc_interpolated, 10),
      pop_interpolated = na.approx(pop, na.rm = F),
      real_gdp_cap_growth = (rgdpnapc - lag(rgdpnapc, 1))/ lag(rgdpnapc, 1),
      real_gdp_cap_growth_interp = (rgdpnapc_interpolated - lag(rgdpnapc_interpolated, 1))/ lag(rgdpnapc_interpolated, 1),
      roll_5_real_gdp_cap_growth_interp = roll_mean(real_gdp_cap_growth_interp, 5),
      lag_5_roll_5_real_gdp_cap_growth_interp = lag(roll_5_real_gdp_cap_growth_interp, 5),
      pop_growth = (pop - lag(pop, 1)) / lag(pop, 1),
      pop_growth_interp = (pop_interpolated - lag(pop_interpolated, 1)) / lag(pop_interpolated, 1),
      lagged_real_gdp_cap_growth = lag(real_gdp_cap_growth, 1),
      lagged_real_gdp_cap_growth_interp = lag(real_gdp_cap_growth_interp, 1)
    )

  full_year_df

}, by = list(country)] %>%
  full_join(
    polity_v_fin,
    by = c('country', 'year')
  ) %>%
  mutate(
    polity2 = ifelse(polity2 %in% c(-88, -66), NA, polity2),
    polity_desc = ifelse(between(polity2, -5, 5), 'Anocracy (mixed)', ifelse(polity2 > 5, 'Democracy', 'Autocracy')),
    polity_desc = factor(polity_desc, levels = c('Autocracy', 'Anocracy (mixed)', 'Democracy')),
    autocratic_shift = change < 0 & sign(polity2) != sign(prior) & is.na(interim),
    n_coups = scoup1 + atcoup2,
    had_civil_war = civwar > 0
  ) %>%
  arrange(country, year)

historical_gdp_stats_growth_rollstats = historical_gdp_stats_growth[, {
  lagged_polity2 = lag(polity2, 1)
  mean_real_gdp_cap_growth_interp_10 = roll_mean(real_gdp_cap_growth_interp, 10)

  list(
    year = year,
    mean_real_gdp_cap_growth_interp_10  = mean_real_gdp_cap_growth_interp_10,
    lagged_mean_real_gdp_cap_growth_interp_10 = lag(mean_real_gdp_cap_growth_interp_10, 1),
    n_polity_changes_last_20_years = roll_sum(polity2 - lagged_polity2 != 0, 20),
    lagged_polity2 = lagged_polity2,
    n_autocratic_shifts_last_10_years = roll_sum(autocratic_shift, 10),
    n_coup_attempts_last_10_years = roll_sum(atcoup2, 10),
    n_coups_last_10_years = roll_sum(scoup1, 10),
    n_civil_war_years_last_10_years = roll_sum(civwar > 0, 10)
  )
}, by = list(country)]

stats_by_country = historical_gdp_stats_growth[,{
  list(
    anocracy_years = sum(between(polity2, -5, 5), na.rm = T),
    democracy_years = sum(polity2 > 5, na.rm = T),
    autocracy_years = sum(polity2 < -5, na.rm = T),
    civ_war_denom = sum(!is.na(civwar)),
    n_civil_war_years = sum(civwar > 0, na.rm = T),
    avg_polity2 = mean(polity2, na.rm = T),
    max_polity2 = max(polity2, na.rm = T),
    min_polity2 = min(polity2, na.rm = T),
    transition_periods = sum(is.na(polity2)),
    n_coup_attempts = sum(atcoup2, na.rm = T),
    n_successful_coups = sum(scoup1, na.rm = T)
  )
}, by = list(country)]

polity_income_years = c(1850, 1900, seq(1950, 2010, by = 10), 2015)
wide_income_polity_stats =
  historical_gdp_stats_growth %>% filter(year %in% polity_income_years) %>%
  select(-polity) %>%
  rename(income = rgdpnapc_interpolated, polity = polity2) %>%
  pivot_wider(id_cols = c('country'),
            values_from = c('polity', 'income', 'pop'), names_from = 'year', values_fn = mean)

stats_by_country = left_join(
  stats_by_country,
  wide_income_polity_stats
) %>%
  dplyr::mutate(
    pct_civil_war_years = n_civil_war_years / civ_war_denom,
    percent_democracy_years = democracy_years / (anocracy_years + democracy_years + autocracy_years),
    coup_war_score = (n_civil_war_years > 0) + (n_coup_attempts > 0 | n_successful_coups > 0),
    growth_1850_2015 = get_period_growth(income_1850, income_2015, 2015 - 1850 + 1),
    growth_1900_2015 = get_period_growth(income_1900, income_2015, 2015 - 1900 + 1),
    growth_1950_2015 = get_period_growth(income_1950, income_2015, 2015 - 1950 + 1),
    percentile_1900 = cume_dist(income_1900),
    percentile_2015 = cume_dist(income_2015)
  )

stats_by_year = group_by(historical_gdp_stats_growth, year) %>%
  summarize(
    annual_income_95 = quantile(rgdpnapc, probs = 0.95, na.rm = T),
    annual_income_max = max(rgdpnapc, na.rm = T),
    annual_income_median = quantile(rgdpnapc, probs = 0.5, na.rm = T),
    avg_world_gdp_growth = mean(real_gdp_cap_growth, na.rm = T)
  )

historical_gdp_stats_growth_fin = left_join(
  historical_gdp_stats_growth,
  stats_by_country
) %>%
  left_join(
    stats_by_year
  ) %>%
  left_join(
    historical_gdp_stats_growth_rollstats
  ) %>%
  mutate(
    percent_of_max_income = rgdpnapc_interpolated / annual_income_max,
    had_attempted_coup = atcoup2 > 0,
    had_successful_coup = scoup1 > 0,
    civwar_factor = factor(civwar),
    log_lag_10_rgdpnapc_interpolated = log(lag_10_rgdpnapc_interpolated),
    log_rgdpnapc_interpolated = log(rgdpnapc_interpolated),
    percent_polity_changes_20 = n_polity_changes_last_20_years / 20
  )

##### quick model for per capita gdp ####

filter(historical_gdp_stats_growth_fin, country == 'Argentina', between(year, 1940, 1980)) %>% select(year, scoup1, atcoup2 )

names(historical_gdp_stats_growth_fin)

full_mod = lm(log_rgdpnapc_interpolated ~ log_lag_10_rgdpnapc_interpolated + avg_world_gdp_growth + lag_5_roll_5_real_gdp_cap_growth_interp +
                percent_of_max_income + year + polity2 + had_attempted_coup +
                civwar_factor + had_successful_coup + percent_polity_changes_20,
             data = historical_gdp_stats_growth_fin)
summary(full_mod)
plot(full_mod)

polity_with_coups_wars = lm(log_rgdpnapc_interpolated ~ log_lag_10_rgdpnapc_interpolated + percent_of_max_income * polity2 +
                              had_attempted_coup + had_successful_coup + I(civwar > 0) +
                              lag_5_roll_5_real_gdp_cap_growth_interp + avg_world_gdp_growth + year,
                     data = historical_gdp_stats_growth_fin %>% filter(year <= 2005))

summary(polity_with_coups_wars)

pure_polity_mod = lm(log_rgdpnapc_interpolated ~ log_lag_10_rgdpnapc_interpolated + percent_of_max_income + polity_desc*polity2 + percent_polity_changes_20 +
                       lag_5_roll_5_real_gdp_cap_growth_interp + avg_world_gdp_growth + year,
                     data = historical_gdp_stats_growth_fin %>% filter(year <= 2005))

summary(pure_polity_mod)

predict(pure_polity_mod, newdata = overall_means %>%
          mutate(
            log_lag_10_rgdpnapc_interpolated = log(6211.999),
            avg_world_gdp_growth = 0.015,
            year = 2015,
            lagged_mean_real_gdp_cap_growth_interp_10 = 0.06,
            polity2 = -7
            )
        ) %>% exp()

anova(pure_polity_mod, polity_desc_mod)

roll_mod = lm(log(rgdpnapc) ~ log(lag_10_rgdpnapc) + avg_world_gdp_growth + I(rgdpnapc / annual_income_max) + year + polity2 +
                I(n_coup_attempts_last_10_years > 0) + I(n_civil_war_years_last_10_years > 0) + I(n_coups_last_10_years > 0),
             data = historical_gdp_stats_growth_fin)

levels(historical_gdp_stats_growth_fin$polity_desc)
historical_gdp_stats_growth_fin$predicted_income_polity_mod = predict(pure_polity_mod,
                                                                      newdata = historical_gdp_stats_growth_fin %>%
                                                                        mutate(
                                                                          # polity2 = ifelse(country == 'Argentina', 10, polity2),
                                                                          # polity_desc = ifelse(country == 'Argentina', levels(historical_gdp_stats_growth_fin$polity_desc)[3], polity_desc),
                                                                          # polity_desc = factor(polity_desc)
                                                                        )
                                                                      )

ggplot(historical_gdp_stats_growth_fin, aes(predicted_income_polity_mod %>% exp(), rgdpnapc)) +
  facet_wrap(~year <= 2005) +
  geom_point()

historical_gdp_stats_growth_fin %>% filter(country %in% c('Argentina', 'United States', 'Botswana', 'Japan', 'South Korea'), year > 1850) %>%
ggplot(aes(year)) +
  geom_line(aes(y = predicted_income_full_mod %>% exp(), colour = country), linetype = 'dashed') +
  geom_line(aes(y = rgdpnapc, colour = country))

historical_gdp_stats_growth_fin %>% filter(country %in% c('Argentina', 'United States', 'Botswana', 'Japan', 'South Korea', 'China'), year > 1850) %>%
  ggplot(aes(year)) +
  facet_wrap(~country) +
  geom_line(aes(y = predicted_income_polity_mod %>% exp(), colour = country), linetype = 'dashed') +
  geom_line(aes(y = rgdpnapc_interpolated, colour = country))
filter(historical_gdp_stats_growth_fin, country == 'China') %>% View()

filter(historical_gdp_stats_growth, country %in% c('United States', 'United Kingdom', 'Argentina'), between(year, 1890, 1900) | between(year, 1930, 1940)) %>%
  select(country, year, rgdpnapc) %>% pivot_wider(names_from = "country", values_from = 'rgdpnapc') %>% View()

setwd('output')

##### US vs. Argentina growth, polity #####

us_argentine_comparison = filter(historical_gdp_stats_growth %>% filter(between(year, 1850, 2015)), country %in% c('United States', 'Argentina'), !is.na(rgdpnapc)) %>%
  mutate(label = ifelse(year == max(year), country, NA))

argentina_greater_us = us_argentine_comparison %>%
  select(country, year, rgdpnapc) %>%
  pivot_wider(id_cols = c('country', 'year'), values_from  = 'rgdpnapc', names_from = 'country') %>%
  filter(Argentina > `United States`)

argentina_rect = data.frame(
  xmin = min(argentina_greater_us$year),
  xmax = max(argentina_greater_us$year)
)

argentine_coups_regime_changes = filter(us_argentine_comparison, n_coups > 0 | autocratic_shift ) %>%
  as.data.frame() %>%
  mutate(
    label = ifelse(scoup1 > 0, "Success", ifelse(n_coups > 0, "Failure", NA)),
    coup_label = ifelse(scoup1 > 0, "Coup", ifelse(n_coups > 0, "Attempted Coup", NA)),
    coup_label = ifelse(scoup1 > 1, 'Multiple\nSuccessful Coups', coup_label)
    )

argentina_rects = tribble(
  ~xmin, ~xmax,
  min(argentina_greater_us$year), max(argentina_greater_us$year),
  min(argentine_coups_regime_changes$year), max(argentine_coups_regime_changes$year)
)

n_coups = filter(argentine_coups_regime_changes, n_coups > 0) %>% pull(n_coups) %>% sum()
n_successful_coups = filter(argentine_coups_regime_changes, n_coups > 0) %>% pull(scoup1) %>% sum()
n_autocratic_shifts = filter(argentine_coups_regime_changes, autocratic_shift) %>% nrow()

#
# anim =
#   growth_comparison_dat %>% filter(days_since_case_100 >=0) %>%
#   ggplot(aes(days_since_case_100, value, colour = country_region)) +
#   geom_line(size = 1) +
#   geom_point(size = 2) +
#   transition_reveal(days_since_case_100) +
#   coord_cartesian(clip = 'off') +
#   labs(
#     title = paste0('COVID-19 Cases by Day, Through ', format(max(growth_comparison_dat$date_upd), '%B %d')),
#     y = 'Case Count\n',
#     x = '\nDays Since Case 100',
#     subtitle = 'Diverging paths illustrate the varied effectiveness of public health responses.',
#     caption = 'Chart: Taylor G. White\nData: Johns Hopkins CSSE') +
#   theme_minimal() +
#   scale_y_continuous(labels = comma) +
#   scale_x_continuous(breaks = seq(0, 60, by = 10)) +
#   theme(
#     plot.caption = element_text(size = 10, hjust = 0),
#     legend.position = 'bottom'
#   ) +
#   theme(plot.margin = margin(5.5, 10, 5.5, 5.5), plot.subtitle = element_text(size=11, face = 'italic')) +
#   scale_colour_hue(name = 'Country', labels = c('Korea, South' = 'South Korea')) +
#   geom_segment(aes(xend = max(days_since_case_100) + 1, yend = value, group = country_region), linetype = 2, colour = 'grey') +
#   geom_point(size = 2) +
#   geom_text_repel(aes(x = max(days_since_case_100) + 1, label = comma(value)), hjust = 0, size = 3,
#                   vjust = -0.5,
#                   show.legend = F) +
#   geom_text_repel(data = key_dates, aes(x =days_since_case_100, y = c(60000, 70000, 80000), label = action), hjust = 0, size = 3,
#                   vjust = -0.5,
#                   show.legend = F) +
#   geom_vline(data = key_dates,
#              aes(xintercept = days_since_case_100, colour = country_region), size = 0.5, linetype = 'dashed', show.legend = F)
#
# animate(anim, nframes = 300,
#         renderer = gifski_renderer("output/covid_case_growth_comparison.gif"),
#         height = 6, width = 6, units = 'in',  type = 'cairo-png', res = 200)

argentina_rects_anim = tibble(
  year = argentina_rects[2,]$xmin:argentina_rects[2,]$xmax %>% as.numeric(),
  start_year = argentina_rects[2,]$xmin
)

animated_us_argentina = us_argentine_comparison %>%
  ggplot(aes(group = country)) +
  theme_bw() +
  transition_reveal(year) +
  geom_rect(data = argentina_rects_anim, aes(xmin = min(year), xmax = year, ymin = 0, group = seq_along(year),
                                             ymax = 55000), fill = 'gray90') +
  geom_line(aes(year, rgdpnapc)) +
  geom_text(data = argentina_greater_us, aes(x = year, y = Argentina * 2, label = "Argentina's income briefly passes the U.S.", group = NA)) +
  geom_text(data = argentina_rects_anim, aes(x = mean(argentina_rects_anim$year), y = 55000, label = sprintf("Argentina:\n%s autocratic shifts, %s coups d'etat (%s attempted)", n_autocratic_shifts, n_successful_coups, n_coups), group = seq_along(year))) +

  geom_segment(data = argentina_greater_us, aes(x = year, xend = year, y = Argentina, yend = Argentina * 2, group = NA)) +

  # geom_point(data = argentine_coups_regime_changes %>% filter(!is.na(label)), aes(year, rgdpnapc, shape = label), size = 4) +
  geom_point(aes(year, rgdpnapc, colour = polity_desc, group = seq_along(year)), size = 1.5) +

  scale_shape_manual(name = "Coups d'Etat",values = c("Success" = 8, "Failure" = 5)) +
  # facet_zoom(xlim = c(1890, 1910), ylim = c(3000, 7000), horizontal = FALSE) +
  scale_alpha(guide = F) +
  scale_colour_manual(name = "Type of Government", values = c('Autocracy' = '#e61938', 'Anocracy (mixed)' = 'darkgray', 'Democracy' = '#0045a1')) +
  guides(colour = guide_legend(override.aes = list(size = 5))) +
  # annotate('text', x = mean(argentina_greater_us$year), y = 55000, label = "Argentina's income surpasses U.S., 1894-1896", angle = 0, vjust = -0.5) +
  # annotate('text', x = mean(argentine_coups_regime_changes$year), y = 55000, label = sprintf("%s autocratic shifts, %s coups d'etat (%s attempted)", n_autocratic_shifts, n_successful_coups, n_coups), angle = 0, vjust = -0.5) +
  # scale_colour_gradient2(name = 'Polity V Score\n>0 is Democratic',low = '#e61938', high = '#0045a1', mid = 'gray', midpoint = 0) +
  # scale_colour_hue(name = 'Democratic', labels = c('TRUE' = 'Yes', 'FALSE' = 'No')) +
  geom_label_repel(aes(year, rgdpnapc, label = country), nudge_x = 1, na.rm = T, nudge_y = 3) +
  scale_y_continuous(labels = dollar, breaks = seq(0, 50000, by = 10000)) +
  scale_x_continuous(breaks = seq(1850, 2015, by = 10)) +
  labs(
    y = 'Real GDP Per Capita (2011 USD)\n', x = '',
    title = 'Democracy and Economic Prosperity',
    subtitle = 'Comparing divergent political and economic paths of the U.S. and Argentina',
    caption = 'Chart: Taylor G. White (@t_g_white)\nData: Polity Project, Maddison Project'
  ) +
  theme_minimal() +
  theme(
    legend.background = element_rect(fill = 'white'),
    legend.position = c(0.15, 0.9),
    axis.text = element_text(size = 11),
    axis.title = element_text(size = 14),
    plot.subtitle = element_text(size = 15),
    legend.text = element_text(size = 9),
    legend.title = element_text(size = 10),
    plot.caption = element_text(size = 11, face = 'italic', hjust = 0),
    title = element_text(size = 18)
  )
#
# animate(animated_us_argentina, nframes = 200,
#         renderer = gifski_renderer("argentina_vs_us_income_comparison.gif"),
#         height = 8, width = 8, units = 'in',  type = 'cairo-png', res = 150, start_pause = 4, end_pause = 20)
#

argentina_stats = filter(stats_by_country, country == 'Argentina') %>% as.data.frame()

dollar_label_func = function(x) {
  dollar(round(x, 0))
}
ggplot(stats_by_country, aes(income_1900, income_2015)) +
  theme_bw() +
  # geom_vline(aes(xintercept = ifelse(country == 'Argentina', income_1900, NA)), na.rm = T, linetype = 'dashed') +
  # geom_hline(aes(yintercept = ifelse(country == 'Argentina', income_2015, NA)), na.rm = T, linetype = 'dashed') +
  geom_segment(data = argentina_stats, aes(x = income_1900, xend = 8000, y = income_2015, yend = 15000), colour = 'orange') +
  geom_label(data = argentina_stats, aes(x = 8000, y = 15000,
                                         label = sprintf("Argentina's Income was in the %sth percentile in 1900, but fell to the %sth percentile by 2015.",
                                                         round(percentile_1900*100), round(percentile_2015 * 100)) %>% str_wrap(32)
                                         )) +

# annotate('text', x = 8000, y = 15000, label = sprintf("Argentina's Income was in the %sth percentile in 1900", round(argentina_stats$percentile_1900*100)) %>% str_wrap(32)) +

  # geom_segment(aes(x = 0, xend = ifelse(country == 'Argentina', income_1900, NA), y = ifelse(country == 'Argentina', income_2015, NA), yend = ifelse(country == 'Argentina', income_2015, NA)), na.rm = T, linetype = 'dashed') +
  # geom_segment(aes(y = 0, yend = ifelse(country == 'Argentina', income_2015, NA), x = ifelse(country == 'Argentina', income_1900, NA), xend = ifelse(country == 'Argentina', income_1900, NA)), na.rm = T, linetype = 'dashed') +
  labs(
    x = 'Log Real Per Capita GDP in 1900\n(2011 USD)',
    y = 'Log Real Per Capita GDP in 2015\n(2011 USD)',
    title = 'Per Capita Income in 1900 vs. 2015'
  ) +

  # geom_label_repel(aes(label = ifelse(country %in% c('Argentina', 'United States'), country, NA)), na.rm = T) +
  scale_x_continuous(labels = dollar_label_func, trans = 'log') +
  scale_y_continuous(labels = dollar_label_func, trans = 'log') +
  stat_smooth(method = 'lm', se = F) +
  geom_point()

us_argentine_comparison %>%
  ggplot() +
  theme_bw() +
  # annotation_custom(grob = ggplotGrob(historical_income_plot), xmin = 1850, xmax = 1900, ymin = 20e3, ymax = 55e3) +
  geom_label_repel(aes(year, rgdpnapc, label = label), nudge_x = 1, na.rm = T, nudge_y = 3e3, segment.colour = 'orange') +
  geom_rect(data = argentina_rects[2,], aes(xmin = xmin, xmax = xmax, ymin = 0,
                                        ymax = 55000), alpha = 0.25, fill = 'gray90', colour = 'black', linetype = 'dashed') +
  geom_text_repel(data = argentina_greater_us %>% head(1), aes(x = year, y = Argentina), label = "Argentina's income\nbriefly surpassed the U.S.", nudge_y = 10e3) +
  geom_line(aes(year, rgdpnapc, group = country)) +
  # geom_point(data = argentine_coups_regime_changes %>% filter(!is.na(label)), aes(year, rgdpnapc, shape = label), size = 4) +
  geom_text_repel(data = argentine_coups_regime_changes %>% filter(scoup1 > 0), aes(year, rgdpnapc, label = coup_label),
                  size = 3, segment.colour = 'orange', nudge_y = -4e3) +
  geom_point(aes(year, rgdpnapc, colour = polity_desc), size = 1.5) +

  scale_shape_manual(name = "Coups d'Etat",values = c("Success" = 8, "Failure" = 5)) +
  # facet_zoom(xlim = c(1890, 1910), ylim = c(3000, 7000), horizontal = FALSE) +
  scale_alpha(guide = F) +
  scale_colour_manual(name = "Type of Government", values = c('Autocracy' = '#e61938', 'Anocracy (mixed)' = 'gray', 'Democracy' = '#0045a1')) +
  # annotate('text', x = mean(argentina_greater_us$year), y = 55000, label = "Argentina's income surpasses U.S., 1894-1896", angle = 0, vjust = -0.5) +
  annotate('text', x = mean(argentine_coups_regime_changes$year), y = 55000, label = sprintf("%s autocratic shifts, %s coups d'etat (%s attempted)", n_autocratic_shifts, n_successful_coups, n_coups), angle = 0, vjust = -0.5) +
  # scale_colour_gradient2(name = 'Polity V Score\n>0 is Democratic',low = '#e61938', high = '#0045a1', mid = 'gray', midpoint = 0) +
  # scale_colour_hue(name = 'Democratic', labels = c('TRUE' = 'Yes', 'FALSE' = 'No')) +
  scale_y_continuous(labels = dollar, breaks = seq(0, 50000, by = 10000)) +
  scale_x_continuous(breaks = seq(1850, 2015, by = 10)) +
  labs(
    y = 'Real GDP Per Capita (2011 USD)\n', x = '',
    title = 'Political Power and Stability vs. Economic Prosperity',
    subtitle = 'Comparing divergent political and economic paths of the U.S. and Argentina, 1850-2015',
    caption = 'Chart: Taylor G. White (@t_g_white)\nData: Polity Project, Maddison Project'
  ) +
  theme_minimal() +
  theme(
    # legend.background = element_rect(fill = 'white'),
    # legend.position = c(0.10, 0.90),
    legend.position = 'bottom',
    axis.text = element_text(size = 12),
    axis.title = element_text(size = 16),
    plot.subtitle = element_text(size = 18),
    legend.text = element_text(size = 11),
    legend.title = element_text(size = 12),
    plot.caption = element_text(size = 13, face = 'italic', hjust = 0),
    title = element_text(size = 26)
  )
ggsave('us vs argentina paths.png', height = 9, width = 12, units = 'in', dpi = 600)

##### South Korea vs North Korea #####
filter(historical_gdp_stats_growth %>% filter(between(year, 1950, 2015)), country %in% c('South Korea', 'North Korea'), !is.na(rgdpnapc)) %>%
  mutate(label = ifelse(year == max(year), country, NA)) %>%
  ggplot(aes(year, rgdpnapc)) +
  theme_bw() +
  geom_line(aes(group = country)) +
  geom_point(aes(colour = polity_desc), size = 1.5) +
  scale_alpha(guide = F) +
  scale_colour_manual(name = "Type of Government", values = c('Autocracy' = '#e61938', 'Anocracy (mixed)' = 'gray', 'Democracy' = '#0045a1')) +
  # scale_colour_gradient2(name = 'Polity V Score\n>0 is Democratic',low = '#e61938', high = '#0045a1', mid = 'gray', midpoint = 0) +
  # scale_colour_hue(name = 'Democratic', labels = c('TRUE' = 'Yes', 'FALSE' = 'No')) +
  geom_label_repel(aes(label = label), nudge_x = 1, na.rm = T, nudge_y = 2) +
  scale_y_continuous(labels = dollar) +
  scale_x_continuous(breaks = seq(1950, 2015, by = 5)) +
  labs(
    y = 'Real GDP Per Capita (2011 USD)\n', x = '',
    title = 'Political Power and Stability vs. Economic Prosperity',
    subtitle = 'Comparing diverging political and economic paths of North and South Korea, 1950-2015',
    caption = 'Chart: Taylor G. White\nData: Polity Project, Maddison Project'
  ) +
  theme_minimal() +
  theme(
    legend.background = element_rect(fill = 'white'),
    legend.position = c(0.10, 0.875),
    axis.text = element_text(size = 12),
    axis.title = element_text(size = 16),
    plot.subtitle = element_text(size = 18),
    legend.text = element_text(size = 11),
    legend.title = element_text(size = 12),
    plot.caption = element_text(size = 13, face = 'italic', hjust = 0),
    title = element_text(size = 26)
  )
ggsave('north vs. south korea paths.png', height = 9, width = 12, units = 'in', dpi = 600)

##### USA vs USSR #####

##### South Korea vs North Korea #####
filter(historical_gdp_stats_growth %>% filter(between(year, 1850, 2015)), country %in% c('USSR', 'Russia', 'United States'), !is.na(rgdpnapc)) %>%
  mutate(label = ifelse(year == max(year), country, NA)) %>%
  ggplot(aes(year, rgdpnapc)) +
  theme_bw() +
  geom_line(aes(group = country)) +
  geom_point(aes(colour = polity_desc), size = 1.5) +
  scale_alpha(guide = F) +
  scale_colour_manual(name = "Type of Government", values = c('Autocracy' = '#e61938', 'Anocracy (mixed)' = 'gray', 'Democracy' = '#0045a1')) +
  # scale_colour_gradient2(name = 'Polity V Score\n>0 is Democratic',low = '#e61938', high = '#0045a1', mid = 'gray', midpoint = 0) +
  # scale_colour_hue(name = 'Democratic', labels = c('TRUE' = 'Yes', 'FALSE' = 'No')) +
  geom_label_repel(aes(label = label), nudge_x = 1, na.rm = T, nudge_y = 3) +
  scale_y_continuous(labels = dollar) +
  scale_x_continuous(breaks = seq(1850, 2015, by = 10)) +
  labs(
    y = 'Real GDP Per Capita (2011 USD)\n', x = '',
    title = 'Political Power and Stability vs. Economic Prosperity',
    subtitle = 'Comparing divergent political and economic paths of the U.S. and Russia/USSR, 1850-2015',
    caption = 'Chart: Taylor G. White\nData: Polity Project, Maddison Project'
  ) +
  theme_minimal() +
  theme(
    legend.background = element_rect(fill = 'white'),
    legend.position = c(0.10, 0.875),
    axis.text = element_text(size = 12),
    axis.title = element_text(size = 16),
    plot.subtitle = element_text(size = 18),
    legend.text = element_text(size = 11),
    legend.title = element_text(size = 12),
    plot.caption = element_text(size = 13, face = 'italic', hjust = 0),
    title = element_text(size = 26)
  )
ggsave('russia+ussr versus US.png', height = 9, width = 12, units = 'in', dpi = 600)

##### UK versus Australia #####
filter(historical_gdp_stats_growth %>% filter(between(year, 1850, 2015)), country %in% c('Australia', 'United Kingdom'), !is.na(rgdpnapc)) %>%
  mutate(label = ifelse(year == max(year), country, NA)) %>%
  ggplot(aes(year, rgdpnapc)) +
  theme_bw() +
  geom_line(aes(colour = country)) +
  geom_point(aes(size = polity2, shape = polity_desc, colour = country)) +
  scale_size(range = c(0, 2.55)) +
  # scale_alpha(guide = F) +
  # scale_colour_manual(name = "Type of Government", values = c('Autocracy' = '#e61938', 'Anocracy (mixed)' = 'gray', 'Democracy' = '#0045a1')) +
  # scale_colour_gradient2(name = 'Polity V Score\n>0 is Democratic',low = '#e61938', high = '#0045a1', mid = 'gray', midpoint = 0) +
  # scale_colour_hue(name = 'Democratic', labels = c('TRUE' = 'Yes', 'FALSE' = 'No')) +
  geom_label_repel(aes(label = label), nudge_x = 1, na.rm = T, nudge_y = 3) +
  scale_y_continuous(labels = dollar) +
  scale_x_continuous(breaks = seq(1850, 2015, by = 10)) +
  labs(
    y = 'Real GDP Per Capita (2011 USD)\n', x = '',
    title = 'Political Power and Stability vs. Economic Prosperity',
    subtitle = 'Comparing divergent political and economic paths of the U.S. and Russia/USSR, 1850-2015',
    caption = 'Chart: Taylor G. White\nData: Polity Project, Maddison Project'
  ) +
  theme_minimal() +
  theme(
    legend.background = element_rect(fill = 'white'),
    legend.position = c(0.10, 0.875),
    axis.text = element_text(size = 12),
    axis.title = element_text(size = 16),
    plot.subtitle = element_text(size = 18),
    legend.text = element_text(size = 11),
    legend.title = element_text(size = 12),
    plot.caption = element_text(size = 13, face = 'italic', hjust = 0),
    title = element_text(size = 26)
  )
ggsave('russia+ussr versus US.png', height = 9, width = 12, units = 'in', dpi = 600)

##### median income by polity type #####

filter(historical_gdp_stats_growth, is.na(polity_desc)) %>% select(country, year, polity2, interim, prior, regtrans) %>% filter(year > 1800) %>%View()
growth_by_polity_type = group_by(historical_gdp_stats_growth, year, polity_desc) %>%
  filter(year >= 1800) %>%
  summarize(
    countries_with_coups = n_distinct(country[n_coups > 0]),
    median_rgdpnapc = median(rgdpnapc, na.rm = T),
    median_growth = median(real_gdp_cap_growth, na.rm = T),
    obs = length(!is.na(rgdpnapc))
  )

ggplot(growth_by_polity_type, aes(year, median_rgdpnapc )) +
  geom_line(aes(colour = polity_desc)) +
  geom_point(aes(colour = polity_desc, alpha = obs, size = obs))

top_incomes_by_year = group_by(year) %>%
  top_n(20, rgdpnapc)

top_n(historical_gdp_stats_growth, 10, rgdpnapc)

historical_gdp_stats_growth %>% filter(year >= 1800, pop >= 1000) %>%
ggplot(aes(factor(cyl), mpg)) +
  geom_boxplot() +
  # Here comes the gganimate code
  transition_states(
    gear,
    transition_length = 2,
    state_length = 1
  ) +
  enter_fade() +
  exit_shrink() +
  ease_aes('sine-in-out')

##### global trends, democracy and growth #####

annual_gdp_cap_leaders = group_by(historical_gdp_stats_growth, year) %>%
  summarize(
    polity_median = median(polity2, na.rm = T),
    polity_90th_percentile = quantile(polity2, probs = 0.9, na.rm = T),
    annual_income_25th_percentile = quantile(cgdppc, probs = 0.25, na.rm = T),
    annual_income_median = quantile(cgdppc, probs = 0.5, na.rm = T),
    annual_income_75th_percentile = quantile(cgdppc, probs = 0.75, na.rm = T),
    annual_income_90th_percentile = quantile(cgdppc, probs = 0.9, na.rm = T)
  ) %>%
  mutate(
    top_median_ratio = annual_income_90th_percentile / annual_income_median
  )

ggplot(annual_gdp_cap_leaders, aes(polity_median, log(annual_income_median))) +
  geom_point() +
  stat_smooth(method = 'lm')

ggplot(annual_gdp_cap_leaders, aes(polity_90th_percentile, log(annual_income_90th_percentile))) +
  geom_point() +
  stat_smooth(method = 'lm')

ggplot(annual_gdp_cap_leaders, aes(year, top_median_ratio)) +
  geom_bar(stat = 'identity')

annual_gdp_cap_leaders %>%
  pivot_longer(cols = c('annual_income_90th_percentile', 'annual_income_median', 'annual_income_75th_percentile', 'annual_income_25th_percentile')) %>%
  ggplot(aes(year, colour = name)) +
  geom_line(
    aes(y = value)
  ) +
  scale_colour_brewer(palette = 'Set1', labels = c('annual_income_90th_percentile' = '90%', 'annual_income_median' = '50%', 'annual_income_75th_percentile' = '75%',
                                                   'annual_income_25th_percentile' = '25%')                      )

ggplot(annual_gdp_cap_leaders, aes(year)) +
  geom_line(
    aes(y = polity_90th_percentile)
  ) +
  geom_line(
    aes(y = polity_median), colour = 'blue'
  ) +
  geom_vline(aes(xintercept = 1989))

group_by(historical_gdp_stats_growth %>% filter(year >= 1800), country) %>%
  summarize(
    obs = n(),
    mean_real_gdp_cap_growth = mean(real_gdp_cap_growth, na.rm = T),
    sd_read_gdp_growth = sd(real_gdp_cap_growth, na.rm = T),
    n_recessions = sum(real_gdp_cap_growth < 0, na.rm = T)
  ) %>%
  View()

table(historical_gdp_stats$country)
us = filter(historical_gdp_stats_growth, country %in% c('Argentina', 'United States', 'United Kingdom', 'Botswana', 'South Africa', 'Japan', 'Germany', 'West Germany'))
ggplot(us %>% filter(between(year, 1800, 2016)), aes(year, rgdpnapc)) +
  facet_wrap(~country) +
  geom_point(aes(colour = polity2 > 0))
table(historical_gdp_stats_growth$country)

##### coups, civil wars, and population/income impacts #####

##### how likely are coups to cluster in time? #####

# for each year with a coup, find how many coups preceded and followed?
e = exp(1)
ggplot(stats_by_country, aes(income_1850, income_2015, size = pop_2015)) +
  geom_point(aes(colour = factor(coup_war_score))) +
  scale_y_continuous(labels = dollar) +
  scale_x_continuous(labels = dollar) +
  stat_smooth( se = F, span = 1)
  # scale_y_continuous(trans = log_trans(),
  #                    # labels = dollar,
  #                         breaks = trans_breaks("log", function(x) e^x),
  #                         labels = trans_format("log", math_format(e^.x))) +
  # scale_x_continuous(trans = log_trans(),
  #                    # labels = dollar,
  #                    breaks = trans_breaks("log", function(x) e^x),
  #                    labels = trans_format("log", math_format(e)))

ggplot(stats_by_country, aes(pop_avg_growth, period_avg_growth )) +
  geom_point()

names(stats_by_country)
ggplot(stats_by_country, aes(income_1850, income_2015)) +
  geom_point(aes(fill = percent_democracy_years ), pch = 21, size = 5) +
  scale_fill_viridis_c()

ggplot(stats_by_country, aes(income_1850, income_2015)) +
  geom_point(aes(fill = avg_polity2  ), pch = 21, size = 5) +
  geom_text_repel(aes(label = country)) +
  # scale_fill_gradient2(low = 'red', mid = 'gray', high= 'blue', midpoint = 5) +
  scale_fill_viridis_c(option = 'A') +
    scale_colour_viridis_c()

filter(stats_by_country, !is.na(income_1900) & !is.na(income_2015)) %>%
  ungroup() %>%
  summarize(
    the_cor = cor(income_1900, income_2015),
    log_cor = cor(log(income_1900), log(income_2015))
  )

cor(stats_by_country$income_1900, stats_by_country$income_2015)

names(historical_gdp_stats_growth)

names(stats_by_country)

filter(stats_by_country, coup_war_score > 0)
simple_growth_model = lm(real_gdp_cap_growth ~ year + autocratic_shift + polity_desc + lagged_real_gdp_cap_growth, data = historical_gdp_stats_growth)
summary(simple_growth_model)

ggplot(historical_gdp_stats_growth, aes(lagged_real_gdp_cap_growth, real_gdp_cap_growth, colour = year > 1965)) +
  geom_point(alpha = 0.5) + stat_smooth(se = F, method = 'lm') +
  facet_wrap(~year > 1965)

ggplot(historical_gdp_stats_growth, aes(lagged_real_gdp_cap_growth, real_gdp_cap_growth)) +
  geom_point(alpha = 0.5, aes(colour = polity2)) +
  scale_colour_gradient2(low = 'red', mid = 'gray', high= 'blue', midpoint = 5) +
  stat_smooth(se = F, method = 'lm') +
  facet_wrap(~year > 1975)

historical_gdp_stats_growth$polity2

##### map coups, civil wars #####

polity_income_vars = expand.grid(
  var = c('income', 'polity', 'pop'),
  year = c(seq(1960, 2010, by = 10), 2015)
) %>%
  arrange(var, year) %>%
  mutate(
    var_combo = paste(var, year, sep = '_')
  )
stats_by_country$pop_1960

stats_by_country_long = pivot_longer(
  stats_by_country %>% as.data.frame(),
  cols = polity_income_vars$var_combo, names_to = 'variable', values_to = 'value'
)

stats_by_country_map = left_join(world_map, stats_by_country, by = c('name' = 'country'))
ggplot(stats_by_country_map) +
  geom_sf(aes(fill = n_civil_war_years > 0)) +
  geom_sf_label(aes(label = ifelse(is.na(n_civil_war_years), name, NA)), na.rm = T) +
  scale_fill_viridis_d()
names(stats_by_country_map)
ggplot(stats_by_country_map) +
  geom_sf(aes(fill = n_coup_attempts + n_successful_coups + n_civil_war_years > 0)) +
  # geom_sf_label(aes(label = ifelse(is.na(n_civil_war_years), name, NA)), na.rm = T) +
  scale_fill_viridis_d()

ggplot(stats_by_country_map) +
  geom_sf(aes(fill = income_2015 %>% log())) +
  # geom_sf_label(aes(label = ifelse(is.na(n_civil_war_years), name, NA)), na.rm = T) +
  scale_fill_viridis_c()

stats_by_country_map_long = left_join(world_map, stats_by_country_long, by = c('name' = 'country'))

filter(stats_by_country_map_long %>% filter(str_detect(variable, 'income')), continent == 'Africa') %>%
  ggplot() +
  facet_wrap(~str_replace(variable, '_', " ") %>% str_to_title()) +
  geom_sf(aes(fill = value)) +
  scale_fill_viridis_c()

filter(stats_by_country_map_long %>% filter(str_detect(variable, 'polity')), continent == 'Africa') %>%
  ggplot() +
  facet_wrap(~str_replace(variable, '_', " ") %>% str_to_title()) +
  geom_sf(aes(fill = value)) +
  scale_fill_gradient2(low = 'red', high = 'blue', mid = 'gray', midpoint = 0)

maps_by_continent = lapply(unique(stats_by_country_map$continent), function(the_continent){
  # the_continent = 'North America'
  cont_sub = filter(stats_by_country_map, continent == the_continent)
  the_plot = ggplot(cont_sub) +
    geom_sf(aes(fill = avg_polity2)) +
    scale_fill_viridis_c() +
    geom_sf_label(aes(label = ifelse(is.na(avg_polity2), name, NA)), na.rm = T)
  return(the_plot)
})
cowplot::plot_grid(plotlist = maps_by_continent)

View(polity_v_fin)
filter(polity_v_fin, country == 'Kazakhstan') %>% pull(polity2)
View(stats_by_country)


# Creating Data Frames
myDataFrame <- data.frame(foo = c(10, 20, 30, 40, 50), bar = c(T, F, T, F, T))
print(myDataFrame)
cat("Number of rows: ", nrow(myDataFrame), "\n")
cat("Number of colums: ", ncol(myDataFrame), "\n")

# Create name, address, phonenumber and gender variables
name <- c("Alex", "Brian", "Charles")
address <- c("California", "NewYork", "Boston")
phonenumber <- c(492092033, 123840334, 943903403)
gender <- c('F', 'M', 'M')

employeeDataFrame <- data.frame(name, address, phonenumber, gender)
print(employeeDataFrame)
# cat(employeeDataFrame) eror!!

# Accessing and manipulating data frames
employeeDataFrame[1,3]

# Accessing the second row
employeeDataFrame[2, ]

# Accessing the third column
employeeDataFrame[,3]

# Accessing name and phone numbers of employees
employeeDataFrame[, c('name', 'phonenumber')]

# Accessing names of employees using $
# <source>$<nameOfColumn>
employeeDataFrame$name
employeeDataFrame$phonenumber

# Merging two data frames
# Syntax of merge()

# merge(x, y, by.x, by.y, sort = TRUE)
# Here the parameters x and y are the two data frames that we want to merge
# by.x and by.y provide the specifications of the columns through which merging will take place
# sort parameter tells whether the result should be sorted on the specified column

name <- c("Alex", "Brian", "Charles")
address <- c("California", "NewYork", "Boston")
phonenumber <- c(492092033, 123840334, 943903403)
gender <- c('F', 'M', 'M')

employeeDataFrame <- data.frame(name, address, phonenumber, gender)

idNum <- c(11, 22, 33)
employeeCardNumber <- data.frame(name, idNum)

merge(employeeCardNumber, employeeDataFrame)

# Mergin two data frames with a column having same name
myKey <- c("Alphabet a", "Alphabet b", "Alphabet c")
smallLetter <- c("a", "b", "c")
smallAlphabet <- data.frame(myKey, smallLetter)

myNewKey <- c("Alphabet a", "Alphabet b", "Alphabet c")
capitalLetter <- c("A", "B", "C")
capitalAlphabet <- data.frame(myNewKey, capitalLetter)

merge(smallAlphabet, capitalAlphabet, by.x = "myKey", by.y = "myNewKey")


#! /usr/bin/env Rscript
library("scales")
library("ggplot2")
library("grid")
library("gridExtra")
ROOT = "/app"

genes<-list("gag", "gp41")

for (gene in genes) {
  # fileName2 = sprintf("%s/data/naiveStudies/%sStatBySeq.csv", ROOT, gene)
  # subtypes<-read.table(fileName2, sep=",", header=TRUE, as.is=TRUE)
  # subtypes = aggregate(cbind(NumSequences = subtypes$Accession) ~ Subtype, subtypes, FUN=length)
  # subtypes = subtypes[subtypes$NumSequences > 100,]
  # subtypes = subtypes[order(-subtypes$NumSequences),]
  # subtypes = subtypes$Subtype
  subtypes = c('A1', 'B', 'C', '01_AE')
  fileName = sprintf("%s/local/naiveStudies/%sNaiveDistance.csv", ROOT, gene)
  data<-read.table(fileName, sep=",", header=TRUE, as.is=TRUE)
  data$Sequence1 = sub("^[^|]+\\|", "", data$Sequence1, perl=TRUE)
  data$Sequence2 = sub("^[^|]+\\|", "", data$Sequence2, perl=TRUE)
  colnames(data) <- c("Subtype", "Subtype2", "Distance")
  filtered = data[data$Subtype %in% subtypes & data$Subtype2 %in% subtypes,]
  # aggs = aggregate(
  #   Distance ~ Subtype + Subtype2, filtered,
  #   FUN=function(x) sprintf("%.1f (%.1f-%.1f,%.1f-%.1f)", median(x) * 100, min(x) * 100, max(x) * 100, quantile(x, 1/4) * 100, quantile(x, 3/4) * 100)
  # )
  # aggs = dcast(aggs, Subtype ~ Subtype2)
  # fileName = sprintf("%s/local/%sNaiveDiversifyMatrix.csv", ROOT, gene)
  # write.csv(aggs, fileName, row.names=FALSE)

  x9999 = quantile(data$Distance, 0.9999)
  print(x9999)
  xmax = max(data$Distance) * 100
  xlimmax = ceiling(xmax / 5) * 5
  filtered = filtered[filtered$Subtype == filtered$Subtype2,]
  filtered$SubtypePair <- paste(filtered$Subtype, filtered$Subtype2, sep="-")
  plot = ggplot(data, aes(Distance * 100)) +
      geom_histogram(
        aes(y=(..count..)/sum(..count..)),
        binwidth=1, size=0.5) +
      # geom_vline(xintercept=xmax, linetype="dashed") +
      scale_y_continuous(labels=percent, breaks=pretty_breaks(4)) +
      ylab('% Sequence Pairs') + xlab('% Distance') + xlim(0, xlimmax) +
      ggtitle("M") +
      theme(
        plot.title = element_text(hjust=0.02, margin=margin(10, 0, -22, unit = "pt")),
        axis.title.x=element_blank(),
        axis.title.y=element_text(color="white"),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank())
  plots = list(plot)

  for (subtype in subtypes) {
      partial = filtered[filtered$Subtype == subtype & filtered$Subtype2 == subtype,]
      x9999 = quantile(partial$Distance, 0.9999)
      print(x9999)
      xmax = max(partial$Distance) * 100
      plot = ggplot(partial, aes(Distance * 100)) +
        geom_histogram(
          aes(y=(..count..)/sum(..count..)),
          binwidth=1, size=0.5) +
        # geom_vline(xintercept=xmax, linetype="dashed") +
        scale_y_continuous(labels=percent, breaks=pretty_breaks(4)) +
        ylab('% Sequence Pairs') + xlab('% Distance') + xlim(0, xlimmax) +
        ggtitle(subtype) + theme(plot.title = element_text(hjust=0.02, margin=margin(10, 0, -22, unit = "pt")))
      if (subtype != '01_AE') {
          plot = plot +
            theme(
              axis.title.x=element_blank(),
              axis.text.x=element_blank(),
              axis.ticks.x=element_blank())
      }
      if (subtype != 'B') {
          plot = plot + theme(axis.title.y=element_text(color="white"))
      }
      plots = append(plots, list(plot))
  }
  pdf(sprintf("%s/report/%s-naive-diversify.pdf", ROOT, tolower(gene)), width=6, height=8)
  ph = 457 / 300  # plot height
  bh = 115 / 300  # height of bottom x label
  grid.arrange(grobs=plots, nrow=length(plots), heights=unit(c(ph, ph, ph, ph, ph + bh), c('in', 'in', 'in', 'in', 'in')))
  dev.off()
}


# Matrix-eQTL Analysis (Adapted from http://www.bios.unc.edu/research/genomic_software/Matrix_eQTL/R.html#cis)
#
# Author: Jiamao Zheng (jiamaoz@yahoo.com) 02/18/2018
#
# Rscript run_matrix-eqtl.r
#
##

# install.packages('MatrixEQTL')
suppressWarnings(suppressMessages(library(MatrixEQTL)))

# setwd('~/Dropbox/Im_lab/2018/lab_session/HGEN47100Lab_2018-02-23/src/')

# arg variables
argv <- commandArgs(trailingOnly = TRUE)
pvalue <- as.numeric(argv[1])
if (length(argv) >1) {
  print('warning: the number of arguments should be less than 1')
  break
}

# choose model
print('choose modelLINEAR')
useModel = modelLINEAR

# set input file path
print('set input file path')
SNP_file_name = '../inputs/for_matrix-eqtl/geuvadis_genotype_data.txt'
snps_location_file_name = '../inputs/for_matrix-eqtl/geuvadis_snp_location_data.txt'
expression_file_name = '../inputs/for_matrix-eqtl/geuvadis_expression_data.txt'
gene_location_file_name = '../inputs/for_matrix-eqtl/geuvadis_mRNA_location_data.txt'
# covariates_file_name = character() # no covariates
# errorCovariance = numeric() # Error covariance matrix. Set to numeric() for identity.

# set output file path
print('set output file path')
output_file_name_cis = "../results/eqtls/geuvadis_cis-eQTL.txt"
output_file_name_tra = "../results/eqtls/geuvadis_trans_trans-eQTL.txt"

# only associations significant at this level will be saved
print('set pvalue cutoff')
if (length(argv) == 0) {
  pvOutputThreshold_cis = 1e-6;
  pvOutputThreshold_tra = 1e-6;
} else if (length(argv) == 1) {
  pvOutputThreshold_cis = pvalue;
  pvOutputThreshold_tra = pvalue;
}

# distance for local gene-SNP pairs
print('set distance for local gene-SNP pairs')
cisDist = 1e6;

# load genotype data
print('load genotype data')
snps = SlicedData$new()
snps$fileDelimiter = "\t"
snps$fileOmitCharacters = "NA"
snps$fileSkipRows = 1
snps$fileSkipColumns = 1
snps$fileSliceSize = 2000
snps$LoadFile(SNP_file_name )

# load gene expression data
print('load gene expression data')
gene = SlicedData$new()
gene$fileDelimiter = "\t"
gene$fileOmitCharacters = "NA"
gene$fileSkipRows = 1
gene$fileSkipColumns = 1
gene$fileSliceSize = 20
gene$LoadFile(expression_file_name )

# # load covariates
# cvrt = SlicedData$new()
# cvrt$fileDelimiter = "\t"
# cvrt$fileOmitCharacters = "NA"
# cvrt$fileSkipRows = 1
# cvrt$fileSkipColumns = 1
# cvrt$fileSliceSize = 10
# cvrt$LoadFile(covariates_file_name)

## Run the analysis
print('Run the analysis')
snpspos = read.table(snps_location_file_name, header = TRUE, stringsAsFactors = FALSE)
genepos = read.table(gene_location_file_name, header = TRUE, stringsAsFactors = FALSE)

me = Matrix_eQTL_main(
  snps = snps,
  gene = gene,
  # cvrt = cvrt,
  output_file_name = output_file_name_tra,
  pvOutputThreshold = pvOutputThreshold_tra,
  useModel = useModel,
  # errorCovariance = errorCovariance,
  verbose = TRUE,
  output_file_name.cis = output_file_name_cis,
  pvOutputThreshold.cis = pvOutputThreshold_cis,
  snpspos = snpspos,
  genepos = genepos,
  cisDist = cisDist,
  pvalue.hist = "qqplot",
  min.pv.by.genesnp = FALSE,
  noFDRsaveMemory = FALSE)

cat('Analysis done in: ', me$time.in.sec, ' seconds', '\n')

## Plot the Q-Q plot of local and distant p-values
print('plot the Q-Q plot of local and distant p-values')
png('../results/eqtls/gevadis_eQTL_QQ-plot.png')
plot(me, pch = 16, cex = 0.7)
print('Done!')
dev.off()


# Code to run nodiv on species range map data (site x sp matrix)
# Marisa Lim (c)2015

# load libraries
library(devtools)
install_github("mkborregaard/nodiv") #Gives the newest version - is probably LESS buggy than CRAN version
library(nodiv)
library(ape)
library(raster)
library(fields)
library(dplyr)
library(picante)

# load this for the gridData function
load('C:/Users/mcwlim/Desktop/Github/Hbird-diversity/P3_Diversi/nodiv-trait-analysis.RDATA')

# set working directory
#MLwd = "D:/MarisaLimfiles/Make_sitexsp_matrix/"
MLwd = "C:/Users/mcwlim/Dropbox/resultsfromSarahcomputer/nodesigfiles"
setwd(MLwd)

# ------------ 1. Load input data: sitexsp, coords, shape, tree ------------
# Read in site by species matrix
#hb_commat <- read.csv("for sitexsp/hbird_sitexspmat_sub.csv") #a 0/1 site-by-species matrix
hb_commat <- read.csv("hbird_sitexspmat_sub.csv")
dim(hb_commat)
hb_commat[1:5,1:4]
rownames(hb_commat) <- hb_commat$X
hb_commat2 <- hb_commat[,-1]

# Read in cell coordinate information
#hb_coords <- read.csv("for sitexsp/cell_coords_rounded.csv")[,-1] # a data.frame with one row for each site, and lat/long coordinates in 2 of the columns
hb_coords <- read.csv("cell_coords_rounded.csv")[,-1]
head(hb_coords)
colnames(hb_coords) <- c("cellIDs", "Long", "Lat")

# Read in geographic extent shape file
#myshape <- raster("for sitexsp/myvarscrop.grd")
myshape<- raster("myvarscrop.grd")
plot(myshape,col="grey")

# Read in tree
#tree <- read.tree("humtree280.tre")
tree <- read.tree("C:/Users/mcwlim/Desktop/StonyBrook/GrahamLab/Dissertation idea materials/THESIS PROJECTS/Hummingbird_Genomics/humtree280.tre")

# ------------ 2. Load inputs into nodiv object ------------

# Get environmental variables
# # Get rasters res=10
tmin <- raster::getData("worldclim", var="tmin", res = 10) %>% mean()
prec <- raster::getData("worldclim", var="prec", res = 10) %>% sum()
alt <- raster::getData("worldclim", var='alt', res=10)
# Extract values (res=10)
hb_coords$tmin <- raster::extract(x=tmin, y=hb_coords[c("Long", "Lat")])/10
hb_coords$tmin[is.na(hb_coords$tmin)] <- na.omit(hb_coords$tmin)/10
hb_coords$prec <- raster::extract(x=prec, y=hb_coords[c("Long", "Lat")])
hb_coords$prec[is.na(hb_coords$prec)] <- na.omit(hb_coords$prec)
hb_coords$alt <- raster::extract(x=alt, y=hb_coords[c("Long", "Lat")])
hb_coords$alt[is.na(hb_coords$alt)] <- na.omit(hb_coords$alt)
hb_coords2 <- arrange(hb_coords, cellIDs)
head(hb_coords2)

# FIXME: the coords are messed up, not grabbing the right areas
# Get rasters res=0.5
tmin5_min <- raster::getData("worldclim", var="tmin", res = 0.5, lon=-165, lat=-60) %>% mean()
tmin5_max <- raster::getData("worldclim", var="tmin", res = 0.5, lon=-30, lat=75) %>% mean()
prec5_min <- raster::getData("worldclim", var="prec", res = 0.5, lon=min(hb_coords$Long), lat=min(hb_coords$Lat)) %>% sum()
prec5_max <- raster::getData("worldclim", var="prec", res = 0.5, lon=max(hb_coords$Long), lat=max(hb_coords$Lat)) %>% sum()
elev5_min <- raster::getData("worldclim", var="alt", res = 0.5, lon=min(hb_coords$Long), lat=min(hb_coords$Lat))
elev5_max <- raster::getData("worldclim", var="alt", res = 0.5, lon=max(hb_coords$Long), lat=max(hb_coords$Lat))
# Extract values (res=0.5)
hb_coords$tmin <- raster::extract(x=tmin5_min, y=hb_coords[c("Long", "Lat")])/10
hb_coords$tmin[is.na(hb_coords$tmin5_min)] <- na.omit(extract(tmin5_max, hb_coords[c("Long", "Lat")]))/10
hb_coords$prec <- raster::extract(x=prec5_min, y=hb_coords[c("Long", "Lat")])
hb_coords$prec[is.na(hb_coords$prec5_min)] <- na.omit(extract(prec5_max, hb_coords[c("Long", "Lat")]))
hb_coords$alt <- raster::extract(x=elev5_min, y=hb_coords[c("Long", "Lat")])
hb_coords$alt[is.na(hb_coords$elev5_min)] <- na.omit(extract(elev5_max, hb_coords[c("Long", "Lat")]))
hb_coords3 <- arrange(hb_coords, cellIDs)
head(hb_coords3)

# Generate distrib_data object
hummers <- distrib_data(hb_commat2, hb_coords) %>%
  add_shape(myshape)
# res=10
hummers <- add_sitestat(distrib_data=hummers,
                        sitestat=dplyr::select(hb_coords2, tmin, prec, alt),
                        site=rownames(hb_commat2))
# res=0.5
hummers <- add_sitestat(distrib_data=hummers,
                        sitestat=dplyr::select(hb_coords3, tmin, prec),
                        site=rownames(hb_commat2))
# Add phylogeny
hummers <- nodiv_data(tree, hummers)
plot(hummers)

# Grid Data...
#...in geographic space
hummers_geo <- gridData(hummers, type = "geo") ### TO DO: what does this do??
plot(hummers_geo)
#...in environmental space
hummers_env <- gridData(hummers, type = "env", env_binsizes = c(2, 400, 400))
  ## Warning message: In points2grid(points, tolerance, round) :   grid has empty column/rows in dimension 2
plot(hummers_env) #### FIX: empty...

# ------------ The most basic summary metrics are then available: ------------
# The coords do not need to have the same length or be ordered the same way
# hummers <- distrib_data(hb_commat2, hb_coords)
# hummers <- add_shape(hummers, myshape)
# plot(hummers)
# hummers <- nodiv_data(tree, hummers)

#look at node numbers
plot(hummers$phylo)
nodelabels(bg="white")

# Now the default plot also shows the phylogeny
jpeg("Hbird_richness.jpg", height=6, width=6, units="in", res=600)
plot_richness(hummers, main="Species richness")
dev.off()
jpeg("Hbird_noderichness.jpg", height=6, width=10, units="in", res=600)
par(mfrow=c(1,2))
plot_node(hummers, node=329, main="Species richness: Andean clade vs. rest")
plot_node(hummers, node=272, main="Species richness at node: Topazes,Hermits vs. rest")
dev.off()

jpeg("Hbird_noderichness_outofSA.jpg", height=6, width=6, units="in", res=600)
plot_node(hummers,node=416, main="Species richness; out of SA")
dev.off()
jpeg("Hbird_noderichness_Coqvs.Brill.jpg", height=6, width=6, units="in", res=600)
plot_node(hummers,node=330, main="Species richness; Coquettes vs. Brilliants")
dev.off()

# Describing the data set
hummers
summary(hummers)
names(hummers)

# create a species richness plot as diagnostic
plot(hummers)

head(species(hummers))
Nspecies(hummers)
head(sites(hummers))
Nsites(hummers)

hist(occupancy(hummers))

plot_species(hummers, "Archilochus_colubris")
plot_species(hummers, "Calypte_anna")
plot_species(hummers, "Metallura_phoebe")

plot_species(hummers, "Chalcostigma_herrani")
plot_species(hummers, 16) # species, sites and nodes can all be identified as numbers or names
i <- 16
plot_species(hummers, i <- i + 1)

occurrences(hummers, "Chalcostigma_herrani")
assemblage(hummers, site = 6)
assemblage(hummers, site = 6, value = "names")

# Tools for working with nodes
plot_nodes_phylo(Node_occupancy(hummers), hummers$phylo, cex = 0.8)

Node_species(hummers, node = 150)
Sister(150, hummers)
Parent(150, hummers)
Descendants(150, hummers)

#Optionally, you can restrict the analysis to only sites with at least 4 species
# hummers <- subsample(hummers, sites = richness(hummers) > 3)

# ------------ 3. Run nodiv: geographic space ------------
humm_nodiv <- Node_analysis(hummers, repeats = 100, method = "rdtable")
summary(humm_nodiv)
par(mfrow=c(1,1))
plot(humm_nodiv, label=nodenumbers(humm_nodiv), col="HMrainbow")

jpeg("Hbird_GND_geography.jpg", height=8, width=15, units="in", res=600)
plot(humm_nodiv, label=humm_nodiv$GND, col=heat.colors(10), direction="upwards")
dev.off()
#plot SOS values for a given node
# check the node numbers if you change resolution of data
jpeg("Hbird_SOS_Andeancladevsrest.jpg", height=6, width=6, units="in", res=600)
plotSOS(humm_nodiv, 329, main="Andean clade vs. rest", col="HMrainbow", xlab="Longitude", ylab="Latitude")
dev.off()
jpeg("Hbird_SOS_Basevsrest.jpg", height=6, width=6, units="in", res=600)
plotSOS(humm_nodiv, 272, main="HermitsTopazes vs. rest", col="HMrainbow", xlab="Longitude", ylab="Latitude")
dev.off()
jpeg("Hbird_SOS_BeesGemsvsEms.jpg", height=6, width=6, units="in", res=600)
plotSOS(humm_nodiv, 416, main="BeesGems vs. Emeralds", col="HMrainbow", xlab="Longitude", ylab="Latitude")
dev.off()

jpeg("Hbird_SOS_hists.jpg", height=6, width=8, units="in", res=600)
par(mfrow=c(1,2))
hist(SOS(humm_nodiv, 329))
hist(SOS(humm_nodiv, 272))
dev.off()

GND(humm_nodiv)

# with hummers_geo
humm_nodiv_geo <- Node_analysis(hummers_geo, repeats = 100, method = "rdtable")
plot(humm_nodiv_geo)
plotSOS(humm_nodiv_geo, 372)

# ------------ 4. Run nodiv: environmental space ------------
humm_nodiv_env <- Node_analysis(hummers_env, repeats = 100, method = "rdtable")
plot(humm_nodiv_env)

jpeg("Hbird_GND_environment.jpg", height=8, width=15, units="in", res=600)
plot(humm_nodiv_env, label=humm_nodiv_env$GND, col=heat.colors(10), direction="upwards")
dev.off()

# not sure how to label the axes with this plot function (diff from geographic space one)
# x-axis = temperature, y-axis = precipitation
jpeg("Hbird_SOSenv_Basevsrest.jpg", height=6, width=6, units="in", res=600)
plotSOS(humm_nodiv_env, 272, col=HMrainbow())
dev.off()
jpeg("Hbird_SOSenv_Andeancladevsrest.jpg", height=6, width=6, units="in", res=600)
plotSOS(humm_nodiv_env, 329, col=HMrainbow())
dev.off()

plotSOS(humm_nodiv_env, 372, col=HMrainbow()) # base of coquettes

jpeg("Hbird_SOSenv_BeesGemsvsEms.jpg", height=6, width=6, units="in", res=600)
plotSOS(humm_nodiv_env, 416, col=HMrainbow())
dev.off()

hist(SOS(humm_nodiv_env, 272))
hist(SOS(humm_nodiv_env, 416))

# ------------ code for running without Archilochus colubris -----------
#hb_commat2 without A. colubris
# hb_commat_noAc <- hb_commat2[,!colnames(hb_commat2)=="Archilochus_colubris"]
# hummers_noAc <- distrib_data(hb_commat_noAc, hb_coords)
# hummers_noAc <- add_shape(hummers_noAc, myshape)

# hummers_noAc <- nodiv_data(tree, hummers_noAc)
# summary(hummers_noAc)
# plot_richness(hummers_noAc, main="Species richness")
# plot_node(hummers_noAc, node=303)
# plot_node(hummers_noAc, node=250)

# humm_nodiv_noAc <- Node_analysis(hummers_noAc, repeats = 200, method = "rdtable") #TODO: how many repeats?
# summary(humm_nodiv_noAc)
# plot(humm_nodiv_noAc, label=nodenumbers(humm_nodiv_noAc), col="white")
#
# jpeg("Hbird_GND_geographynoAc.jpg", height=8, width=10, units="in", res=600)
# plot(humm_nodiv_noAc, label=humm_nodiv_noAc$GND, col=heat.colors(10), direction="upwards")
# dev.off()
# #plot SOS values for a given node
# jpeg("Hbird_SOS_AndeancladevsrestnoAc.jpg", height=6, width=6, units="in", res=600)
# plotSOS(humm_nodiv_noAc, 303, main="node 303: Andean clade vs. rest")
# dev.off()
# jpeg("Hbird_SOS_BasevsrestnoAc.jpg", height=6, width=6, units="in", res=600)
# plotSOS(humm_nodiv_noAc, 250, main="node 250: HermitsTopazes vs. rest")
# dev.off()
#
# jpeg("Hbird_SOS_histsnoAc.jpg", height=6, width=8, units="in", res=600)
# par(mfrow=c(1,2))
# hist(SOS(humm_nodiv_noAc, 303))
# hist(SOS(humm_nodiv_noAc, 250))
# dev.off()


# plumber.R

#* Echo back the input
#* @param msg The message to echo
#* @get /echo
function(msg=""){
  list(msg = paste0("The message is: '", msg, "'"))
}

#* Plot a histogram
#* @png
#* @get /plot
function(){
  rand <- rnorm(100)
  hist(rand)
}

#* Return the sum of two numbers
#* @param a The first number to add
#* @param b The second number to add
#* @post /sum
function(a, b){
  as.numeric(a) + as.numeric(b)
}


ola <- function(w, nrep) {
  l <- length(w)
  lo2 <- l/2
  tot <- l + nrep * lo2
  out <- rep(0, tot)
  offset <- lo2
  out[1:l] <- w
  for (j in 1:nrep) {
    out[offset:(offset+l-1)] <- out[offset:(offset+l-1)] + w
    offset <- offset + lo2
  }
  out
}


rm(list = ls())
setwd(dirname(parent.frame(2)$ofile))

library(ggplot2)
library(plyr)
library(dplyr)
library(tidyr)
library(readr)
library(xtable)
source('./_function_task_expand_name.r')
source('./_compute_summary.r')
source('./_plot_parameter.r')

best.range = 5000

best.model.step.fn = function (errors) {
  best.step = max(length(errors) - best.range, 0) + which.min(tail(errors, best.range))
  if (length(best.step) == 0) {
    return(length(errors))
  } else {
    return(best.step)
  }
}

first.solved.step = function (steps, errors, threshold) {
  index = first(which(errors < threshold))
  if (is.na(index)) {
    return(NA)
  } else {
    return(steps[index])
  }
}

safe.interval = function (alpha, vec) {
  if (length(vec) <= 1) {
    return(NA)
  }

  return(abs(qt((1 - alpha) / 2, length(vec) - 1)) * (sd(vec) / sqrt(length(vec))))
}

name.parameter = 'interpolation.range'
name.label = 'Interpolation range'
name.file = '../results/function_task_static_mul_range.csv'
name.output = '../paper/results/simple_function_static_mul_range.pdf'
name.output.reproduction = '../paper/results/simple_function_static_mul_range_reproduce.pdf'

eps = read_csv('../results/function_task_static_mse_expectation.csv') %>%
  filter(simple == FALSE & parameter == 'extrapolation.range') %>%
  mutate(
    operation = revalue(operation, operation.full.to.short)
  ) %>%
  select(operation, extrapolation.range, threshold)

dat = expand.name(read_csv(name.file)) %>%
  merge(eps) %>%
  mutate(
    parameter = !!as.name(name.parameter)
  )

dat.last = dat %>%
  group_by(name, parameter) %>%
  #filter(n() == 201) %>%
  summarise(
    threshold = last(threshold),
    best.model.step = best.model.step.fn(metric.valid.interpolation),
    interpolation.last = metric.valid.interpolation[best.model.step],
    extrapolation.last = metric.test.extrapolation[best.model.step],
    interpolation.step.solved = first.solved.step(step, metric.valid.interpolation, threshold),
    extrapolation.step.solved = first.solved.step(step, metric.test.extrapolation, threshold),
    sparse.error.max = sparse.error.max[best.model.step],
    solved = replace_na(metric.test.extrapolation[best.model.step] < threshold, FALSE),
    model = last(model),
    operation = last(operation),
    seed = last(seed),
    size = n()
  )

dat.last.rate = dat.last %>%
  group_by(model, operation, parameter) %>%
  group_modify(compute.summary)

dat.gather = plot.parameter.make.data(dat.last.rate)

p = ggplot(dat.gather, aes(x = parameter, colour=model, group=interaction(parameter, model))) +
  geom_point(aes(y = mean.value, shape=our.model), position=position_dodge(width=0.3)) +
  geom_errorbar(aes(ymin = lower.value, ymax = upper.value), position=position_dodge(width=0.3), alpha=0.5) +
  scale_color_discrete(labels = model.to.exp(levels(dat.gather$model))) +
  scale_x_discrete(name = name.label) +
  scale_y_continuous(name = element_blank(), limits=c(0,NA)) +
  scale_shape(guide = FALSE) +
  facet_wrap(~ key, scales='free_y', labeller = labeller(
    key = c(
      success.rate = "Success rate",
      converged.at = "Solved at iteration step",
      sparse.error = "Sparsity error"
    )
  )) +
  theme(legend.position="bottom") +
  theme(plot.margin=unit(c(5.5, 10.5, 5.5, 5.5), "points")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
print(p)
ggsave(name.output, p, device="pdf", width = 13.968, height = 5.7, scale=1.4, units = "cm")

dat.gather.reproduction = dat.gather %>%
  filter(model %in% c('$\\mathrm{NAC}_{\\bullet}$', 'NALU') &
         parameter %in% c('U[0,1]', 'U[0.1,0.2]', 'U[1,2]', 'U[1.1,1.2]', 'U[10,20]')) %>%
  mutate(
    model = droplevels(model)
  )

p = ggplot(dat.gather.reproduction, aes(x = parameter, colour=model, group=interaction(parameter, model))) +
  geom_point(aes(y = mean.value), position=position_dodge(width=0.3)) +
  geom_errorbar(aes(ymin = lower.value, ymax = upper.value), position=position_dodge(width=0.3), alpha=0.5) +
  scale_color_discrete(labels = model.to.exp(levels(dat.gather.reproduction$model))) +
  scale_x_discrete(name = name.label) +
  scale_y_continuous(name = element_blank(), limits=c(0,NA)) +
  facet_wrap(~ key, scales='free_y', labeller = labeller(
    key = c(
      success.rate = "Success rate",
      converged.at = "Solved at iteration step",
      sparse.error = "Sparsity error"
    )
  )) +
  theme(legend.position="bottom") +
  theme(plot.margin=unit(c(5.5, 10.5, 5.5, 5.5), "points")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
print(p)
ggsave(name.output.reproduction, p, device="pdf", width = 13.968, height = 5.7, scale=1.4, units = "cm")


#' Plot effective sample size (Neff) by index
#'
#' Effective sample size is a measure of how precisely age composition is measured.
#' @param asap name of the variable that read in the asap.rdat file
#' @param index.names names of indices
#' @param save.plots save individual plots
#' @param od output directory for plots and csv files
#' @param plotf type of plot to save
#' @param liz.palette color definitions
#' @export

PlotIndexNeff  <- function(asap,index.names,save.plots,od,plotf,liz.palette){
  par(mfrow=c(1,1) )

  years <- seq(asap$parms$styr, asap$parms$endyr)
  Neff.init <- asap$index.Neff.init
  Neff.est <- asap$index.Neff.est
  index.acomp.flags <- asap$control.parms$index.age.comp.flag
  my.title <- "Index Neff "
  my.save <- "Index.Neff."

  for (i in 1:asap$parms$nindices) {
    #cum.age.comp.flag<-0
    if( index.acomp.flags[i]>0) {
      plot(years,Neff.init[i,], type='p', col=liz.palette[i], pch=1, xlab="Year", ylab="Effective Sample Size",
           ylim=c(0, 1.1*max(Neff.init[i,],Neff.est[i,])) )
      lines(years, Neff.est[i,], col=liz.palette[i], lwd=2)
      title (paste0(my.title, i, " (", index.names[i], ")") )
      if (save.plots) savePlot(paste0(od, my.save, i, ".", plotf), type=plotf)
    } #end test for age-comp
  } #end loop nindices
  return()
}   #end function


#!/usr/bin/Rscript
args <- commandArgs(TRUE)
infile_name <-args[1]
outfile_name <-args[2]
text_for_the_title <-args[3]

jpeg(outfile_name,width=1000,height=1000, quality = 90)

a<-read.table(infile_name,header=T)
x<-a[,1]
y<-a[,2]

#the function to calculate maximum when "N/A" values are present among the data
my.max <- function(x) ifelse( !all(is.na(x)), max(x, na.rm=T), NA)

#calculating maximum, while ignoring "N/A" values
maximum_value_of_x<-my.max(x)
maximum_value_of_y<-my.max(y)

par(mar = c(5, 5, 5, 5)) # Setting the margin on all sides
plot(x,y,xlim=c(0,maximum_value_of_x),ylim=c(0,maximum_value_of_y),type="l",main=text_for_the_title,xlab="position (bp)",ylab="position (bp)", xaxs = "i", yaxs = "i", cex.main=2, cex.lab=1.5)


equityinfo <- function(symbol, extract=NULL) {

    if (is.null(extract)) {
        ## interactive with list of info available
        out <- quantmod::getQuote(symbol, src='yahoo', what = quantmod::yahooQF())
    } else {
        out <- quantmod::getQuote(symbol, src='yahoo', what = quantmod::yahooQF(extract))
    }
    return(out)
}

## equityinfo('SPY')
## equityinfo('AAPL', extract='P/E Ratio')
## equityinfo('AAPL', extract=c('Name (Long)', 'P/E Ratio', 'Price/EPS Estimate Next Year', 'Price/Book', 'Dividend Yield'))


getName <- function(v) {
deparse(substitute(v))
}

## Draw a small histogram of each different dataset, separated by animal/field of view

dir.create("animal")
dir.create("fov")

# Plot histograms of log2 H2BGFP intensities (all data; separated per animal)
for (dataset in names(everything)) {
		name <- sprintf("animal/%s.png",dataset)
		print(sprintf("Generating %s", name))
		title <- sprintf("Histone dilution in dataset %s",dataset)
		png(name)
		hist(log2(everything[[dataset]]),main=title,xlab="log2(Histone Intensity)")
		dev.off()
}

# Plot histograms of log2 H2BGFP intensities (all data; separated per field-of-view)
for (dataset in names(fov)) {
		name <- sprintf("fov/%s.png",dataset)
		print(sprintf("Generating %s", name))
		title <- sprintf("Histone dilution in dataset %s",dataset)
		png(name)
		hist(log2(fov[[dataset]]),main=title,xlab="log2(Histone Intensity)")
		dev.off()
}


## load libraries
  library(dplyr)
  library(lubridate)
  ## ggplot is from gitub branch b181e9a, since the version on CRAN as of May 2016 did not support subtitle on the charts
  ## to install use the following
      ## devtools::install_github("hadley/ggplot2")
  library(ggplot2)

## fetch data from wunderground
  # sample url to fetch data https://www.wunderground.com/history/airport/VIDP/2016/5/19/MonthlyHistory.html?req_city=Gurgaon&req_statename=India&reqdb.zip=00000&reqdb.magic=1&reqdb.wmo=42178&format=1
  # you can adapt it your use case by modifying the parameters like location and dates
  basePath <- c("https://www.wunderground.com/history/airport/VIDP/","/","/","/MonthlyHistory.html?req_city=Gurgaon&req_statename=India&reqdb.zip=00000&reqdb.magic=1&reqdb.wmo=42178&format=1")

  ## set month and date
    ## change the mdate to change the month for which it fetches data
    ## don't change ddate, dont think date parameter has any affect on the data returned
  mDate <- "05"
  dDate <- "01"

  ## select range of year for which to fetch data
  ## you have to be careful about the starting year, different weather stations have different operationalisation dates
  yearRange <- c(2006,2016)

  ## make a loop and fetch data for the year range mentioned for the entire month
  for (i in yearRange[1]:yearRange[2]) {
    filePath <- paste0(basePath[1],as.character(i),basePath[2],mDate,basePath[3],dDate,basePath[4])
    print(filePath)
    tmp <- read.csv(filePath)
    if(i == yearRange[1]){
      df1 <- tmp
    }else{
      df1 <- rbind(df1,tmp)
    }
  }

  ## format the data add in more identifier columns
  df1$Year <- as.factor(year(df1$IST))
  df1$IST <- as.Date(df1$IST,"%Y-%m-%d")
  df1$Date <- as.numeric(format(df1$IST,"%d"))
  df2 <- df1 %>% filter(Date < 21)

  ## make plot

  ## do the box plot
  q <- ggplot(df2,aes(Year,Max.TemperatureC))
  q  <- q + geom_boxplot() + geom_jitter(colour="grey70")
    ## calculate the median
    df3 <- df2 %>% select(Year,Max.TemperatureC) %>% group_by(Year) %>% summarise(medTemp = median(Max.TemperatureC))
    ## add in median to the box plot q
    q <- q + geom_text(data = df3, aes(y = medTemp, label = paste0(round(medTemp,0),"C")),size = 3, vjust = -0.5)
    q <- q + ggtitle("Gurgaon Max Temperature for first 20 days of May",subtitle="Line and Text represents median of observed temperatures, grey dots represent individual observations")
    q + theme(plot.title = element_text(hjust=0, size=16))


install.packages("caret")
install.packages("rpart")
install.packages("tree")
install.packages("randomForest")
install.packages("e1071")
install.packages("ggplot2")


# set the working directory
setwd(
  "D:\\Data\\study\\12.Semester\\mci-af\\_StudyResults"
)
.libPaths("C:/Users/tobia/Documents/R/win-library/3.6")

#### Variables
##################
plot <- FALSE
details <- FALSE
file <- c("resync_complete.csv", "resync2_clean.csv")

#### Basic import
##################

# read in the csv file:
df_results <-
  read.csv(file[[1]], header = TRUE, sep = ";", stringsAsFactors = FALSE) 	# read in the first line as column labels with header=TRUE

library(plyr)

# print to console the results of ls() call:
print("Data objects:")
print(ls()) 							# ls(): which data objects currently exist in this workspace
print("Columns of the result set:")
print(names(df_results)) 					# names(): which column names exist in this dataframe?

# number of participants (all rows, column no.1)
print("number of data samples:")
print(length(df_results[, 1]))

# number of columns/variables
print("number of variables:")
print(length(df_results))

#### Actual analysis
##################

## libs
library(pastecs)
# library(reshape)
library(car) # used for levene + mauchly
library(coin) # used for wilcoxon
library(pgirmess) # used for kruskalmc
library(ggplot2)
library(scales)
library(tidyr)
# library(matrixStats)

# Change all occurances of numbers as groups to strings
df_results["FadeSeconds"] <- data.frame(lapply(df_results["FadeSeconds"], function(x) {
    gsub("-1", "Alarm", x)
}))
df_results["FadeSeconds"] <- data.frame(lapply(df_results["FadeSeconds"], function(x) {
    gsub("20", "Fade 20", x)
}))
df_results["FadeSeconds"] <- data.frame(lapply(df_results["FadeSeconds"], function(x) {
    gsub("5", "Fade 5", x)
}))

# print(table(df_results["gender"]))
options(scipen=100)
options(digits=2)
print(stat.desc(df_results["RSME"]))

for (j in c("orderingMis", "matchingMis", "countingMis")) {
  print(j)
  for (i in c("Alarm", "Fade 20", "Fade 5")) {
    print(i)
    # print(stat.desc(df_results[df_results["FadeSeconds"] == i, j]))
    print(table(df_results[df_results["FadeSeconds"] == i, j]))
  }
}
print(stat.desc(df_results[df_results["FadeSeconds"] == i, "orderingTime"]))
print(stat.desc(df_results[df_results["FadeSeconds"] == i, "matchingTime"]))
print(stat.desc(df_results[df_results["FadeSeconds"] == i, "countingTime"]))

print(stat.desc(df_results[df_results["AlarmDuration"] != -1, "AlarmDuration"]))

if(details){
  for (i in c("Fade 5", "Fade 20", "Alarm")) {
    for (j in c(
      "o1", "o2", "o3", "o4", "o5", "o6", "o7", "o8", "o9", "o10",
      "m1", "m2", "m3", "m4", "m5", "m6", "m7", "m8", "m9", "m10",
      "c1", "c2", "c3"
      )) {
      tmp <- stat.desc(df_results[df_results["FadeSeconds"] == i, j])
      sts <- c(tmp["min"], tmp["max"], tmp["range"], tmp["median"], tmp["mean"], tmp["std.dev"])
      # print(i + j)
      print(sts)
    }
  }
  rm(i)
  rm(j)
  rm(tmp)
  rm(sts)
}

df_sleep = c(8,8,10,10,10,10,10,11,12,12,12,13,13,14,12.5,12.5,12.5,
            15,15,15,15,15,15,15,15,15,15,15,15,15,17.5,17,17,18,18,18,
            18.5,19,20,20,20,20,20,20,30)

##################################
##################################
##########   Analyze   ###########
##################################
##################################
##################################
for (analyze in c(
  "orderingTime",
  "matchingTime",
  "countingTime"
)) {
  print(paste("Analyzing variable", analyze))

  shapiro <- TRUE
  for (group in c("Fade 5", "Fade 20", "Alarm")) {
    #print(paste("Analyzing group", group))

    d_t <- df_results[df_results$FadeSeconds == group, ]
    stt <- shapiro.test(d_t[, analyze])
    print(paste("Shapiro's test:", stt$p.value))
    shapiro <- shapiro && stt$p.value > 0.05
  }
  rm(d_t)

  ltt <-
    leveneTest(df_results[, analyze] ~ factor(FadeSeconds, c("Fade 5", "Fade 20", "Alarm")), data = df_results)
  print(paste("Levenes's test:", ltt$`Pr(>F)`[1]))

  cat("\nResult: The Variable ")
  if (shapiro && ltt$`Pr(>F)`[1] > 0.05) {
    cat("is parametric\n")
    r_aov <-
      aov(df_results[, analyze] ~ factor(FadeSeconds, c("Fade 5", "Fade 20", "Alarm")), data = df_results)
    r_aovS <- summary(r_aov)
    print(r_aovS)
    if (r_aovS[[1]]$`Pr(>F)`[1] < 0.05) {
      print("Statistically Significant!!")
    }
    #rm(r_aov)
  } else {
    cat("is NOT parametric.\n\n")
    r_kru <-
      kruskal.test(df_results[, analyze] ~ factor(FadeSeconds, c("Fade 5", "Fade 20", "Alarm")), data = df_results)
    print(r_kru)
    r_kru$p.value
    if (r_kru$p.value < 0.05) {
      r_krumc <-
        kruskalmc(df_results[, analyze] ~ factor(FadeSeconds, c("Fade 5", "Fade 20", "Alarm")), data = df_results)
      print(r_krumc)
      rm(r_krumc)
    }
    rm(r_kru)
  }
  rm(stt)
  rm(ltt)
  cat("\n=========\n\n")
}
rm(analyze)

##################################
##################################
##########     PLOT   ############
##################################
##################################
##################################
blank_theme <- theme_minimal()+
    theme(
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    panel.border = element_blank(),
    # panel.grid=element_blank(),
    axis.ticks = element_blank(),
    plot.title=element_text(size=40, face="bold")
    )

if (plot) {
  df2 <- data.frame(group=rep(c("Fade 5", "Fade 20", "Alarm"), each=10),
    task=factor(c("o1", "o2", "o3", "o4", "o5","o6", "o7", "o8", "o9", "o10")),
    val=c(
      median(df_results[df_results$FadeSeconds == "Fade 5", "o1"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "o2"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "o3"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "o4"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "o5"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "o6"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "o7"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "o8"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "o9"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "o10"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "o1"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "o2"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "o3"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "o4"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "o5"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "o6"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "o7"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "o8"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "o9"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "o10"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "o1"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "o2"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "o3"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "o4"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "o5"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "o6"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "o7"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "o8"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "o9"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "o10"])
      )
    )
  df2$task <- factor(df2$task,levels = c("o1", "o2", "o3", "o4", "o5","o6", "o7", "o8", "o9", "o10"))
  bp <- ggplot(df2, aes(x=task, y=val, group=group)) +
    geom_line(aes(color=group))+
    geom_point(aes(color=group)) +
    theme_minimal() +
    labs(y = "Time (ms)", x = "Subtask", title="Ordering subtask times", fill = "Group", color="Group") +
    guides(fill = guide_legend(title = "Group")) +
    scale_color_manual(values = c("#3288bd", "#d53e4f", "#fc8d59"))+
    scale_fill_manual(values = c("#3288bd", "#d53e4f", "#fc8d59"))
  ggsave("timeTask1.pdf", bp, NULL, NULL, 1, 7, 5)

  df2 <- data.frame(group=rep(c("Fade 5", "Fade 20", "Alarm"), each=10),
    task=factor(c("m1", "m2", "m3", "m4", "m5","m6", "m7", "m8", "m9", "m10")),
    val=c(
      median(df_results[df_results$FadeSeconds == "Fade 5", "m1"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "m2"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "m3"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "m4"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "m5"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "m6"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "m7"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "m8"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "m9"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "m10"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "m1"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "m2"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "m3"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "m4"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "m5"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "m6"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "m7"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "m8"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "m9"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "m10"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "m1"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "m2"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "m3"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "m4"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "m5"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "m6"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "m7"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "m8"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "m9"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "m10"])
      )
    )
  df2$task <- factor(df2$task,levels = c("m1", "m2", "m3", "m4", "m5","m6", "m7", "m8", "m9", "m10"))
  bp <- ggplot(df2, aes(x=task, y=val, group=group)) +
    geom_line(aes(color=group))+
    geom_point(aes(color=group)) +
    theme_minimal() +
    labs(y = "Time (ms)", x = "Subtask", title="Matching subtask times", fill = "Group", color="Group") +
    guides(fill = guide_legend(title = "Group")) +
    scale_color_manual(values = c("#3288bd", "#d53e4f", "#fc8d59"))+
    scale_fill_manual(values = c("#3288bd", "#d53e4f", "#fc8d59"))
  ggsave("timeTask2.pdf", bp, NULL, NULL, 1, 7, 5)

  df2 <- data.frame(group=rep(c("Fade 5", "Fade 20", "Alarm"), each=3),
    task=factor(c("c1", "c2", "c3")),
    val=c(
      median(df_results[df_results$FadeSeconds == "Fade 5", "c1"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "c2"]),
      median(df_results[df_results$FadeSeconds == "Fade 5", "c3"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "c1"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "c2"]),
      median(df_results[df_results$FadeSeconds == "Fade 20", "c3"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "c1"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "c2"]),
      median(df_results[df_results$FadeSeconds == "Alarm", "c3"])
      )
    )
  df2$task <- factor(df2$task,levels = c("c1", "c2", "c3"))
  bp <- ggplot(df2, aes(x=task, y=val, group=group)) +
    geom_line(aes(color=group))+
    geom_point(aes(color=group)) +
    theme_minimal() +
    labs(y = "Time (ms)", x = "Subtask", title="Counting subtask times", fill = "Group", color="Group") +
    guides(fill = guide_legend(title = "Group")) +
    scale_color_manual(values = c("#3288bd", "#d53e4f", "#fc8d59"))+
    scale_fill_manual(values = c("#3288bd", "#d53e4f", "#fc8d59"))
  ggsave("timeTask3.pdf", bp, NULL, NULL, 1, 7, 5)

  #### SAM
  df_plot <- data.frame(
    "ppr" = df_results$SAM_pleasure_pre,
    "ppo" = df_results$SAM_pleasure_post,
    "apr" = df_results$SAM_arousal_pre,
    "apo" = df_results$SAM_arousal_post,
    "dpr" = df_results$SAM_dominance_pre,
    "dpo" = df_results$SAM_dominance_post,
    "group" = df_results$FadeSeconds
  )
  df_plot$group <-
    factor(df_plot$group, c("Alarm", "Fade 20", "Fade 5"))
  df_plot <-
    gather(df_plot, sam, val, ppr:dpo, factor_key = TRUE)
  bp <-
    ggplot(data = df_plot, aes(x = sam, y = val)) +
    geom_boxplot(aes(fill = group), position = position_dodge(1)) +
    blank_theme +
    theme(axis.text.x = element_text(size=14,angle=45,hjust=1))+
    #coord_cartesian(ylim = c(0, 9)) +
    labs(x = "Sam Dimension", y = "Reaction") +
    scale_x_discrete(labels=c(
        "ppr" = "Pleasure (pre)",
        "ppo" = "Pleasure (post)",
        "apr" = "Arousal (pre)",
        "apo" = "Arousal (post)",
        "dpr" = "Dominance (pre)",
        "dpo" = "Dominance (post)"
        )) +
    guides(fill = guide_legend(title = "Group")) +
    scale_fill_manual(values = c("#3288bd", "#d53e4f", "#fc8d59"))
  ggsave("SAMresults.pdf", bp, NULL, NULL, 1, 9, 5)

  ## Ordering mistakes histogram
  # Basic scatter plot
  S_sqrt <- function(x){sign(x)*sqrt(abs(x))}
  IS_sqrt <- function(x){x^2*sign(x)}
  S_sqrt_trans <- function() trans_new("S_sqrt",S_sqrt,IS_sqrt)
  df_plot <- data.frame(
    t = df_results$orderingTime,
    m = df_results$orderingMis,
    g = df_results$FadeSeconds
  )
  p <- ggplot(df_plot, aes(x=t, y=m, shape=g, color=g)) +
    geom_point(size=5) +
    scale_y_continuous(trans = "S_sqrt",
        breaks=seq(0,45,5)
      ) +
      theme_minimal() +
      labs(y = "Mistakes", x = "Time (ms)", title="Ordering time and mistakes", color="Group") +
      guides(color = guide_legend(title = "Group"), shape = guide_legend(title = "Group")) +
      scale_color_manual(values = c("#3288bd", "#d53e4f", "#fc8d59"))
  ggsave("orderingMisTimeScat.pdf", p, NULL, NULL, 1, 7, 5)

  ## Matching mistakes histogram
  # Basic scatter plot
  df_plot <- data.frame(
    t = df_results$matchingTime,
    m = df_results$matchingMis,
    g = df_results$FadeSeconds
  )
  p <- ggplot(df_plot, aes(x=t, y=m, shape=g, color=g)) +
    geom_point(size=5) +
      scale_y_continuous(trans = "S_sqrt",
        breaks=seq(0,10,1)
      ) +
      theme_minimal() +
      labs(y = "Mistakes", x = "Time (ms)", title="Matching time and mistakes", color="Group") +
      guides(color = guide_legend(title = "Group"), shape = guide_legend(title = "Group")) +
      scale_color_manual(values = c("#3288bd", "#d53e4f", "#fc8d59"))
  ggsave("matchingMisTimeScat.pdf", p, NULL, NULL, 1, 7, 5)

  ## Counting mistakes histogram
  # Basic scatter plot
  df_plot <- data.frame(
    t = df_results$countingTime,
    m = df_results$countingMis,
    g = df_results$FadeSeconds
  )
  p <- ggplot(df_plot, aes(x=t, y=m, shape=g, color=g)) +
    geom_point(size=5) +
      scale_y_continuous(trans = "S_sqrt",
        breaks=seq(0,3,1)
      ) +
      theme_minimal() +
      labs(y = "Mistakes", x = "Time (ms)", title="Counting time and mistakes", color="Group") +
      guides(color = guide_legend(title = "Group"), shape = guide_legend(title = "Group")) +
      scale_color_manual(values = c("#3288bd", "#d53e4f", "#fc8d59"))
  ggsave("countingMisTimeScat.pdf", p, NULL, NULL, 1, 7, 5)

  ####### Alarm duration
  ## Alarm duration histogram
  df_plot <- data.frame("var" = df_results[df_results["AlarmDuration"] > 0,"AlarmDuration"],
                        "g" = "Alarm duration")
  # Change automatically color by groups
  bp <-
    # theme_classic() +
    ggplot(df_plot, aes(x = g, y = var, fill = g)) +
    geom_boxplot() +
    blank_theme+
    labs(x = "", y = "Age") +
    theme(legend.position = "none", text = element_text(size = 20)) +
    scale_fill_manual(values = c("#fc8d59")) + coord_flip()
  ggsave("alarmDurationHist.pdf", bp, NULL, NULL, 1, 7, 5)
  rm(dt)

  ## Plot subjective Sleep duration
  df_plot <- data.frame(
    "val" = df_results["SleepDuration"],
    "group" = df_results$FadeSeconds
  )
  df_plot$group <-
    factor(df_plot$group, c("Alarm", "Fade 20", "Fade 5"))
  df_plot <-
    gather(df_plot, sam, val, SleepDuration, factor_key = TRUE)
  bp <-
    ggplot(data = df_plot, aes(x = group, y = val)) +
    geom_boxplot(aes(fill = group), position = position_dodge(1)) +
    blank_theme +
    theme(axis.text.x = element_text(size=14,angle=45,hjust=1))+
    labs(x = "Sam Dimension", y = "Reaction") +
    scale_x_discrete(labels=c(
        "al" = "Alarm",
        "fz" = "Fade 20",
        "ff" = "Fade 5"
        )) +
    guides(fill = guide_legend(title = "Group")) +
    scale_fill_manual(values = c("#3288bd", "#d53e4f", "#fc8d59"))
  ggsave("subjectiveSleepDuration.pdf", bp, NULL, NULL, 1, 7, 5)

  ## Plot RSME Boxplot
  df_plot <- data.frame(
    "rsme" = df_results["RSME"],
    "group" = df_results$FadeSeconds
  )
  df_plot$group <-
    factor(df_plot$group, c("Alarm", "Fade 20", "Fade 5"))
  df_plot <-
    gather(df_plot, sam, val, RSME, factor_key = TRUE)
  bp <-
    ggplot(data = df_plot, aes(x = group, y = val)) +
    geom_boxplot(aes(fill = group), position = position_dodge(1)) +
    blank_theme +
    theme(axis.text.x = element_text(size=14,angle=45,hjust=1))+
    labs(x = "Sam Dimension", y = "Reaction") +
    scale_x_discrete(labels=c(
        "al" = "Alarm",
        "fz" = "Fade 20",
        "ff" = "Fade 5"
        )) +
    guides(fill = guide_legend(title = "Group")) +
    scale_fill_manual(values = c("#3288bd", "#d53e4f", "#fc8d59"))
  ggsave("rsme.pdf", bp, NULL, NULL, 1, 7, 5)

  ### Plot sleep state
  g <- c("Slept", "Dozed", "Meditated", "Awake")
  v <- c(9, 12, 3, 21)
  df_plot <- data.frame(
    group = g,
    value = v
  )
  bp <- ggplot(df_plot, aes(x = "", y = value, fill = group)) +
    geom_bar(width = 1, stat = "identity")
  bp <- bp + coord_polar("y", start = 0) +
    blank_theme +
    labs(x = "", y = "") +
    guides(fill = guide_legend(title = "Sleep status")) +
    theme(plot.title = element_text(size = 12, face = "bold"),
      legend.title=element_text(size=20),
      legend.text=element_text(size=16),
      axis.text.x=element_blank()) +
    scale_fill_manual(values = c("#d53e4f", "#fee08b", "#e6f598", "#3288bd"))
  ggsave("slept.pdf", bp, NULL, NULL, 1, 7, 5)

  rm(df_plot)
  rm(bp)
}


# R script for downloading and analysing R package download statistics
# from http://cran-logs.rstudio.com/

# Number of days over which to analyse stats
days <- 14

# Percentiles to output
percentiles <- c(80, 90, 95, 99)

library(dplyr)
library(ggplot2)

data_file <- "data.tsv"
if (file.exists(data_file)) {
  # Data file exists so just read it in
  data <- read.table(data_file, sep="\t", header=TRUE)
} else {
  # Define data range and associated URLs to download
  end <- as.Date(Sys.time()) - 3 # It can take some days for logs to be available
  begin <- end - days
  dates <- seq(begin, end, by="day")
  filenames <- strftime(dates, "%Y-%m-%d.csv.gz")

  # Get data by day, count downloads by package and
  # append to data. Better to aggregate by date first
  # because of the large size of the daily logs.
  data <- NULL
  dir.create("logs", showWarnings=FALSE)
  for (filename in filenames) {
    path <- file.path("logs", filename)
    if(!file.exists(path)) {
      url <- paste0("http://cran-logs.rstudio.com/", substr(filename, 1, 4), '/', filename)
      download.file(url, path)
    }
    day <- read.csv(path)
    counts <- day %>% group_by(package) %>% count(name="count")
    data <- rbind(data, counts)
  }

  # Save data for use again
  write.table(data, data_file, sep="\t", quote=FALSE, row.names=F)
}

# Count by package
counts <- data %>% group_by(package) %>% summarise(count=sum(count), .groups="keep") %>% arrange(-count)

# Calculate rank and percentile
counts <- within(counts, {
  rank <- 1:nrow(counts)
  percentile <- diffinv(count)[-1] / sum(count) * 100
})

# Plot stats
plot <- counts %>%
  head(1000) %>%
  ggplot(aes(x=rank, y=percentile)) +
  geom_line() +
  geom_hline(yintercept=percentiles, linetype=2, colour="grey") +
  labs(x="Rank of package", y="Percentile or package")
ggsave("stats.png", plot)

# Write stats
counts %>%
  select(package, rank, percentile) %>%
  write.table("stats.tsv", sep="\t", quote=FALSE, row.names=F)


#devtools::test("asremlPlus")
context("model_selection")

cat("#### Test for changeTerms using wheat example with asreml4\n")
test_that("Wheatchange_asreml4", {
  skip_if_not_installed("asreml")
  skip_on_cran()
  library(dae)
  library(asreml)
  library(asremlPlus)
  ## use asremlPlus to analyse the wheat (barley) example from section 8.6 of the asreml manual (Butler et al. 2010)
  data(Wheat.dat)
  #'## Add cubic trend to Row so that spline is not bound
  Wheat.dat <- within(Wheat.dat,
                      {
                        vRow <- as.numeric(Row)
                        vRow <- vRow - mean(unique(vRow))
                        yield <- yield + 10*vRow + 20 * (vRow^2) + 5 * (vRow^3)
                      })

  #Function to check which models have been changed
  chk.changes <- function(test.summary)
  {
    changes <- tail(test.summary[test.summary$action != "Boundary",], 1)
    changes <- unlist(lapply(c("fixed", "random", "residual"),
                             function(x, changes){grepl(x, changes, fixed = TRUE)},
                             changes = changes$action))
    return(changes)
  }

  # Fit initial model
  current.asr <- do.call("asreml",
                         args = list(yield ~ Rep + WithinColPairs + Variety,
                                     random = ~ Row + Column + units,
                                     residual = ~ ar1(Row):ar1(Column),
                                     data=Wheat.dat))
  summary(current.asr)$varcomp
  current.asrt <- as.asrtests(current.asr, NULL, NULL)
  testthat::expect_equal(nrow(summary(current.asrt$asreml.obj)$varcomp), 6)
  testthat::expect_equal(nrow(current.asrt$wald.tab), 4)

  # Add and drop both fixed and random terms
  current.asrt <- changeTerms(current.asrt, addFixed = "vRow", dropFixed = "WithinColPairs",
                              addRandom = "spl(vRow)", dropRandom = "units",
                              checkboundaryonly = TRUE)
  testthat::expect_equal(sum(chk.changes(current.asrt$test.summary)), 2)
  testthat::expect_equal(nrow(summary(current.asrt$asreml.obj)$varcomp), 6)
  testthat::expect_equal(nrow(current.asrt$wald.tab), 4)

  # Drop all fixed terms
  current.asrt <- changeTerms(current.asrt, dropFixed = "Rep + Variety + vRow",
                              checkboundaryonly = TRUE)
  testthat::expect_equal(sum(chk.changes(current.asrt$test.summary)), 1)
  testthat::expect_equal(nrow(summary(current.asrt$asreml.obj)$varcomp), 6)
  testthat::expect_equal(nrow(current.asrt$wald.tab), 1)

  # Add back fixed terms
  current.asrt <- changeTerms(current.asrt, addFixed = "Rep + Variety + vRow",
                              checkboundaryonly = TRUE)
  testthat::expect_equal(sum(chk.changes(current.asrt$test.summary)), 1)
  testthat::expect_equal(nrow(summary(current.asrt$asreml.obj)$varcomp), 6)
  testthat::expect_equal(nrow(current.asrt$wald.tab), 4)

  # Restart with residual, remove it and then return it
  current.asr <- do.call("asreml",
                         args = list(yield ~ Rep + WithinColPairs + Variety,
                                     random = ~ Row + Column + units,
                                     residual = ~ ar1(Row):ar1(Column),
                                     data=Wheat.dat))
  current.asrt <- as.asrtests(current.asr, NULL, NULL)
  current.asrt <- changeTerms(current.asrt, dropRandom = "units",newResidual = "-(1)")
  testthat::expect_equal(sum(chk.changes(current.asrt$test.summary)), 2)
  testthat::expect_equal(nrow(summary(current.asrt$asreml.obj)$varcomp), 1)
  testthat::expect_equal(nrow(current.asrt$wald.tab), 4)
  current.asrt <- changeTerms(current.asrt, newResidual = "ar1(Row):ar1(Column)")
  testthat::expect_equal(sum(chk.changes(current.asrt$test.summary)), 1)
  testthat::expect_equal(nrow(summary(current.asrt$asreml.obj)$varcomp), 3)
  testthat::expect_equal(nrow(current.asrt$wald.tab), 4)

  # Restart with no random and add them back in
  current.asr <- do.call("asreml",
                         args = list(yield ~ Rep + WithinColPairs + Variety,
                                     residual = ~ ar1(Row):ar1(Column),
                                     data=Wheat.dat))
  summary(current.asr)$varcomp
  current.asrt <- as.asrtests(current.asr, NULL, NULL)
  current.asrt <- changeTerms(current.asrt, addRandom = "Row + Column + units",
                              newResidual = "Row:ar1(Column)")
  testthat::expect_equal(sum(chk.changes(current.asrt$test.summary)), 2)
  testthat::expect_equal(nrow(summary(current.asrt$asreml.obj)$varcomp), 5)
  testthat::expect_equal(nrow(current.asrt$wald.tab), 4)

  #Change residual with no random terms
  current.asrt <- as.asrtests(current.asr, NULL, NULL)
  current.asrt <- changeTerms(current.asrt,
                              newResidual = "Row:ar1(Column)",
                              label="Row autocorrelation")
  testthat::expect_equal(sum(chk.changes(current.asrt$test.summary)), 1)
  testthat::expect_equal(nrow(summary(current.asrt$asreml.obj)$varcomp), 2)
  testthat::expect_equal(nrow(current.asrt$wald.tab), 4)
})


#!/usr/bin/env Rscript

#Andrew Burt - a.burt@ucl.ac.uk

args <- commandArgs(trailingOnly=TRUE)
path_to_src <- args[1]
source(paste(path_to_src,"nlmle.r",sep=""))
source(paste(path_to_src,"quantileregression.r",sep=""))
source(paste(path_to_src,"bootstrap.r",sep=""))
source(paste(path_to_src,"measuncert.r",sep=""))
source(paste(path_to_src,"olsBIOMASS.r",sep=""))
source(paste(path_to_src,"fieldresults.r",sep=""))
source(paste(path_to_src,"generateplots.r",sep=""))
cdata <- read.table(args[2],col.names=c("country","d","h","agb","rho"))
caldata <- data.frame(cdata$d,cdata$agb)
colnames(caldata) <- c("X","y")
fitNLMLE <- function(data,tol=1e-10,reltol=1e-10,stepmin=1/5120,maxitr=250)

print(fitNLMLE)

#alpha <- as.numeric(args[3])
#runs <- as.numeric(args[4])
#localreg <- args[5]
#results <- getFieldResults(caldata,args[6:length(args)],alpha,runs,localreg)
#writeResults(results)


data = read.delim("merge.tsv")

plotMerge = function(n, yaxt = 's') {
  if (yaxt == 'n') {
    ylab = NA
    old = par(mar=c(4.5,1,3,0.5))
  } else {
    ylab = "Error in quantile (ppm)"
    old = par(mar=c(4.5,5,3,0.5))
  }
  par(lwd=0.2)
  boxplot(e1*1e6 ~ q, at=1:6-0.17, xaxt='n', boxwex=0.25, data[data$type=="quantile" & data$parts == n,],
          ylim=c(-10000, 10000), cex=0.5, yaxt = yaxt,
          col=rgb(0.95, 0.95, 0.95), xlab='Quantile (q)', ylab=ylab)
  boxplot(e2*1e6 ~ q, at=1:6+0.17, xaxt='n', boxwex=0.25, add=T, data[data$type=="quantile" & data$parts == n,],
          col=rgb(0.4, 0.4, 0.4), cex=0.5, yaxt = yaxt)
  axis(side=1, at=1:6, labels=c(0.001, 0.01, 0.1, 0.2, 0.3, 0.5))
  legend(0.5, 10000, c("Direct", "Merged"), fill = c(rgb(0.95, 0.95, 0.95), rgb(0.4, 0.4, 0.4)))
  abline(h=0, col=rgb(0.4, 0.4, 0.4))
  text(1.2, 5000, expression(1/delta == 50))
  title(paste(n, " parts"))
  box()
  par(old)
}

setEPS()
postscript("merge.eps", width=6, height=2.4, pointsize=9)
layout(matrix(c(1,2,3), 1, 3, byrow=T), widths=c(1.15,1,1))

plotMerge(5, 's')
plotMerge(20, 'n')
plotMerge(100, 'n')

dev.off()