library("readr")
library("readxl")
library("socialmixr")
library("dplyr")
library("tidyr")
library("janitor")
library("ggplot2")

spatial_resolution <- "ltla"

# make sure figure directory exists directory
fig_path <- here::here("figure")
dir.create(fig_path, recursive = TRUE, showWarnings = FALSE)

## get vaccination data and extract ages
vacc_file <- paste0("vaccinations_", spatial_resolution, ".csv")
vacc <- read_csv(here::here("data", vacc_file)) %>%
  clean_names() %>%
  mutate(lower_age_limit = as.integer(sub("[_+].*$", "", age))) %>% ## remove bit after "_" from age column
  select(-age)

cases_file <- paste0("cases_", spatial_resolution, ".csv")
cases <- read_csv(here::here("data", cases_file)) %>%
  clean_names() %>%
  mutate(lower_age_limit = as.integer(sub("[_+].*$", "", age))) %>%
  filter(!is.na(lower_age_limit)) %>%
  select(-age)

## age groups are slightly different between the two files - combine age group 16-17 and 18-25 to 15-25 in vaccination file
vacc <- vacc %>%
  mutate(lower_age_limit = if_else(lower_age_limit < 25, 15L, lower_age_limit))

## First, use totals
tot_cases <- cases %>%
  filter(date == max(date)) %>%
  group_by(area_name) %>%
  summarise(cases = sum(rolling_sum), .groups = "drop")

tot_vacc <- vacc %>%
  filter(date == max(date)) %>%
  group_by(area_name) %>%
  summarise(pop = sum(vaccine_register_population_by_vaccination_date),
            vaccinated = sum(cum_people_vaccinated_complete_by_vaccination_date),
            .groups = "drop")

combined <- tot_cases %>%
  inner_join(tot_vacc, by = "area_name") %>%
  mutate(cases = cases * 100000 / pop, vaccinated = vaccinated / pop)

p <- ggplot(combined, aes(x = cases, y = vaccinated)) +
  geom_point() +
  geom_smooth(alpha = 0.35, method = "lm") +
  ylab("2-dose vaccinated") +
  xlab("7-day case rate / 100k") +
  theme_minimal()

p


# Analysis of differences between one barometer and many others in its neighbourhood.
# This one is the same as v02, but uses better matching of timestamps.

logger.names <- grep('barometer/', gwloggeR.data::enumerate(), value = TRUE)

round_timestamp <- function(ts, scalefactor.sec = 3600*12) {
  as.POSIXct(round(as.numeric(ts)/scalefactor.sec) * scalefactor.sec, origin = '1970-01-01', tz = 'UTC')
}

read.baro <- function(logger.name) {
  df <- gwloggeR.data::read(logger.name)$df
  if (nrow(df) == 0L) return(df)
  df <- df[!is.na(TIMESTAMP_UTC), ]
  df <- df[!is.na(PRESSURE_VALUE), ]
  df <- df[!duplicated(TIMESTAMP_UTC), ]
  df <- df[, .('PRESSURE_VALUE' = mean(PRESSURE_VALUE)),
           by = .('TIMESTAMP_UTC' = round_timestamp(TIMESTAMP_UTC))]
  df[, 'FILE' := basename(logger.name)]
  df[, 'N' := .N]
  data.table::setkey(df, TIMESTAMP_UTC)
  structure(df, 'logger.name' = logger.name)
}

# read.baro('barometer/BAOL553X_B_004BA.csv')
data <- sapply(logger.names, read.baro, simplify = FALSE, USE.NAMES = TRUE)

compare <- function(df1, df2) {
  if (nrow(df1) == 0L || nrow(df2) == 0L) return(data.table::data.table())

  diff.df <- df1[J(df2), .('PRESSURE_DIFF' = x.PRESSURE_VALUE - i.PRESSURE_VALUE, TIMESTAMP_UTC)][!is.na(PRESSURE_DIFF), ]

  diff.df
}

compute <- function(logger.name, make.plot = TRUE) {
  logger.names <- setdiff(logger.names, logger.name)
  logger.df <- data[[logger.name]]

  df.diff <- lapply(logger.names, function(other.name) {
    other.df <- data[[other.name]]
    compare(logger.df, other.df)
  })
  df.diff <- data.table::rbindlist(df.diff, use.names = TRUE, fill = TRUE)

  if (nrow(df.diff) == 0L) return()

  df.quant <- df.diff[
    , .(Q.025 = quantile(PRESSURE_DIFF, 0.025),
        Q.5 = quantile(PRESSURE_DIFF, 0.5),
        Q.975 = quantile(PRESSURE_DIFF, 0.975)),
    by = TIMESTAMP_UTC]

  plt.logger <- ggplot2::ggplot(data = logger.df, mapping = ggplot2::aes(x = TIMESTAMP_UTC, y = PRESSURE_VALUE)) +
    ggplot2::geom_line() +
    ggplot2::coord_cartesian(ylim = quantile(logger.df$PRESSURE_VALUE, probs = c(0.005, 0.995)),
                             xlim = range(logger.df$TIMESTAMP_UTC)) +
    ggplot2::theme_light() +
    ggplot2::theme(axis.title.x = ggplot2::element_blank(),
                   axis.text.x = ggplot2::element_blank(),
                   axis.text.y = ggplot2::element_text(angle = 90, hjust = 0.5))

  plt.diff <- ggplot2::ggplot(data = df.diff, mapping = ggplot2::aes(x = TIMESTAMP_UTC, y = PRESSURE_DIFF)) +
    ggplot2::geom_point(pch = '.') +
    ggplot2::geom_line(data = df.quant, mapping = ggplot2::aes(y = Q.5), col = 'red', alpha = 0.5) +
    ggplot2::stat_smooth(method = 'gam', formula = y ~ s(x, k = 40), color = 'yellow', se = FALSE) +
    ggplot2::coord_cartesian(ylim = quantile(df.diff$PRESSURE_DIFF, probs = c(0.025, 0.975)),
                             xlim = range(logger.df$TIMESTAMP_UTC)) +
    #ggplot2::scale_x_datetime(date_breaks = '1 year', date_labels = '%Y') +
    ggplot2::theme_light() +
    ggplot2::theme(axis.text.y = ggplot2::element_text(angle = 90, hjust = 0.5))

  layout_matrix <- rbind(1,2)
  grob.title <- grid::textGrob(sprintf('%s (#%s vs. #%s observations)',
                                       basename(logger.name), nrow(logger.df), nrow(df.diff)),
                               x = 0.05, hjust = 0)

  filename <- sprintf('./drifts/analysis_04/%s.png', tools::file_path_sans_ext(basename(logger.name)))

  local({
    if (!make.plot) return()
    png(filename, width = 1280, height = 720)
    on.exit(dev.off())
    print(gridExtra::grid.arrange(plt.logger, plt.diff,
                                  layout_matrix = layout_matrix,
                                  top = grob.title))
  })

  structure(df.diff, 'logger.name' = logger.name)
}

# compute(logger.names[1])
# lapply(logger.names, compute)

parallel::setDefaultCluster(parallel::makeCluster(spec = 7L))
parallel::clusterExport(varlist = c('logger.names', 'round_timestamp', 'data', 'compare'))
results <- parallel::parSapplyLB(X = logger.names, FUN = compute, simplify = FALSE, USE.NAMES = TRUE,
                                 chunk.size = 1, make.plot = TRUE)
parallel::stopCluster(cl = parallel::getDefaultCluster())


# ---
# jupyter:
#   kernelspec:
#     display_name: R
#     language: R
#     name: ir
#   language_info:
#     codemirror_mode: r
#     file_extension: .r
#     mimetype: text/x-r-source
#     name: R
#     pygments_lexer: r
#     version: 3.5.0
# ---

# %% [markdown]
# This is a jupyter notebook that uses the IR kernel.

# %%
sum(1:10)

# %%
plot(cars)

# %%


# To run: >> Rscript boxplots.r

library(ggplot2)
library(extrafont)

data <- read.csv(file="rq1.csv", header=TRUE, sep=",")
data$bugRatio <- data$fails/100

data$benchmarkId <- factor(data$benchmarkId,levels = c("#1", "#2", "#3", "#4", "#6", "#7", "#10", "#5**", "#8**", "#9**", "#11**"))

p1 <- ggplot(data, aes(x=benchmarkId, y=bugRatio, fill=tool)) + geom_boxplot() + labs(x="Benchmarks", y = "Bug reproduction ratio", fill = "") + scale_fill_manual(values=c("#FFFFFF", "#999999")) + theme_bw() + theme(legend.position = "bottom", legend.text = element_text(size = 14, face="bold"), text = element_text(size = 14, face="bold"), axis.title = element_text(face="bold")) + coord_cartesian(ylim = c(0, 1))

p2 <- ggplot(data, aes(x=benchmarkId, y=firstfail, fill=tool)) + geom_boxplot() + labs(x="Benchmarks", y = "Runs until the first failure", fill = "") + scale_fill_manual(values=c("#FFFFFF", "#999999")) + theme_bw() + theme(legend.position = "bottom", legend.text = element_text(size = 12, face="bold"), text = element_text(size = 12), axis.title = element_text(size = 14, face="bold")) + coord_cartesian(ylim = c(0, 50))

pdf("/benchmarks/figures/RQ1-g1.pdf")
print(p1)
dev.off()

# Not used in the paper - just to support a statement in RQ1
pdf("/benchmarks/figures/RQ1-g2.pdf")
print(p2)
dev.off()


library(rstan)
library(reshape2)

all_dat = readRDS('../data/all_melt.RDS')

all_dat = all_dat[which(all_dat$class %in% c('Tenure Track', 'Postdoctoral', 'Graduate')),]
all_dat$class = droplevels(all_dat$class)

tots = aggregate(value ~ date + class, all_dat, sum)

int = all_dat[all_dat$int==TRUE,c('class', 'date', 'month', 'year', 'value' )]
dat_org = merge(int, tots, by = c('date', 'class'))
colnames(dat_org)[5:6] = c('int', 'total')
dat_org = data.frame(dat_org, nint = dat_org$total - dat_org$int)
# levels(dat_org$class) <- c('Graduate', 'Postdoctoral', 'Tenure Track')

classes = c('Tenure Track', 'Postdoctoral', 'Graduate')
years   = seq(2000, 2015)

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

gr_dat = dat_org[which(dat_org$class == 'Graduate'),]
gr_dat = gr_dat[order(gr_dat$date),]
gr_dat$nint_p = gr_dat$nint/gr_dat$total

pd_dat = dat_org[which(dat_org$class == 'Postdoctoral'),]
pd_dat = pd_dat[order(pd_dat$date),]
pd_dat$nint_p = pd_dat$nint/pd_dat$total

tt_dat = dat_org[which(dat_org$class == 'Tenure Track'),]
tt_dat = tt_dat[order(tt_dat$date),]
tt_dat$nint_p = tt_dat$nint/tt_dat$total

date  = tt_dat$date
month = tt_dat$month
year  = tt_dat$year
T     = length(date)

X <- matrix(0, nrow=length(month), ncol=length(unique(month)))
X[cbind(seq_along(month), month)] <- 1

all <- list(T = T,
            N_years = length(unique(year)),
            N_months = length(unique(month)),
            K = 12,
            date = date,
            month = month,
            year  = year-2000+1,
            y_tt  = tt_dat$int,
            N_tt  = tt_dat$total,
            y_gr  = gr_dat$int,
            N_gr  = gr_dat$total,
            y_pd  = pd_dat$int,
            N_pd  = pd_dat$total,
            N_all = tt_dat$total + gr_dat$total + pd_dat$total)

########################################################################################################################################
## plotting functions
########################################################################################################################################

# only works when there are individual month effects
plot_month_ind <- function(month_ind, suff){
  # month_ind = post_m2b$month_ind
  month_ind = apply(month_ind, c(2,3), function(x) quantile(x, probs=c(0.025, 0.5, 0.975)))
  month_ind = melt(month_ind)

  colnames(month_ind) = c('quant', 'class', 'month', 'value')

  month_ind$class = classes[month_ind$class]

  ymin = subset(month_ind, quant == c('2.5%'))$value
  ymax = subset(month_ind, quant == c('97.5%'))$value
  y = subset(month_ind, quant == c('50%'))$value
  limits = data.frame(subset(month_ind, quant == c('2.5%'))[,1:3], ymin=ymin, ymax=ymax, y=y)
  # limits = aes(ymin=ymin, ymax=ymax)

  ggplot() + geom_point(data=subset(month_ind, quant == c('50%')), aes(x=factor(month), y=value, colour=factor(class)), size=3) +
    geom_pointrange(data=limits, aes(x=factor(month), ymin=ymin, y=y, ymax=ymax, colour=factor(class)))

  #ggsave(paste0('figures/month_ind_', suff, '.pdf'))

}

# only works when there are individual month effects
plot_month_shared <- function(month_shared, suff){
  # month_ind = post_m2b$month_ind
  month_shared = apply(month_shared, c(2), function(x) quantile(x, probs=c(0.025, 0.5, 0.975)))
  month_shared = melt(month_shared)

  colnames(month_shared) = c('quant', 'month', 'value')

  ymin = subset(month_shared, quant == c('2.5%'))$value
  ymax = subset(month_shared, quant == c('97.5%'))$value
  y = subset(month_shared, quant == c('50%'))$value
  limits = data.frame(subset(month_shared, quant == c('2.5%'))[,1:3], ymin=ymin, ymax=ymax, y=y)
  # limits = aes(ymin=ymin, ymax=ymax)

  ggplot() + geom_point(data=subset(month_shared, quant == c('50%')), aes(x=factor(month), y=value), size=3) +
    geom_pointrange(data=limits, aes(x=factor(month), ymin=ymin, y=y, ymax=ymax)) +
    ggtitle('Month shared')

  #ggsave(paste0('figures/month_shared_', suff, '.pdf'))

}

# only works when there are individual month effects
plot_time_shared <- function(post, suff){
  time_shared = post$time_all
  time_shared = apply(time_shared, c(2), function(x) quantile(x, probs=c(0.025, 0.5, 0.975)))
  time_shared = melt(time_shared)

  colnames(time_shared) = c('quant', 'time', 'value')

  ymin = subset(time_shared, quant == c('2.5%'))$value
  ymax = subset(time_shared, quant == c('97.5%'))$value
  y = subset(time_shared, quant == c('50%'))$value
  limits = data.frame(subset(time_shared, quant == c('2.5%'))[,1:3], ymin=ymin, ymax=ymax, y=y)
  # limits = aes(ymin=ymin, ymax=ymax)

  ggplot() + geom_point(data=subset(time_shared, quant == c('50%')), aes(x=factor(time), y=value), size=3) +
    geom_pointrange(data=limits, aes(x=factor(time), ymin=ymin, y=y, ymax=ymax)) +
    ggtitle('Time shared')

  #ggsave(paste0('figures/time_shared_', suff, '.pdf'))

}

# only works when there are individual month effects
plot_time_individual <- function(post, suff){
  time_ind = post$time_ind
  time_ind = apply(time_ind, c(2,3), function(x) quantile(x, probs=c(0.025, 0.5, 0.975)))
  time_ind = melt(time_ind)

  colnames(time_ind) = c('quant', 'class', 'time', 'value')

  ymin = subset(time_ind, quant == c('2.5%'))$value
  ymax = subset(time_ind, quant == c('97.5%'))$value
  y = subset(time_ind, quant == c('50%'))$value
  limits = data.frame(subset(time_ind, quant == c('2.5%'))[,1:3], ymin=ymin, ymax=ymax, y=y)
  # limits = aes(ymin=ymin, ymax=ymax)

  ggplot() + geom_point(data=subset(time_ind, quant == c('50%')), aes(x=factor(time), y=value), size=3) +
    geom_pointrange(data=limits, aes(x=factor(time), ymin=ymin, y=y, ymax=ymax)) +
    ggtitle('Time ind')

  #ggsave(paste0('figures/time_shared_', suff, '.pdf'))

}

# only works when there are individual month effects
plot_year_slope <- function(post, suff){
  year_all = post$year_slope_all
  year_all = quantile(year_all, probs=c(0.025, 0.5, 0.975))
  year_all = melt(year_all)
  year_all = data.frame(quant=rownames(year_all), class=rep('all'), value=year_all)

  print(year_all)

  if ('year_slope_ind' %in% names(post)){
  year_ind = post$year_slope_ind
  year_ind = apply(year_ind, c(2), function(x) quantile(x, probs=c(0.025, 0.5, 0.975)))
  year_ind = melt(year_ind)

  colnames(year_ind) = c('quant', 'class', 'value')

  print('Here')
  print(year_ind)
  year = rbind(year_ind, year_all)
  } else {
    year = year_all
  }

  print(year)

  ymin = subset(year, quant == c('2.5%'))$value
  ymax = subset(year, quant == c('97.5%'))$value
  y = subset(year, quant == c('50%'))$value
  limits = data.frame(subset(year, quant == c('2.5%'))[,1:3], ymin=ymin, ymax=ymax, y=y)
  # limits = aes(ymin=ymin, ymax=ymax)

  ggplot() + geom_point(data=subset(year, quant == c('50%')), aes(x=class, y=value), size=3) +
    geom_pointrange(data=limits, aes(x=class, ymin=ymin, y=y, ymax=ymax)) +
    ggtitle('Year')

  #ggsave(paste0('figures/time_shared_', suff, '.pdf'))

}

plot_alphas <- function(alpha_ind, alpha_all, suff){

  alpha_ind = apply(alpha_ind, c(2), function(x) quantile(x, probs=c(0.025, 0.5, 0.975)))
  alpha_ind = melt(alpha_ind)

  colnames(alpha_ind) = c('quant', 'class', 'value')

  alpha_ind$class = classes[alpha_ind$class]

  alpha_all = quantile(alpha_all, probs=c(0.025, 0.5, 0.975))
  alpha_all = melt(alpha_all)

  alpha_all = data.frame(quant=rownames(alpha_all), class=rep('all'), value=alpha_all)

  alpha = rbind(alpha_ind, alpha_all)

  ymin = subset(alpha, quant == c('2.5%'))$value
  ymax = subset(alpha, quant == c('97.5%'))$value
  y = subset(alpha, quant == c('50%'))$value
  limits = data.frame(subset(alpha, quant == c('2.5%'))[,1:3], ymin=ymin, ymax=ymax, y=y)
  # limits = aes(ymin=ymin, ymax=ymax)

  ggplot() + geom_point(data=subset(alpha, quant == c('50%')), aes(x=class, y=value), size=3) +
    geom_pointrange(data=limits, aes(x=class, ymin=ymin, y=y, ymax=ymax)) +
    ggtitle('Constants')

  #ggsave(paste0('figures/alpha_', suff, '.pdf'))
}

plot_time_slopes <- function(time_slope_ind, time_slope_all, suff){

  time_slope_ind = apply(time_slope_ind, c(2), function(x) quantile(x, probs=c(0.025, 0.5, 0.975)))
  time_slope_ind = melt(time_slope_ind)

  colnames(time_slope_ind) = c('quant', 'class', 'value')

  time_slope_ind$class = classes[time_slope_ind$class]

  time_slope_all = quantile(time_slope_all, probs=c(0.025, 0.5, 0.975))
  time_slope_all = melt(time_slope_all)

  time_slope_all = data.frame(quant=rownames(time_slope_all), class=rep('all'), value=time_slope_all)

  alpha = rbind(time_slope_ind, time_slope_all)

  ymin = subset(alpha, quant == c('2.5%'))$value
  ymax = subset(alpha, quant == c('97.5%'))$value
  y = subset(alpha, quant == c('50%'))$value
  limits = data.frame(subset(alpha, quant == c('2.5%'))[,1:3], ymin=ymin, ymax=ymax, y=y)
  # limits = aes(ymin=ymin, ymax=ymax)

  ggplot() + geom_point(data=subset(alpha, quant == c('50%')), aes(x=class, y=value), size=3) +
    geom_pointrange(data=limits, aes(x=class, ymin=ymin, y=y, ymax=ymax))  +
    ggtitle('Time slope')

  #ggsave(paste0('figures/time_slopes_', suff, '.pdf'))
}

plot_preds <- function(all, post, suff){

  dat = rbind(data.frame(date=date, value=colMeans(post[['theta_tt']]), class=rep('Tenure Track'), type='pred'),
              data.frame(date=date, value=colMeans(post[['theta_pd']]), class=rep('Postdoctoral'), type='pred'),
              data.frame(date=date, value=colMeans(post[['theta_gr']]), class=rep('Graduate'), type='pred'),
              data.frame(date=date, value=all$y_tt/all$N_tt, class=rep('Tenure Track'), type='data'),
              data.frame(date=date, value=all$y_pd/all$N_pd, class=rep('Postdoctoral'), type='data'),
              data.frame(date=date, value=all$y_gr/all$N_gr, class=rep('Graduate'), type='data'))

  ggplot() + geom_line(data=dat, aes(x=date, y=value, colour=type)) + facet_grid(class~.) +
    ggtitle('Interdisciplinary jobs by class')

  #ggsave(paste0('figures/preds_', suff, '.pdf'))
}

plot_year_effects <- function(post, suff){
  year_shared = post$year_shared
  year_shared =  apply(year_shared, c(2), function(x) quantile(x, probs=c(0.025, 0.5, 0.975)))
  year_shared = melt(year_shared)
  year_shared = data.frame(quant=year_shared[,1], class=rep('all'), year=year_shared[,2], value=year_shared[,3])

  print(year_shared)

  if ('year_ind' %in% names(post)){
    year_ind = post$year_ind
    year_ind = apply(year_ind, c(2,3), function(x) quantile(x, probs=c(0.025, 0.5, 0.975)))
    year_ind = melt(year_ind)

    colnames(year_ind) = c('quant', 'class', 'year', 'value')

    print('Here')
    print(year_ind)
    year = rbind(year_ind, year_shared)
  } else {
    year = year_shared
  }

  print(year)

  ymin = subset(year, quant == c('2.5%'))$value
  ymax = subset(year, quant == c('97.5%'))$value
  y = subset(year, quant == c('50%'))$value
  limits = data.frame(subset(year, quant == c('2.5%'))[,1:3], ymin=ymin, ymax=ymax, y=y)
  # limits = aes(ymin=ymin, ymax=ymax)

  ggplot() +
    geom_point(data=subset(year, quant == c('50%')), aes(x=factor(year), y=value, color=factor(class)), size=3) +
    # geom_pointrange(data=limits, aes(x=class, ymin=ymin, y=y, ymax=ymax)) +
    ggtitle('Year')

  #ggsave(paste0('figures/time_shared_', suff, '.pdf'))

}

########################################################################################################################################
## run models
########################################################################################################################################

fit_m1 <- stan(file    = 'model_MIN_TSLIN_YSH_ABO.stan',
               data    = all,
               iter    = 200,
               chains  = 1,
               control = list(max_treedepth=12))
post_m1   <- extract(fit_m1)

fit_m2 <- stan(file    = 'model_MIN_TSLIN_YIN_AIN.stan',
                data    = all,
                iter    = 200,
                chains  = 1,
                control = list(max_treedepth=12))
post_m2   <- extract(fit_m2)

fit_m3 <- stan(file    = 'model_MIN_YSH_ABO.stan',
               data    = all,
               iter    = 200,
               chains  = 1,
               control = list(max_treedepth=12))
post_m3   <- extract(fit_m3)
########################################################################################################################################
## plot parameters estimates
########################################################################################################################################

plot_month_ind(post_m1$month_ind, '1')
plot_month_ind(post_m2$month_ind, '2')

# plot_month_shared(post_m2$month_all, '2')
# plot_month_shared(post_m2a$month_all, '2a')
# plot_month_shared(post_m2b$month_all, '2b')
# plot_month_shared(post_m2c$month_all, '2c')

plot_alphas(post_m1$alpha_ind, post_m1$alpha_all, '1')
plot_alphas(post_m2$alpha_ind, post_m2$alpha_all, '2')

plot_time_slopes(post_m1$time_slope_ind, post_m1$time_slope_all, '1')
plot_time_slopes(post_m2$time_slope_ind, post_m2$time_slope_all, '2')

plot_time_shared(post_m2$time_shared, '2')

plot_year_effects(post_m1, '1')
plot_year_effects(post_m2, '2')

########################################################################################################################################
## plot parameters estimates
########################################################################################################################################

pdf(file=paste0('figures/model_MIN_TSLIN_YSH_ABO.pdf'))
plot_month_ind(post_m1$month_ind, '1')
plot_alphas(post_m1$alpha_ind, post_m1$alpha_all, '1')
plot_time_slopes(post_m1$time_slope_ind, post_m1$time_slope_all, '1')
plot_preds(all, post_m1, '1')
plot_year_effects(post_m1, '1')
dev.off()

pdf(file=paste0('figures/model_MIN_TSLIN_YIN_AIN.pdf'))
plot_month_ind(post_m2$month_ind, '2')
plot_alphas(post_m2$alpha_ind, post_m2$alpha_all, '2')
plot_time_slopes(post_m2$time_slope_ind, post_m2$time_slope_all, '2')
plot_preds(all, post_m2, '2')
plot_year_effects(post_m2, '2')
dev.off()

pdf(file=paste0('figures/model_MIN_YSH_ABO.pdf'))
plot_month_ind(post_m3$month_ind, '2')
plot_alphas(post_m3$alpha_ind, post_m3$alpha_all, '2')
plot_preds(all, post_m3, '3')
plot_year_effects(post_m3, '3')
dev.off()

########################################################################################################################################
## across classes
########################################################################################################################################

fit_ac <- stan(file    = 'model_across_class.stan',
               data    = all,
               iter    = 200,
               chains  = 1,
               control = list(max_treedepth=12))
post_ac   <- extract(fit_ac)

pdf(file=paste0('figures/model_across_class.pdf'))
plot_month_ind(post_ac$month_ind, 'ac')
plot_alphas(post_ac$alpha_ind, post_ac$alpha_all, 'ac')
plot_preds(all, post_ac, 'ac')
plot_year_effects(post_ac, 'ac')
dev.off()


# 3. faza: Izdelava zemljevida

# Uvozimo funkcijo za pobiranje in uvoz zemljevida.
source("lib/uvozi.zemljevid.r")

# Uvozimo zemljevid.
# cat("Uvažam zemljevid...\n")
# obcine <- uvozi.zemljevid("http://e-prostor.gov.si/fileadmin/BREZPLACNI_POD/RPE/OB.zip",
#                           "obcine", "OB/OB.shp", mapa = "zemljevid",
#                           encoding = "Windows-1250")

cat("Uvažam zemljevid...\n")
slo <- uvozi.zemljevid("http://biogeo.ucdavis.edu/data/gadm2/shp/SVN_adm.zip",
                       "slovenija", "SVN_adm1.shp", mapa = "zemljevid",
                       encoding = "Windows-1250")

# Funkcija, ki podatke preuredi glede na vrstni red v zemljevidu
preuredi <- function(podatki, zemljevid) {
  nove.slo <- c()
  manjkajo <- ! nove.slo %in% rownames(podatki)
  M <- as.data.frame(matrix(nrow=sum(manjkajo), ncol=length(podatki)))
  names(M) <- names(podatki)
  row.names(M) <- nove.slo[manjkajo]
  podatki <- rbind(podatki, M)

  out <- data.frame(podatki[order(rownames(podatki)), ])[rank(levels(zemljevid$NAME_1)[rank(zemljevid$NAME_1)]), ]
  if (ncol(podatki) == 1) {

    out <- data.frame(out)

    names(out) <- names(podatki)
    rownames(out) <- rownames(podatki)
  }
  return(out)
}

# Preuredimo podatke, da jih bomo lahko izrisali na zemljevid.
brezposelnost <- brezpspol[1:12,]
#rownames(brezposelnost) <- brezposelnost[,4]
zbrezpspol <- preuredi(brezposelnost, slo)

# zbrezposelnost <- preuredi(brezposelnost[1:12,4], slo)

# Izračunamo povprečno velikost družine.
# druzine$povprecje <- apply(druzine[1:4], 1, function(x) sum(x*(1:4))/sum(x))
# min.povprecje <- min(druzine$povprecje, na.rm=TRUE)
# max.povprecje <- max(druzine$povprecje, na.rm=TRUE)

min.2014 <- min(zbrezpspol[3], na.rm=TRUE)
max.2014 <- max(zbrezpspol[3], na.rm=TRUE)
norm.2014 <- (zbrezpspol[,3]-min.2014)/(max.2014-min.2014)

# Narišimo zemljevid v PDF.
cat("Rišem zemljevid...\n")
pdf("slike/Slovenija.pdf", width=6, height=4)

# n = 100
# barve = topo.colors(n)[1+(n-1)*(druzine$povprecje-min.povprecje)/(max.povprecje-min.povprecje)]
# plot(obcine, col = barve)

# n = 100
# #barve =rgb(1, 0, 0, norm.2013)
# barve =rgb((n:1)/n, 1, 1)[unlist(1+(n-1)*norm.2014)]
# plot(slo, col = barve, bg="lightblue")

n <- 100
barve <- rgb((n:1)/n, 1, 1)
plot(slo, col = barve[unlist(1+(n-1)*norm.2014)], bg="lightblue")

k <- 5 # število stopenj v legendi
stopnje <- seq(min.2014, max.2014, (max.2014-min.2014)/(k-1))
legend("bottomright", title = "v tisočih", legend = round(stopnje),
       fill = barve[seq(1, n, (n-1)/(k-1))], bg = "white")

#imena regij
koordinate1 <- coordinates(slo)
imena1 <- as.character(slo$NAME_1)
rownames(koordinate1) <- imena1
names(imena1) <- imena1

koordinate1["Obalno-kraška",1] <- koordinate1["Obalno-kraška",1]+0.1 #levo,desno
koordinate1["Obalno-kraška",2] <- koordinate1["Obalno-kraška",2]+0.025 #dol,gor
koordinate1["Zasavska",2] <- koordinate1["Zasavska",2]+0.01
koordinate1["Spodnjeposavska",1] <- koordinate1["Spodnjeposavska",1]+0.1
koordinate1["Spodnjeposavska",2] <- koordinate1["Spodnjeposavska",2]
imena1["Jugovzhodna Slovenija"] <- "Jugovzhodna\nSlovenija"
imena1["Notranjsko-kraška"] <- "Notranjsko-\nkraška"
imena1["Obalno-kraška"] <- "Obalno-\nkraška"
imena1["Spodnjeposavska"]<- "Spodnje-\nposavska"

text(koordinate1,labels=imena1, cex=0.3)
title("Brezposelnost v letu 2014")

dev.off()


# Databricks notebook source
# Git Update Test
print(R.version.string)

# COMMAND ----------

mount_name = "adlsv2-databricks" # Change this to the mount name in your Databricks workspace

# COMMAND ----------

# Load Training Data
path = paste("/dbfs/mnt/",mount_name,"/data/train/weight_data.csv",sep="")
print(paste("Reading file from",path))

data<-read.csv(path, header=TRUE)

# The predictor vector (height).
x <- data$height
# The response vector (weight).
y <- data$weight
# Apply the lm() function.
model <- lm(y~x)

# COMMAND ----------

data

# COMMAND ----------

# Make Predictions
df_test_heights <- data.frame(x = as.numeric(c(115,20)))
result <-  predict(model,df_test_heights)
print(result)

# COMMAND ----------

# Create Paths
model_dir = paste("/dbfs/mnt/",mount_name,"/models",sep="")
model_name = "model.rds"
model_path = paste(model_dir,"/",model_name,sep="")

dir.create(model_dir) # Directory must be created first if it does not exist, or saveRDS will fail

# Save the model to blob storage
model_path = paste("/dbfs/mnt/",mount_name,"/models/model.rds",sep="")

saveRDS(model, model_path)

# COMMAND ----------

# View model details
print(model)

# COMMAND ----------

print('Completed')


dirs<-c("NS-2015-ver01", "NS-2015-ver02","NS-2015-ver04", "NS-2015-ver04","NS-2015-ver05")
labels<-c("NS-2015-ver01", "NS-2015-ver02","NS-2015-ver04", "NS-2015-ver04","NS-2015-ver05")

dev='screen'

SSBparm<-"out"   # read ssb-R parameters from SSB_R.in (="in") or SSB_R.out (="out")
cleanup()
a<-0
for (dir in dirs) {
  data.path<-file.path(root,dir)
    print(data.path)
  setwd(data.path)

  Init.function() # get SMS.contol object  including sp.names

  SSB.R.year.first<-SMS.control@SSB.R.year.first
  SSB.R.year.last <-SMS.control@SSB.R.year.last
  SSB.R.year.first[SSB.R.year.first==-1]<-SMS.control@first.year
  SSB.R.year.last[SSB.R.year.last==-1]<-SMS.control@last.year.model

  a<-a+1
  #read SSB/R parameters
  if (SSBparm=="in") {
     p<-Read.SSB.Rec.data.in(dir=file.path(root,dir))
     p<-data.frame(Species=sp.names[(first.VPA):SMS.control@no.species],Species.n=seq(first.VPA,SMS.control@no.species),p)
  }  else {
      p<-Read.SSB.Rec.data(dir=file.path(root,dir))
  }
  b<-data.frame(dir=dirs[a],label=labels[a],SSB.R.year.first=SSB.R.year.first,SSB.R.year.last=SSB.R.year.last,p)
  if (dir==dirs[1]) all.dat<-b  else all.dat<-rbind(all.dat,b)
}

parm.all<-subset(all.dat)

a<-0
for (dir in dirs) {
  data.path<-file.path(root,dir)
  setwd(data.path)

  Init.function() # get SMS.contol object  including sp.names

  SSB.R.year.first<-SMS.control@SSB.R.year.first
  SSB.R.year.last <-SMS.control@SSB.R.year.last
  SSB.R.year.first[SSB.R.year.first==-1]<-SMS.control@first.year
  SSB.R.year.last[SSB.R.year.last==-1]<-SMS.control@last.year.model

  a<-a+1

   # extract SSB and Recruits
#   s<-Read.summary.data(extend=include.terminal.year)
   s<-Read.summary.data()

   s1<-subset(s,Quarter==1 & Year<=SMS.control@last.year.model-SMS.control@first.age,select=c(Year,Species.n,Age,SSB))
   ssb<-aggregate(s1$SSB/1000,by=list(s1$Year,s1$Species.n),sum,na.rm=T)
   names(ssb)<-list("Year","Species.n","SSB")

   rec<-subset(s,Quarter==SMS.control@rec.season,select=c(Year,Species.n,Age,N))
   rec<-subset(rec,Age==SMS.control@first.age & Year>=SMS.control@first.year+SMS.control@first.age)
   rec<-subset(rec,Year<=SMS.control@last.year.model,select=c(Year,Species.n,N))

   p<-merge(ssb,rec)

   b<-data.frame(dir=dirs[a],label=labels[a],p)
  if (dir==dirs[1]) all.dat<-b  else all.dat<-rbind(all.dat,b)
}
ssbrec<-subset(all.dat)

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

yy<-as.character(seq(SMS.control@first.year,SMS.control@last.year.model))
ss<-as.character(seq(first.VPA,nsp))

if (dev=="print") cleanup()
nox<-4
noy<-3

i<-0
newplot(dev,nox,noy,Portrait=FALSE,w11=11)

s.index<-0
i<-noxy

for (sp in (first.VPA:nsp)) {
  recssb<-subset(ssbrec,Species.n==sp)
  maxSSB<-max(recssb$SSB)
  maxRec<-max(recssb$N)/1000000
  print (sp)
  col<-0
  s.index<-s.index+1
  for (cur.dir in dirs) {

    p<-subset(parm.all,cur.dir==dir)
    recssb<-subset(ssbrec,cur.dir==dir)

    model<-p[s.index,'model']
    alfa<-p[s.index,'alfa']
    beta<-p[s.index,'beta']
    CV<-p[s.index,'std']
    first<-p[s.index,"SSB.R.year.first"]
    last<-p[s.index,"SSB.R.year.last"]

    if (i==noxy) {newplot(dev,nox,noy); i<-0 }

    x<-seq(0,maxSSB, by=maxSSB/100)*1000
    y<-x   #Copy structure
   cat(model,alfa,beta,'\n')
    if (model==1) y<-alfa*x*exp(-beta*x)
    if (model==2) y<-alfa*x/(1+x*beta)
    if (model==3) y<-rep(exp(alfa),length(x))
    if (model==4) {for (i in (1:length(x))) y[i]<-exp(alfa)*min(x[i],exp(beta))}
    if (model==100) {for (i in (1:length(x))) y[i]<-exp(alfa)*min(x[i],beta)}

    x<-x/1000
    y<-y/1000000

    col<-col+1
    if (cur.dir == dirs[1]) {
      plot(x,y,xlab="SSB 1000t",ylab="recruits 10^9",
           main=sp.names[as.numeric(sp)],
           type='l',col=col,ylim=c(0,max(y)*1.5))

    } else  lines(x,y,col=col)

    i<-i+1
  }
}


library(GenomicRanges)
library(rtracklayer)

apply_seqlengths <- function(gr, genome=Dmelanogaster) {
  seqlengths(gr) <- seqlengths(genome)[seqlevels(gr)]
  gr
}

check_coverage_argument <- function(cvg, regions=NULL) {
  if(class(cvg) == "character") {
    if(is.null(regions)) {
      cvg <- import(cvg, as="RleList")
    } else {
      stopifnot(file.exists(cvg))
      cvg <- import(cvg, which=regions, as="RleList")
    }
  }
  cvg
}

regionApply <- function(regions, cvg, func, ...) {
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(unlist(
    viewApply(
      Views(cvg, as(regions, "IntegerRangesList")),
      function(x) { func(as.numeric(x), ...) },
      simplify=FALSE
    ), use.names=FALSE), use.names=FALSE)
  ans
}

regionApply_list <- function(regions, cvg, func) {
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(
    viewApply(
      Views(cvg, as(regions, "IntegerRangesList")),
      function(x) { func(as.numeric(x)) },
      simplify=FALSE
    ), use.names=FALSE)
  ans
}

regionSums <- function(regions, cvg, stranded = F) {
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(
    viewSums(
      Views(cvg, as(regions, "IntegerRangesList"))
    ), use.names=FALSE)
  ans[oo] <- ans  # restore original order
  ans
}

regionMeans <- function(regions, cvg) {
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(
    viewMeans(
      Views(cvg, as(regions, "IntegerRangesList"))
    ), use.names=FALSE)
  ans[oo] <- ans  # restore original order
  ans
}

regionWhichMaxs <- function(regions, cvg) {
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(
    viewWhichMaxs(
      Views(cvg, as(regions, "IntegerRangesList"))
    ), use.names=FALSE)
  ans[oo] <- ans  # restore original order
  ans
}

regionWhichMins <- function(regions, cvg) {
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(
    viewWhichMins(
      Views(cvg, as(regions, "IntegerRangesList"))
    ), use.names=FALSE)
  ans[oo] <- ans  # restore original order
  ans
}

regionMaxs <- function(regions, cvg) {
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(
    viewMaxs(
      Views(cvg, as(regions, "IntegerRangesList"))
    ), use.names=FALSE)
  ans[oo] <- ans  # restore original order
  ans
}

regionMins <- function(regions, cvg) {
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(
    viewMins(
      Views(cvg, as(regions, "IntegerRangesList"))
    ), use.names=FALSE)
  ans[oo] <- ans  # restore original order
  ans
}

total_signal <- function(cov) {
  if(class(cov) == "character") {
    cache.file <- paste0(cov, ".ts.rds")
    if(file.exists(cache.file)) {
      return(readRDS(cache.file))
    } else {
      cov <- check_coverage_argument(cov)
      ts <- sum(as.numeric(sapply(cov, function(x) sum(as.numeric(x)))))
      saveRDS(ts, file=cache.file)
      return(ts)
    }
  } else {
    return(sum(as.numeric(sapply(cov, function(x) sum(as.numeric(x))))))
  }
}


"Input your filenames here"
codeFileName = "testCode.bf"
inputsFileName = "testInputs.csv"
plotOutputs = FALSE
"That's all you need to modify"
# Load readtext package
library(readtext)
codeRaw = readtext(codeFileName, text_field = "plaintext")[,2]
codeRawLength = nchar(codeRaw)
inputsCSV = read.csv(inputsFileName, header=FALSE)
print(getwd())
print("CodeRaw:")
print(codeRaw)
print("CodeRawLength:")
print(codeRawLength)
print("InputsRaw:")
print(inputsCSV)

"Process code"
code <- character()
for (i in 1:codeRawLength) {
    char <- substring(codeRaw,i,i)
    if ( char == "<" | char == ">" | char == "-" | char == "+" | char == "," | char == "." | char == "[" | char == "]") {
        code <- c(code,char)
    }
}
print(code)

"Match Brackets"
bracketList <- character(length(code))
nestedLevel <- 0
i <- 1
while (i <= length(code)) {
    if (code[i] == "[") {
        nestedLevel <- nestedLevel + 1
        bracketList[i] <- nestedLevel
    } else if (code[i] == "]") {
        x <- i
        while (x >= 1) {
            if (bracketList[x] == nestedLevel) {
                bracketList[i] <- x
                print("Found Match")
                break
            }
            x <- x - 1
        }
        nestedLevel <- nestedLevel - 1
    }
    else {
        bracketList[i] <- -1
    }
    i <- i+1
}
print("Bracket Matching")
print(bracketList)

"Run code"
print("Running BF code")
code_pointer <- 1
memory <- rep(0,20000)
memory_pointer <- 1
input_pointer <- 1
outputs <- character()

while (code_pointer <= length(code)) {
    char <- code[code_pointer]
    #print(paste("Excuting: ",char))
    if (char == "<") {
        memory_pointer <- memory_pointer-1
    } else if (char == ">") {
        memory_pointer <- memory_pointer+1
    } else if (char == "+") {
        memory[memory_pointer] <- memory[memory_pointer] + 1
    } else if (char == "-") {
        memory[memory_pointer] <- memory[memory_pointer] - 1
    } else if (char == ",") {
        memory[memory_pointer] <- strtoi(inputsCSV[input_pointer])
        input_pointer <- input_pointer
    } else if (char == ".") {
        outputs <- append(outputs,memory[memory_pointer])
        print(memory[memory_pointer])
    } else if (char == "]") {
        if (memory[memory_pointer] != 0) {
            code_pointer = strtoi(bracketList[code_pointer])
        }
    }
    code_pointer <- code_pointer+1
}
if (plotOutputs == True) {
    par(pch=22, col="red")
    outputNum = c(1:length(outputs))
    heading="BF outputs"
    plot(outputNum, outputs, main=heading)
    lines(outputNum, outputs, type="l")
}


#extract commit log from each relase cycle

##### set from args #####
args<-commandArgs(trailingOnly=T)

#check the number of arguments
if(length(args) == 0){
  print("use default setting (for Chromium), --args 42 2 2014-06-20 24")
  release_cycle<-42#days(= 6 weeks = 1.5month)
  threshold<-2#commits/release_cycle
  newest_release_date<-as.Date("2014-06-20")#ver37
  num_release<-24#: a number of past release to trace
}else if(length(args) != 4){
  write("Error: commandline arguments for <release_cycle(days)> <threshold of commits> <newest release date(yyyy-mm-dd)> <the number of going back release> are required", stderr())
  q()
}else{
  release_cycle<-as.numeric(args[1])
  threshold<-as.numeric(args[2])
  newest_release_date<-as.Date(args[3])
  num_release<-as.numeric(args[4])
}
# import merged git log file
git_log.df<-read.csv("git_log_main_change_merged.csv",header=T)
git_log.df$author_date<-as.Date(git_log.df$author_date)
git_log.df$author_mail<-as.character(git_log.df$author_mail)
#filtering
activity.df<-data.frame(1:num_release,1:2)
names(activity.df)<-c("Duration","Effort")
for(i in 1:num_release){
  git_log_tmp.df<-subset(git_log.df,git_log.df$author_date<(newest_release_date-release_cycle*(i-1)) & (newest_release_date-release_cycle*i)<=git_log.df$author_date)
  auth_freq.df<-data.frame(table(git_log_tmp.df$author_mail))
  names(auth_freq.df)<-c("author_mail","commit_count")

  activity.df$Duration[i]<-paste(newest_release_date-release_cycle*(i-1),"-",newest_release_date-release_cycle*i,sep="")
  # In original paper, non-fulltime developers' effort is caliculated by commit_count/threshold, so using ">="
  # http://gsyc.urjc.es/~grex/repro/2014-msr-effort/msr14-robles-estimating-effort.pdf
  fulltime_auth.df<-subset(auth_freq.df,auth_freq.df$commit_count>=threshold)
  parttime_auth.df<-subset(auth_freq.df,auth_freq.df$commit_count<threshold)
  parttime_auth.df$effort<-parttime_auth.df$commit_count/threshold
  # 28 = 1 month
  activity.df$Effort[i]<-(nrow(fulltime_auth.df)+sum(parttime_auth.df$effort))*(release_cycle/28)
  activity.df$commits[i]<-nrow(git_log_tmp.df)
  activity.df$bugfix_commits[i]<-nrow(subset(git_log_tmp.df,git_log_tmp.df$bug_fix==1))
  activity.df$refactoring_commits[i]<-nrow(subset(git_log_tmp.df,git_log_tmp.df$refactoring_flag==1))
  activity.df$newfunc_commits[i]<-nrow(subset(git_log_tmp.df,git_log_tmp.df$bug_fix!=1 & git_log_tmp.df$refactoring_flag!=1))
  activity.df$add_lines[i]<-sum(git_log_tmp.df$add_lines)
  activity.df$del_lines[i]<-sum(git_log_tmp.df$del_lines)
  activity.df$change_files[i]<-sum(git_log_tmp.df$change_files)

  ##temporary dataframe output
  #write.csv(auth_freq.df,paste("author_activity_from_",(newest_release_date-release_cycle*i),"_to_",(newest_release_date-release_cycle*(i-1)),".csv",sep=""),row.names=F)
}
write.csv(activity.df,paste("chromium_activity_metrics.csv",sep=""),row.names=F)


context("Utilities")

test_that("finite.cases.data.frame", {
  # All finite --------------------------------------------------------------
  expect_identical(finite.cases(data.frame(x=4)),            TRUE)          # 1x1
  expect_identical(finite.cases(data.frame(x=4, y=11)),      TRUE)          # 1x2
  expect_identical(finite.cases(data.frame(x=4:5)),          c(TRUE, TRUE)) # 2x1
  expect_identical(finite.cases(data.frame(x=4:5, y=11:12)), c(TRUE, TRUE)) # 2x2

  # Has one NA --------------------------------------------------------------
  expect_identical(finite.cases(data.frame(x=NA)),                  FALSE)           # 1x1
  expect_identical(finite.cases(data.frame(x=4, y=NA)),             FALSE)           # 1x2
  expect_identical(finite.cases(data.frame(x=c(4,NA))),             c(TRUE,  FALSE)) # 2x1
  expect_identical(finite.cases(data.frame(x=c(4,NA), y=c(11,NA))), c(TRUE,  FALSE)) # 2x2
  expect_identical(finite.cases(data.frame(x=c(4,NA), y=c(NA,12))), c(FALSE, FALSE)) # 2x2
  expect_identical(finite.cases(data.frame(x=c(4,5),  y=c(NA,12))), c(FALSE, TRUE))  # 2x2

  # Testing NaN and Inf, using miscellaneous data shapes --------------------
  expect_identical(finite.cases(data.frame(x=c(4,NaN))),              c(TRUE, FALSE))
  expect_identical(finite.cases(data.frame(x=Inf)),                   FALSE)
  expect_identical(finite.cases(data.frame(x=c(4,5),  y=c(-Inf,12))), c(FALSE, TRUE))
})


#' @include geom-polygon.r
NULL

#' Polygons from a reference map
#'
#' This is pure annotation, so does not affect position scales.
#'
#' @eval rd_aesthetics("geom", "map")
#' @export
#' @param map Data frame that contains the map coordinates.  This will
#'   typically be created using [fortify()] on a spatial object.
#'   It must contain columns `x` or `long`, `y` or
#'   `lat`, and `region` or `id`.
#' @inheritParams layer
#' @inheritParams geom_point
#' @examples
#' # When using geom_polygon, you will typically need two data frames:
#' # one contains the coordinates of each polygon (positions),  and the
#' # other the values associated with each polygon (values).  An id
#' # variable links the two together
#'
#' ids <- factor(c("1.1", "2.1", "1.2", "2.2", "1.3", "2.3"))
#'
#' values <- data.frame(
#'   id = ids,
#'   value = c(3, 3.1, 3.1, 3.2, 3.15, 3.5)
#' )
#'
#' positions <- data.frame(
#'   id = rep(ids, each = 4),
#'   x = c(2, 1, 1.1, 2.2, 1, 0, 0.3, 1.1, 2.2, 1.1, 1.2, 2.5, 1.1, 0.3,
#'   0.5, 1.2, 2.5, 1.2, 1.3, 2.7, 1.2, 0.5, 0.6, 1.3),
#'   y = c(-0.5, 0, 1, 0.5, 0, 0.5, 1.5, 1, 0.5, 1, 2.1, 1.7, 1, 1.5,
#'   2.2, 2.1, 1.7, 2.1, 3.2, 2.8, 2.1, 2.2, 3.3, 3.2)
#' )
#'
#' ggplot(values) +
#'   geom_map(aes(map_id = id), map = positions) +
#'   expand_limits(positions)
#' ggplot(values, aes(fill = value)) +
#'   geom_map(aes(map_id = id), map = positions) +
#'   expand_limits(positions)
#' ggplot(values, aes(fill = value)) +
#'   geom_map(aes(map_id = id), map = positions) +
#'   expand_limits(positions) + ylim(0, 3)
#'
#' # Better example
#' if (require(maps)) {
#'
#'   crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests)
#'
#'   # Equivalent to crimes %>% tidyr::pivot_longer(Murder:Rape)
#'   vars <- lapply(names(crimes)[-1], function(j) {
#'     data.frame(state = crimes$state, variable = j, value = crimes[[j]])
#'   })
#'   crimes_long <- do.call("rbind", vars)
#'
#'   states_map <- map_data("state")
#'   ggplot(crimes, aes(map_id = state)) +
#'     geom_map(aes(fill = Murder), map = states_map) +
#'     expand_limits(x = states_map$long, y = states_map$lat)
#'
#'   last_plot() + coord_map()
#'   ggplot(crimes_long, aes(map_id = state)) +
#'     geom_map(aes(fill = value), map = states_map) +
#'     expand_limits(x = states_map$long, y = states_map$lat) +
#'     facet_wrap( ~ variable)
#' }
geom_map <- function(mapping = NULL, data = NULL,
                     stat = "identity",
                     ...,
                     map,
                     na.rm = FALSE,
                     show.legend = NA,
                     inherit.aes = TRUE) {
  # Get map input into correct form
  if (!is.data.frame(map)) {
    abort("`map` must be a data.frame")
  }
  if (!is.null(map$lat)) map$y <- map$lat
  if (!is.null(map$long)) map$x <- map$long
  if (!is.null(map$region)) map$id <- map$region
  if (!all(c("x", "y", "id") %in% names(map))) {
    abort("`map` must have the columns `x`, `y`, and `id`")
  }

  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomMap,
    position = PositionIdentity,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      map = map,
      na.rm = na.rm,
      ...
    )
  )
}

#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
GeomMap <- ggproto("GeomMap", GeomPolygon,
  draw_panel = function(data, panel_params, coord, map) {
    # Only use matching data and map ids
    common <- intersect(data$map_id, map$id)
    data <- data[data$map_id %in% common, , drop = FALSE]
    map <- map[map$id %in% common, , drop = FALSE]

    # Munch, then set up id variable for polygonGrob -
    # must be sequential integers
    coords <- coord_munch(coord, map, panel_params)
    coords$group <- coords$group %||% coords$id
    grob_id <- match(coords$group, unique(coords$group))

    # Align data with map
    data_rows <- match(coords$id[!duplicated(grob_id)], data$map_id)
    data <- data[data_rows, , drop = FALSE]

    polygonGrob(coords$x, coords$y, default.units = "native", id = grob_id,
      gp = gpar(
        col = data$colour, fill = alpha(data$fill, data$alpha),
        lwd = data$size * .pt
      )
    )
  },

  required_aes = c("map_id")
)


#-h-  doarth			  636  local   12/01/80  15:53:48
# doarth - do arithmetic operation
   include  defs

   subroutine doarth (argstk, i, j)
   integer argstk (ARGSIZE), i, j

   include COMMON_BLOCKS

   integer k, l
   integer ctoi

   character op

   k = argstk (i + 2)
   l = argstk (i + 4)
   op = evalst (argstk (i + 3))
   if (op == PLUS)
      call pbnum (ctoi (evalst, k) + ctoi (evalst, l))
   else if (op == MINUS)
      call pbnum (ctoi (evalst, k) - ctoi (evalst, l))
   else if (op ==  STAR )
      call pbnum (ctoi (evalst, k) * ctoi (evalst, l))
   else if (op ==  SLASH )
      call pbnum (ctoi (evalst, k) / ctoi (evalst, l))
   else
      call remark ('arith error')

   return
   end


require(pROC)

source(paste0(BASEDIR,'/example/lib/cross.validation.stats.r'))
source(paste0(BASEDIR,'/example/lib/cross.validation.caret.r'))
source(paste0(BASEDIR,'/example/lib/collapse-features.r'))

# task.ids (optional) only run on specific task ids
# n = number of bootstrap iterations
# mlmodels = type of algorithms supported by caret
# featuretable = type of OTU-type table to use (single item or vector) otufn_refseq, otufn_gg, taxafn_refseq, taxafn_gg
# debug.mode = print status to screen and save intermediate roc objects
run.cv.datasets <- function(taskfn="tasks.txt", task.ids=NULL, n=100, mlmodels = c("rf", "svmRadial", "svmLinear"),
                            featuretable="otufn_refseq", debug.mode=FALSE)
{
    tasks <- read.table(taskfn, sep="\t", head=T, quote="", as.is=T)

    # ROC for binary tasks only
    tasks_binary <- tasks[tasks$data_type=="binary",]

    # include only tasks where all featuretables have valid values
    tasks_binary <- tasks_binary[rowSums(is.na(tasks_binary[,featuretable,drop=F])) == 0,]

    data.ix <- 1:nrow(tasks_binary)
    if(length(task.ids) > 0)  data.ix <- which(tasks_binary$task_id %in% task.ids)
    tasks_binary <- tasks_binary[data.ix,]

    roc.list <- list()

    for(task.ix in 1:nrow(tasks_binary))
    {
        if(debug.mode) print(paste0("Starting dataset ", task.ix, ", ", tasks_binary[task.ix, "task_name"], "..."))

        # read in grouping vars, but make sure that they're compatible with variable naming due to caret package requirements
        task <- read.table(tasks_binary[task.ix, "taskfn"], sep="\t", comment="", row=1, head=T, quote="", check.names=F, colClasses="character")
        task$Var <- as.factor(make.names(task$Var))

        rocs <- NULL
        for(ftable.ix in 1:length(featuretable))
        {
            otu <- read.table(tasks_binary[task.ix, featuretable[ftable.ix]], sep="\t", comment="", row=1, head=T, check.names=F, quote="")
            otu <- t(otu)
            otu <- sweep(otu, 1, rowSums(otu), '/')
            prevalences <- apply(otu, 2, function(bug.col) mean(bug.col > 0))
            otu <- otu[, prevalences >= .10]
            ret <- collapse.by.correlation(otu, .95)
            otu <- otu[, ret$reps]

            valid_samples <- intersect(rownames(otu), rownames(task))
            otu <- otu[valid_samples,]
            task <- task[valid_samples,, drop=F]

            if(nrow(task) < 100) nfolds = -1 else nfolds = 5 # LOO for small sample sizes

            for(model.ix in 1:length(mlmodels))
            {
                roc.name <- mlmodels[model.ix]
                if(length(featuretable) > 1) # if more than 1 otu table, multiplex mlmodel and otutable names
                    roc.name <- paste(mlmodels[model.ix], featuretable[ftable.ix], sep="-")
                rocs[[roc.name]] <- cross.validation.stats(x=otu, y=task$Var, nfolds=nfolds, modelfun=mlmodels[model.ix], group.var=task$Group.Var, n=n)
            }
        }

        # name each list items as a task name, save roc objects to compare under that
        roc.list[[tasks_binary[task.ix, "task_name"]]] <- rocs

        # save intermediate roc.list objects, in case one dataset errors out
        if(debug.mode) save(roc.list, file="roc.list.autosave.RData")
    }
    invisible(roc.list)
}


# Ensemble gene noise for the CAP/Sepsis

library(parallel)

setwd("/media/yuri/Data/home1/GNI_data/infection/DataSciRep/")
# Read CORUM and KEGG gene ensembles annotations
load("org.Hs.core_paths.Rdat")
names(kegg_path) <- paste0("kegg:", names(kegg_path))
# redundant to Respiratory chain complex I (subcomplex I alpha), mitochondrial complex
corum_core$`mitochondrial respiratory chain complex I assembly` <- NULL
names(corum_core) <- paste0("complex:", names(corum_core))
core_paths <- c(corum_core, kegg_path)

setwd("/media/yuri/Data/home1/GNI_data/infection/ResultsSciRep/")
# Read CAP/Sepsis affymetrix data
load("GSE65682_series_all_mortality.Rdat")

# match genes between ensembles annotations and affymetrix data
core_paths_subset <- lapply(seq_along(core_paths), function(i) core_paths[[i]][ core_paths[[i]] %in% rownames(affyData_out) ] )
names(core_paths_subset) <- names(core_paths)
# select ensembles represented by more than 10 genes
core_paths_subset <- core_paths_subset[ sapply(core_paths_subset, length) >= 10 ]

# Calculate ensemble gene noise
affyDat_noise_paths <- lapply(seq_along(core_paths_subset), function(i) {
  cat(i, "\r")
  idx <- rownames(affyData_out) %in% core_paths_subset[[i]]
  dat <- affyData_out[idx,]
  res <- apply(dat, 2, var)
  res
})
names(affyDat_noise_paths) <- names(core_paths_subset)
affyDat_noise_paths <- do.call(cbind, affyDat_noise_paths)

# save ensemble gene noise for CAP
affyDat_noise_paths_CAP <- affyDat_noise_paths[pheno$d != "other", ]
pheno_CAP <- pheno[pheno$d != "other", ]

# save ensemble gene noise for Sepsis
affyDat_noise_paths_SPS <- affyDat_noise_paths[pheno$d != "cap", ]
pheno_SPS <- pheno[pheno$d != "cap", ]

setwd("/media/yuri/Data/home1/GNI_data/infection/ResultsSciRep")
save.image("CAP_Sepsis_Ensemble_noise.RDat")

################################################################################
# Estimate significance of association of ensemble gene noise with CAP and Sepsis

library(SuppDists)

setwd("/media/yuri/Data/home1/GNI_data/infection/ResultsSciRep")
load("CAP_Sepsis_Ensemble_noise.RDat")

# Estimate significance of association of ensemble gene noise with CAP
pheno_CAP$mort_num[pheno_CAP$mort == "NA"] <- -1

pR_CAP_stage <- apply(affyDat_noise_paths_CAP, 2, function(x) {
  df <- data.frame(x=x, age=pheno_CAP$age, d = pheno_CAP$d, mort = pheno_CAP$mort_num)

  # subtract the effect of age
  m00 <- lm(x ~ age, data=df)
  df$xr <- coefficients(m00)[[1]] + resid(m00)

  q = cor(df$xr, df$mort , method="kendall")
  r = nrow(df)
  res <- c(tau = q, p = pKendall(q,r, lower=F))
})
pR_CAP_stage <- data.frame(t(pR_CAP_stage))

padjR_CAP_stage <- pR_CAP_stage
padjR_CAP_stage$p <- p.adjust(padjR_CAP_stage$p, "bonferroni")
# padjR_CAP_stage[grep("mitoch", rownames(padjR_CAP_stage)),]

padjR_CAP_stage_sig <- padjR_CAP_stage[padjR_CAP_stage$p <= 0.05,]
padjR_CAP_stage_sig_UP <- padjR_CAP_stage_sig[padjR_CAP_stage_sig$tau > 0,]
padjR_CAP_stage_sig_DOWN <- padjR_CAP_stage_sig[padjR_CAP_stage_sig$tau < 0,]

# Estimate significance of association of ensemble gene noise with Sepsis
pheno_SPS$mort_num[pheno_SPS$mort == "NA"] <- -1

pR_SPS_stage <- apply(affyDat_noise_paths_SPS, 2, function(x) {
  df <- data.frame(x=x, age=pheno_SPS$age, d = pheno_SPS$d, mort = pheno_SPS$mort_num)

  # subtract the effect of age
  m00 <- lm(x ~ age, data=df)
  df$xr <- coefficients(m00)[[1]] + resid(m00)

  q = cor(df$xr, df$mort , method="kendall")
  r = nrow(df)
  res <- c(tau = q, p = pKendall(q,r, lower=F))
})
pR_SPS_stage <- data.frame(t(pR_SPS_stage))
padjR_SPS_stage <- pR_SPS_stage
padjR_SPS_stage$p <- p.adjust(padjR_SPS_stage$p, "bonferroni")
# padjR_SPS_stage[grep("mitoch", rownames(padjR_SPS_stage)),]

padjR_SPS_stage_sig <- padjR_SPS_stage[padjR_SPS_stage$p <= 0.05,]
padjR_SPS_stage_sig_UP <- padjR_SPS_stage_sig[padjR_SPS_stage_sig$tau > 0,]
padjR_SPS_stage_sig_DOWN <- padjR_SPS_stage_sig[padjR_SPS_stage_sig$tau < 0,]

setwd("/media/yuri/Data/home1/GNI_data/infection/ResultsSciRep")
save.image("CAP_Sepsis_Ensemble_noise_sig.RDat")


### Iterate factor scores and clustering via mean imputation by typology
library(wordspace)

this.dir<- dirname(parent.frame(2)$ofile)
parent.dir <- strsplit(this.dir,'scripts')[[1]]
setwd(parent.dir)

get_data <- function () {
  datafile <- 'data/urbandata2019-64var-id-sorted-updated.csv'
  print(paste0("Step 1: read in appropriate dataset",datafile))
  data <- read.csv(datafile)
  head(data)
  return(data)
}

data1 <- get_data()
data_scaled_missing <- read.csv('data/urbandata2019-64var-id-sorted-updated-missing.dat',sep="\t",header=FALSE)
data_scaled_missing[data_scaled_missing=="."]<-NA
data_scaled_missing <- apply(as.matrix(data_scaled_missing), 2, as.numeric)

data1[,c(1:64)] <- data_scaled_missing
indexcols <- read.csv('data/urbandata2019-64var-citynames-countries-updated.csv')[,1:4]
data1 <- cbind(indexcols,data1)

impute_iterate <- function (n) {
  num_clust = 13 #optimal starting number
  print("Step 2: starting zeroth iteration: factor scores on mean imputed data")
  source('scripts/fscore-analyses.r') # computes the first round of factor scores (check right loadings and data are used)
  print("Step 3: zeroth clustering step")
  source('scripts/cluster-analyses.r')
  print("Step 4: iterate over mean imputation by cluster")
  for (i in c(1:n)){
    if (i>1){
      clustermeans_old <- clustermeans
      print(head(clustermeans_old)[,1:4])
    }
    print(paste0("Step ",i+3,"a: perform mean imputation by cluster"))
    source('scripts/typology-mean-iteration.r')
    print(head(clustermeans)[,1:4])
    print(paste0("Step ",i+3,"b: get updated scores"))
    scores <- getScore(data3,loading)
    print(paste0("Step ",i+3,"c: perform clustering on updated scores"))
    source('scripts/cluster-analyses.r')
    print(paste0("Step ",i+3,"d: perform next iteration"))
    if (i>1){
      print(head(as.matrix(clustermeans)-as.matrix(clustermeans_old))[,1:4])
      normdiff <- mean(rowNorms(as.matrix(clustermeans)-as.matrix(clustermeans_old)))
      print(paste0("Iteration ",i, ": Norm of diff clustermeans: ", normdiff))
    }
  }
  num_clust = 12 #for final typology grouping
}

impute_iterate(6)
num_clust = 12 #for final grouping


fizzbuzz <- function(num) {
    if (num %% 3 == 0 && num %% 5 == 0) {
        print("FizzBuzz")
    } else if (num %% 3 == 0) {
        print("Fizz")
    } else if (num %% 5 == 0) {
        print("Buzz")
    } else {
        print(num)
    }

}
sapply(1:100, function(x) fizzbuzz(x))


# Script to generate a pie chart of the modal split
# This needs two inputs: A MATSim file (sth) and an output path

#!/usr/bin/env Rscript
# Read in the runtime arguments
args = commandArgs(trailingOnly=TRUE)

if(length(args)<2){

stop("You need to specify two arguments for that call (input MATSim file and output image file). Aborting.", call.=FALSE)

} else {

# Read args[1] (input file)
data <- read.table(args[1],header=TRUE,sep="\t")

labels <- list()
values <- list()

i = 7
while(i < length(data)){

name <- sub("departures_","\\2",names(data[i]))
sum <- sum(data[i])

if(name != "transit_walk"){

labels<-c(labels, name)
values<-c(values, sum)

}

i<-i+4

}

# Plot the chart to the location defined in the runtime args
png(filename=args[2])

# Create the chart
labels <- unlist(labels)
values <- unlist(values)

pct <- round(values/sum(values)*100)
labels <- paste(labels, pct)
labels <- paste(labels, "%", sep="")

chart <- pie(values, labels, main="Modal Split")

dev.off()

}


#' Plot CV for F, SSB, and Recruitment
#'
#' Summary plot of estimated precision over time.
#' @param asap name of the variable that read in the asap.rdat file
#' @param a1 list file produced by grab.aux.files function
#' @param save.plots save individual plots
#' @param od output directory for plots and csv files
#' @param plotf type of plot to save
#' @export

PlotCV <- function(asap,a1,save.plots,od,plotf){
  if (any(!is.na(a1$asap.std))){
    par(mfrow=c(1,1), mar=c(4,4,2,2)  )

    years = seq(asap$parms$styr, asap$parms$endyr)
    asap.std <- a1$asap.std
    F.rep = asap.std[asap.std$name=="Freport",3]
    cv.F.rep = asap.std[asap.std$name=="Freport",4]/F.rep
    ssb.vec = asap.std[ asap.std$name=="SSB",3]
    cv.ssb.vec = asap.std[ asap.std$name=="SSB",4]/ssb.vec
    rec.vec = asap.std[ asap.std$name=="recruits", 3]
    cv.rec.vec = asap.std[asap.std$name=="recruits", 4]/rec.vec

    plot(years,   cv.rec.vec, type='l', lwd=2, col='black', xlab="Year", ylab="CV",
         ylim=c(0, 1.1*max(cv.rec.vec, cv.ssb.vec, cv.F.rep))  )
    lines(years, cv.ssb.vec, lwd=2, col="blue")
    lines(years, cv.F.rep, lwd=2, col="green3")
    legend('top', legend=c("Recr.", "SSB", "Freport"), col=c("black", "blue", "green3"),
           lty=rep(1,3), lwd=rep(2,3), horiz=T)

    if (save.plots==T) savePlot(paste0(od, 'CV.estimates.', plotf), type=plotf)
  }
  return()
}  # end function


#' SARC style plot of recruitment and SSB
#'
#' Recruitment lagged to match SSB (recr years 2:nyears; SSB years 1:(nyears-1)).
#' @param asap name of the variable that read in the asap.rdat file
#' @param save.plots save individual plots
#' @param od output directory for plots and csv files
#' @param plotf type of plot to save
#' @export

PlotSARCrecSSB <- function(asap,save.plots,od,plotf){

  par( mar = c(5,5,1,5), oma = c(0,0,0,1), family='serif')

  years = seq(asap$parms$styr, asap$parms$endyr)
  nyears<-asap$parms$nyears
  ssb <- asap$SSB
  recr <- asap$N.age[,1]
  ssb.plot<- ssb[1:(nyears-1)]
  recr.plot<- recr[2:nyears]
  yr.text=substr(years,3,4)

  scale.ssb=1
  scale.recruits=1

  scale.r= max(ssb.plot/scale.ssb)/max(recr.plot/scale.recruits)
  barplot( recr.plot/scale.recruits*scale.r , beside=T,axisnames=F , width=1,
           space=rep(0,nyears-1), offset=rep(-0.5,nyears-1),  axes=F, xpd=F,
           xlab = '', ylab ='', ylim = c(0,1.1*max(recr.plot/scale.recruits*scale.r)), xlim=c(0.5,nyears-1.5), col="lightcyan2")
  xr <-pretty(recr.plot/scale.recruits)
  axis(2, at = xr*scale.r, lab = xr )
  axis(side=1, las=2, at=seq(0.5,asap$parms$nyears-1.5, by=2),
       labels=as.character(seq(years[1],years[nyears-1], by=2)), cex=0.75, las=2)

  lines(seq(0.5,nyears-1.5, by=1), ssb.plot/scale.ssb, lwd=2, col = 'navyblue')
  x <- pretty(ssb.plot/scale.ssb)
  axis(4, at = c(0,x), lab = c(0,x), col='navyblue', col.axis="navyblue")
  box()

  mtext(side = 1, 'Year', line = 3)
  mtext(side = 4, 'SSB (year)', line = 3, col='navyblue')
  mtext(side = 2, 'Age-1 Recruits (year-class)', line = 3)

  if (save.plots==T) savePlot(paste0(od, 'SARC.SSB.vs.R.barplots.', plotf), type=plotf)
  par(family="")
  return()
}  # end function


#!/usr/bin/env Rscript
# From https://github.com/berkeley-dsep-infra/datahub/issues/881
print("Installing packages for PH142")

source("/tmp/class-libs.R")

class_name = "PH142"

class_libs = c(
    "fGarch", "3042.83.1",
    "SASxport", "1.6.0",
    "googlesheets", "0.3.0",
    "googledrive", "0.1.3",
    "ggrepel", "0.8.1",
    "infer", "0.4.0.1",
    "janitor", "1.2.0",
    "latex2exp", "0.4.0",
    "measurements", "1.3.0",
    "dagitty", "0.2-2",
    "cowplot", "1.0.0",
    "rlang", "0.4.7"
)

class_libs_install_version(class_name, class_libs)

print("Installing patchwork...")
devtools::install_github('thomasp85/patchwork', ref='36b4918', upgrade_dependencies=FALSE, quiet=TRUE)

print("Installing tigris...")
devtools::install_github('walkerke/tigris', ref='78d1e44ccc1f561342078c0e79d0415fa4396389', upgrade_dependencies=FALSE, quiet=TRUE)

print("Installing googlesheets4")
devtools::install_github("tidyverse/googlesheets4", ref='9348a37511c45257f2aceadf76674a601740e708', upgrade_dependencies=FALSE, quiet=TRUE)

print("Done installing packages for PH142")


if (FALSE){
	install.packages("ggplot2", repo="http://cran.us.r-project.org")
	install.packages("ggfortify", repo="http://cran.us.r-project.org")
	install.packages("data.table", repo="http://cran.us.r-project.org")
	install.packages("ggrepel", repo="http://cran.us.r-project.org")
}
library(plyr)
library(ggplot2)
library(grid)
library(data.table, quietly=T)
library(ggfortify)

if (FALSE) {
	library("ggrepel")
}

#data <- read.table(file="system_file/pca/pca.txt", sep="\t", quote="", comment="", header=T, row.names=1, check.names=F)

if (1 == 0){
        data <- read.table(file="system_file/pca/pca.txt", sep="\t", header=T, row.names=1,
                check.names=F, quote="", comment="")
} else if (1 == 1) {
        data <- read.table(file="system_file/pca/pca.txt", sep="\t", header=T, row.names=NULL,
                check.names=F, quote="", comment="")
        rownames_data <- make.names(data[,1],unique=T)
        data <- data[,-1,drop=F]
        rownames(data) <- rownames_data
}

data <- data[rowSums(abs(data))!=0, ]

data$mad <- apply(data, 1, mad)

data <- data[data$mad>0.5, ]

data <- data[order(data$mad, decreasing=T), 1:(dim(data)[2]-1)]

dim_data <- dim(data)

data_row_num <- dim_data[1]

if (5000 != 0 & 5000 < data_row_num) {
	data <- data[1:5000, ]
}

data <- as.data.frame(t(data))

sampleL = rownames(data)

if ("system_file/pca/pcaphenodata_.txt" == "") {
	data_t_label <- data
	data_t_label$group = sampleL
	data_t_label$Row.names = sampleL
} else {
	grp_data <- read.table("system_file/pca/pcaphenodata_.txt", sep="\t", quote="", header=T, check.names=F, row.names=NULL, comment="")
	rownames(grp_data) <- grp_data[,1]
	data_t_label <- merge(data, grp_data, by=0, all.x=T)
	rownames(data_t_label) <- data_t_label$Row.names
	data_t_label <- data_t_label[match(sampleL, data_t_label$Row.names), ]
	#data_t_label <- grp_data[na.omit(sampleL, rownames(grp_data)), ]
}

shape_order <- c()

if ("Batch" != "c_t_c_t0304") {
if (length(shape_order) > 1) {
	data_t_label$Batch <- factor(data_t_label$Batch, levels=shape_order, ordered=T)
} else {
	data_t_label$Batch <- factor(data_t_label$Batch)
}
}

color_order <- c()

if (length(color_order) > 1) {
	data_t_label$Conditions <- factor(data_t_label$Conditions, levels=color_order, ordered=T)
}

if ("nolog" != "nolog"){
	data <- nolog(data + 0)
}

color_v <- c()

if ("Batch" != "c_t_c_t0304") {
	shape_level <- length(unique(data_t_label$Batch))
	shapes = (1:shape_level)%%30
}

pca <- prcomp(data, scale=TRUE)

rotation = pca$rotation

  outputprefix = "system_file/pca/pca.txt"
  if (outputprefix == "") {
  outputprefix = "system_file/pca/pca.txt"
}

write.table(rotation, file=paste0(outputprefix,".pca.weights.xls"), sep="\t", quote=F, row.names=T, col.names=T)

system("sed -i 's/^/ID\t/' system_file/pca/pca.txt.pca.weights.xls")

x = pca$x

write.table(x, file=paste0(outputprefix,".pca.pcs.xls"), sep="\t", quote=F, row.names=T,  col.names=T)

system("sed -i 's/^/ID\t/' system_file/pca/pca.txt.pca.pcs.xls")

# sdev: standard deviation of the principle components.
# Square to get variance
percentVar <- pca$sdev^2 / sum( pca$sdev^2)

percentVar2 <- as.data.frame(percentVar)
rownames(percentVar2) <- colnames(x)

write.table(percentVar2, file=paste0(outputprefix,".pca.pc_variance.xls"), sep="\t", quote=F, row.names=T)

if (2 == 2) {
	p <- autoplot(pca, data=data_t_label, alpha=0) + ggtitle("")+coord_fixed()

	if ("Diameters" != ""){
		p <- p + aes(size=Diameters)
	}
	if ("Conditions" != "c_t_c_t0304") {
		p <- p + aes(colour=Conditions)
		if (length(color_v) >= 2) {
			if (is.numeric(data_t_label$Conditions)){
				p <- p + scale_colour_gradient(low=color_v[1], high=color_v[2], name="Conditions")
			}else {
				p <- p + scale_color_manual(values=color_v)
			}
		}
	}

	if ("Batch" != "c_t_c_t0304") {
		p <- p + aes(shape=Batch)
		if ( shape_level > 6) {
			p <- p + scale_shape_manual(values=shapes)
		}
	}
	#if (("Diameters" != "") && ("Conditions" != "c_t_c_t0304") && ("Batch" != "c_t_c_t0304")) {
	#	p <- autoplot(pca, data=data_t_label, colour="Conditions", shape="Batch", size="Diameters", alpha=0)
	#} else if (("Conditions" != "c_t_c_t0304") && ("Batch" != "c_t_c_t0304")) {
	#	p <- autoplot(pca, data=data_t_label, colour="Conditions", shape="Batch",alpha=0)
	#} else if (("Diameters" != "") && ("Batch" != "c_t_c_t0304")) {
	#	p <- autoplot(pca, data=data_t_label, shape="Batch", size="Diameters", alpha=0)
	#} else if (("Diameters" != "") && ("Conditions" != "c_t_c_t0304")) {
	#	p <- autoplot(pca, data=data_t_label, colour="Conditions", size="Diameters", alpha=0)
	#} else if ("Diameters" != "") {
	#	p <- autoplot(pca, data=data_t_label, size="Diameters", alpha=0)
	#} else if ("Conditions" != "c_t_c_t0304") {
	#	p <- autoplot(pca, data=data_t_label, colour="Conditions", alpha=0)
	#} else if ("Batch" != "c_t_c_t0304") {
	#	p <- autoplot(pca, data=data_t_label, shape="Batch", alpha=0)
	#} else {
	#	p <- autoplot(pca, data=data_t_label)
	#}

	#if (("Conditions" != "c_t_c_t0304") && length(color_v) == 2) {
	#	p <- p + scale_colour_gradient(low=color_v[1], high=color_v[2], name="Conditions")
	#}

	#if (("Batch" != "c_t_c_t0304") && shape_level > 6) {
	#	p <- p + scale_shape_manual(values=shapes)
	#}

	if (FALSE) {
		#p <- p + geom_text(aes(label=Row.names), position="identity",
		#hjust=0, size=0, check_overlap=FALSE)
		if ("0" != "") {
			p <- p + geom_text_repel(aes(label=Row.names), show.legend=F, size=0)
		} else {
			p <- p + geom_text_repel(aes(label=Row.names), show.legend=F)
		}
	}

	p <- p + xlab(paste0("PC1 (", round(percentVar[1]*100), "% variance)")) +
		ylab(paste0("PC2 (", round(percentVar[2]*100), "% variance)"))

	p <- p

  ggsave(filename = paste0(outputprefix, '.pca.pdf'),p)

} else {
	library(scatterplot)
	if ("Conditions" != "c_t_c_t0304") {
		group = data_t_label$Conditions
		colorA <- rainbow(length(unique(group)))

		colors <- colorA[as.factor(group)]

		colorl <- colorA[as.factor(unique(group))]
	}

	if ("Batch" != "c_t_c_t0304") {
		# 获得PCH symbol列表
		group <- data_t_label$Batch
		pch_l <- as.numeric(as.factor(unique(group)))
		# 产生每个样品的pch symbol
		pch <- pch_l[as.factor(group)]
	}

	pc <- as.data.frame(pca$x)
	outputprefix = "system_file/pca/pca.txt"
  if (outputprefix == "") {
  outputprefix = "system_file/pca/pca.txt"
}
	filename = paste0(outputprefix, '.pca.pdf')

	pdf(filename)
	scatterplot3d(x=pc$PC1, y=pc$PC2, z=pc$PC3, pch=pch, color=colors, xlab=paste0("PC1 (", round(percentVar[1]*100), "% variance)"), ylab=paste0("PC2 (", round(percentVar[2]*100), "% variance)"), zlab=paste0("PC3 (", round(percentVar[3]*100), "% variance)"))

	legend(-3,8, legend=levels(as.factor(Conditions)), col=colorl, pch=pch_l, xpd=T, horiz=F, ncol=6)
	dev.off()
}


#  James Rekow

algorithmTestSuite = function(algorithmTestFile, iStrength = 1, sigmaMax = 0.1, thresholdMult = 10 ^ (-1),
                              maxSteps = 10 ^ 4, tStep = 10 ^ (-2), intTime = 1, interSmplMult = 0.01,
                              conGraph = NULL, rollRange = 0.025, numReplicates = 3, numClustKnown = TRUE){

  #  ARGS:
  #
  #  RETURNS: percentErrorDF - data frame containing columns for all the input data and the average
  #                            percent of samples placed in the wrong subgroup in each treatment

  source(algorithmTestFile)

  algorithmTestCharName = strsplit(algorithmTestFile, "\\.")[[1]][1]

  #  source("identifySubgroupsVer1Test_Exp_Weight.r")
  #  numClust = KNOWN
  #
  #  inputs:
  #    1: M = 40, N = 20, lambda = 0, univ = 1, numSubgroups = 2   : standard case
  #    2: M = 100, N = 20, lambda = 0, univ = 1, numSubgroups = 2  : large M
  #    3: M = 40, N = 20, lambda = 0, univ = 1, numSubgroups = 6   : lot's of subgroups
  #    4: M = 100, N = 20, lambda = 100, univ = 1, numSubgroups = 6: large M, many subgrps, interactions
  #    5: M = 40, N = 20, lambda = 0, univ = 0, numSubgroups = 2   : no universality

  #  default setting is that number of clusters in each treatment is unknown
  numClust = NULL

  input = vector("list", 5)
  input[[1]] = c(40, 20, 2, 0, 1)
  input[[2]] = c(100, 20, 2, 20, 1)
  input[[3]] = c(40, 20, 6, 0, 1)
  input[[4]] = c(100, 20, 6, 100, 1)
  input[[5]] = c(40, 20, 2, 0, 0)

  #  create a matrix of all unique combinations of elements from Mvec, NVec, lambdaVec, and univVec
  inputMat = Reduce(rbind, input)

  performAlgorithmTest = function(inputVec){

    #  ARGS: inputVec - vector of input values from inputMat which are fed to the algorithm to be tested
    #
    #  RETURNS: meanPercentError - the mean percent error of the algorithm with the given inputs

    #  extract input values
    MVec = inputVec[1]
    NVec = inputVec[2]
    numSubgroupsVec = inputVec[3]
    lambdaVec = inputVec[4]
    univVec = inputVec[5]

    treatmentArgList = list(MVec = MVec, NVec = NVec, numSubgroupsVec = numSubgroupsVec,
                            lambdaVec = lambdaVec, univVec = univVec, iStrength = iStrength,
                            sigmaMax = sigmaMax, thresholdMult = thresholdMult, maxSteps = maxSteps,
                            tStep = tStep, intTime = intTime, interSmplMult = interSmplMult,
                            conGraph = conGraph, rollRange = rollRange, numReplicates = numReplicates,
                            numClustKnown = numClustKnown)

    meanPercentError = do.call(algorithmTestCharName, args = treatmentArgList)[[6]]

    return(meanPercentError)

  } #  end performAlgorithmTest function

  meanPercentErrorVec = apply(inputMat, 1, performAlgorithmTest)

  meanPercentErrorDF = data.frame(M = inputMat[ , 1], N = inputMat[ , 2], numSubgroups = inputMat[ , 3],
                                  lambda = inputMat[ , 4], univVec = inputMat[ , 5],
                                  meanPercentError = meanPercentErrorVec)

  return(meanPercentErrorDF)

} #  end algorithmTestSuite function


#Here we first familiarize ourselves with the basic layout of the Shiny user interface. It is important to note, that while we set-up interactivity, user interactivity is not included within this first shiny App activity.

#ui.R
#	1. After initially loading the shiny library and relevant data, the overall UI is wrapped within the shinyUI function
#	2. Next, we define a page that is fluid (fluidPage)--that can change based on the user's input. For this page, we name it with a title (titlePanel)
#	3. The set-up of the page is one based on a template (sidebarLayout): a sidebar (sidebarPanel; on the left, from which the user will make their selections); and a main Panel (mainPanel) which is changes based on the user's input in the left side-bar panel
#	4. The mainPanel will display the PCA of the metrics, which is identified as "pcaplot". This object is created/assigned within the server.R script.

#server.R
#	1. The shiny library and relevant data is first loaded
#	2. We define the server for the Shiny app as something with both objects that are input (from the ui.R) and output (from the server.R)
#	3. We create a reactive Shiny plot that is output from server.R to ui.R with the function renderPlot. renderPlot is an reactive function that can take input data from the ui.R script and feed it into the server.R script. It then actively updates the information within its function. We name the object that has the renderPlot function to plot the PCAs as "pcaplot". "pcaplot" is then output and displayed through the ui.R within the plotOutput function.

library(shiny)	#First load shiny library
load("../pcas.RDATA")	#Load data

#Define the overall UI
shinyUI(
	#Use a fluid Bootstrap layout
	fluidPage(
		#Give the page a title
		titlePanel("Title"),
		#Define page with a sidebar panel and main panel
		sidebarLayout(
			#Sidebar Panel
			sidebarPanel(
				#We will fill this out later
			),
			#Create a spot for the plot
			mainPanel(
				plotOutput("pcaplot")
			)
		)

    )
 )

 #TASK:
 #1. Change the title to something more relevant, e.g., "PCA of Metrics"


rm(list=ls())

file.prefix  <- commandArgs()[4]

eigenval  <- read.table(file=paste(file.prefix, ".eval", sep=""), col.names=c("eigenvalues"))
eigenvect <- read.table(file=paste(file.prefix, ".pca.evec", sep=""), skip=1, col.names=c("FID", "IID", "PC1", "PC2", "PC3", "PC4", "PC5", "PC6", "PC7", "PC8", "PC9", "PC10", "batch"))

# ------------------------------------------------- #
# -- draw PC1-4 and show percentage of variation -- #
# ------------------------------------------------- #

pc.percent <- eigenval[1:10,1]/sum(eigenval[,1])
png(file=paste(file.prefix, ".4PCpairs.png", sep=""), width=900, height=720)
thelabels <- paste("PC", 1:4, "\n", format(pc.percent[1:4], digits=2), "%", sep="")
pairs(eigenvect[,3:6], col=eigenvect$batch, labels=thelabels, pch=19)
graphics.off()

# -------------------------------------------- #
# -- draw PC1-2 with color code reg batches -- #
# -------------------------------------------- #

min_x = min(eigenvect$PC1)*1.1
max_x = max(eigenvect$PC1)*1.1
min_y = min(eigenvect$PC2)*1.1
max_y = max(eigenvect$PC2)*1.1

# --------------- #
# -- variant 1 -- #
# --------------- #

batches_code <- unique(eigenvect$batch)
color_code <- rgb(runif(length(batches_code)),runif(length(batches_code)),runif(length(batches_code)))

# -- plot symbols -- #
# batches get '0'
# "HapMap" batches: 3x'17'
pch_code <- as.vector(unique(eigenvect$batch))
pch_code[pch_code != "HAPMAPCEU" & pch_code != "HAPMAPJPT" & pch_code != "HAPMAPCHB" & pch_code!="HAPMAPYRI"] <- 19
pch_code[pch_code=="HAPMAPCEU"] <- 17
pch_code[pch_code=="HAPMAPJPT"] <- 17
pch_code[pch_code=="HAPMAPCHB"] <- 17
pch_code[pch_code=="HAPMAPYRI"] <- 17
pch_code <- as.integer(pch_code)

# determine color vector for each entry of eigenvect
color_vect <- color_code[match(eigenvect$batch, batches_code)]
# determine symbol vector for each entry of eigenvect
pch_vect <- pch_code[match(eigenvect$batch, batches_code)]

# draw plot
png(file=paste(file.prefix, ".2PC.png", sep=""), width=900, height=720)
plot(eigenvect[3:4], xlim=c(min_x,max_x),ylim=c(min_y,max_y), pch=pch_vect, col=color_vect)
legend("topleft", legend=unique(eigenvect$batch), cex=0.7, pch=pch_code, col=color_code, text.col=rep("black", length(unique(eigenvect$batch))), bty="n")
graphics.off()

# --------------- #
# -- variant 2 -- #
# --------------- #

#png(file="PS_AS_IBD_PSC_SNPQCI_pruned_hapmap2.2PC.png", width=900, height=720)
#plot(eigenvect[2:3], xlim=c(min_x,max_x),ylim=c(min_y,max_y), pch=rep(1, length(unique(eigenvect$batch))), col=eigenvect$batch)
#####warnings()
#legend("topleft", legend=unique(eigenvect$batch), cex=0.7, pch=rep(1, length(unique(eigenvect$batch))), col=as.numeric(unique(eigenvect$batch)), text.col=rep("black", length(unique(eigenvect$batch))), bty="n")
##legend("topleft", legend=unique(eigenvect$batch), cex=0.7, pch=rep(1, length(unique(eigenvect$batch))), text.col=as.numeric(unique(eigenvect$batch)), col=as.numeric(unique(eigenvect$batch)), bty="n")
#####warnings()
#dev.off()

##### only 0-25 symbols available, otherwise this creates a warning, look at with warnings()
####pch_vector <- c(as.numeric(eigenvect$batch)%%26)
####png(file="PS_AS_IBD_PSC_SNPQCI_pruned_hapmap2.2PC.png", width=900, height=720)
####plot(eigenvect[2:3], xlim=c(min_x,max_x),ylim=c(min_y,max_y), pch=pch_vector, col=eigenvect$batch)
####warnings()
####dev.off()


#!/usr/bin/env Rscript
# For https://github.com/berkeley-dsep-infra/datahub/issues/2556
# For https://github.com/berkeley-dsep-infra/datahub/issues/2524
# For https://github.com/berkeley-dsep-infra/datahub/issues/2748
# For https://github.com/berkeley-dsep-infra/datahub/issues/2788
# Fall 2021
print("Installing packages for PH 252")

source("/tmp/class-libs.R")

class_name = "PH 252"

class_libs = c(
  "foreign", "0.8-81",
  "blm", "2013.2.4.4",
  "geepack", "1.3-2",
  "multcomp", "1.4-17",
  "epitools", "0.5-10.1",
  "rms", "6.2-0",
  "lmtest","0.9-38",
  "car","3.0-10",
  "SurvRegCensCov","1.4",
  "ProfileLikelihood","1.1",
  "biostat3","0.1.5"
)

devtools::install_github('cran/epi', ref='06efd3f', upgrade_dependencies=FALSE, quiet=FALSE)
devtools::install_github('kaz-yos/tableone', ref='7cfcd71', upgrade_dependencies=FALSE, quiet=FALSE)

class_libs_install_version(class_name, class_libs)

print("Done installing packages for PH 252")


import_package("ggplot2", attach=TRUE)
.b = import('../base')

.reverselog_trans = function(base=exp(1)) {
    scales::trans_new(paste0("log-", format(base)),
                      function(x) -log(x, base),
                      function(x) base^-x,
                      scales::log_breaks(base = base),
                      domain = c(1e-100, Inf))
}

.scientific_10 = function(x) {
    fmt = ifelse(x < 0.01, scales::scientific_format()(x), x)
    parse(text=gsub("1e", "10^", fmt))
}

#' Draw a volcano plot from calculated associations
#'
#' @param df         A data.frame obtained from the stats module.
#'                   Optionally, it can have the fields:
#'                     circle: draw a border around the circle [TRUE/FALSE]
#' @param base.size  Scaling factor for the points drawn
#' @param p          Line between significant and insignificant associations
#' @param ceil       Minimum p-value to set top associations to; default: 0, no filter
#' @param check_overlap  Don't print overlapping labels in geom_text()
#' @param xlim       Limits along the horizontal axis; default: fit data
#' @param ylim       Limits along the vertical axis; default: fit data
#' @param simplify   Drop some insignificant points and labels to reduce file size
#' @param repel      Whether to use repel package for labels
#' @param max_overlaps   Parameter passed to ggrepel if repel is TRUE
#' @param x_label_bias   Multiplier to focus more on effect size than significance
#' @param pos_label_bias Multiplier to focus more on positive than negative labels
#' @return           A ggplot2 object of the volcano plot
volcano = function(df, x = c("log2FoldChange", "estimate", ".x"),
                   label = c("label", "name", "gene_name", "gene", "external_gene_name", "set_name", "set"),
                   y = c("adj.p", "padj", "p.value", "pval", ".y"),
                   size = c("size", "n", "baseMean"),
                   base.size=1, p=0.05, label_top=20, ceil=0, check_overlap=FALSE,
                   text.size=3.5, xlim=NULL, ylim=NULL, simplify=TRUE, repel=TRUE, max.overlaps=20,
                   x_label_bias=1, pos_label_bias=1) {

    msg = c()
    if (length(x) > 1) {
        x = intersect(x, colnames(df))[1]
        msg = c(msg, paste(sQuote(x), "(x)"))
    }
    if (length(y) > 1) {
        y = intersect(y, colnames(df))[1]
        msg = c(msg, paste(sQuote(y), "(y)"))
    }
    if (length(label) > 1) {
        label = intersect(label, colnames(df))[1]
        msg = c(msg, paste(sQuote(label), "(label)"))
    }
    if (length(size) > 1) {
        size = intersect(size, colnames(df))[1]
        if (is.na(size)) {
            df$size = 1
            size = "size"
        }
        if (size == "baseMean") # better circle sizes
            df[[size]] = sqrt(df[[size]]) # should probably scale_size(...)
        msg = c(msg, paste(sQuote(size), "(size)"))
    }
    if (length(msg) > 0)
        message("[plot/volcano] using ", paste(msg, collapse=", "))

    sx = rlang::sym(x)
    sy = rlang::sym(y)
    sl = rlang::sym(label)

    if (nrow(df) == 0)
        stop("No observations to plot")
    if (!'circle' %in% colnames(df))
        df$circle = FALSE
    if (!'fill' %in% colnames(df))
        df$fill = TRUE

    df$color = rep(rgb(0, 151, 30, 120, maxColorValue=255), nrow(df)) # green
    df$color[df[[x]] < 0] = rgb(225, 0, 0, 120, maxColorValue=255) # red
    df$color[df[[y]] > p] = rgb(200, 200, 200, 120, maxColorValue=255) # grey

    # workaround display bugs for very small p-values
    ylab = waiver()
    df[[y]] = pmax(df[[y]], 1e-300)
    if (any(df[[y]] <= 1e-300, na.rm=TRUE)) {
        df[[y]] = 2^log10(pmin(df[[y]], 300))
        ylab = "Pseudo p-value (values too close to zero)"
    }

    # remove insignificant points outside x limits, adjust size
    if (any(df[[y]] < p, na.rm=TRUE))
        df = dplyr::filter(df, !! sy < p |
                           abs(!! sx) < max(abs((!! sx)[(!! sy)<p]),
                           na.rm=TRUE))

    df[[size]] = df[[size]] * base.size

    # set very low p-values to the cutoff value and label point
    # .Machine$double.eps too large, first != 0 too small
    if (ceil == 0 && any(df[[y]] == 0, na.rm=TRUE))
        ceil = min(df[[y]][df[[y]] > 1e-300], na.rm=TRUE)
    pmin = df[[y]] < ceil
    if (any(pmin, na.rm=TRUE)) {
        df[pmin,] = mutate(df[pmin,],
            !! sl := paste0(!! sl, " (p < 1e", ceiling(log10(!! sy)), ")"),
            !! sy := ceil)
    }

    # filter labels, but only for points we don't highlight
    rel_effect = df[[x]] / abs(df[[x]][rank(-abs(df[[x]]), ties.method="first") == 10])
    rel_effect[is.na(rel_effect)] = 0
    rel_pval = log10(df[[y]]) / log10(df[[y]][rank(df[[y]], ties.method="first") == 10])
    point_dist = abs(rel_effect) * x_label_bias + abs(rel_pval)
    point_dist[rel_effect > 0] = point_dist[rel_effect > 0] * pos_label_bias
    point_dist[df[[y]] > p] = NA
    point_dist[is.na(df[[label]])] = NA # only keep points where we have labels
    df[[label]][rank(-point_dist) > label_top & xor(df$fill, df$circle)] = NA

    # make sure we don't plot too many insignificant points
    if (simplify && sum(df[[y]] > p, na.rm=TRUE) > 800) {
        set.seed(123456)
        idx = which(df[[y]] >= .b$minN(df[[y]][df[[y]] > p], 100))
        prob = 1 - df[[y]][idx]+.Machine$double.eps*2
        prob[df$circle[idx]] = 1
        keep = sample(idx, size=500, replace=FALSE, prob=prob)
        df[[y]][setdiff(idx, keep)] = NA
        df[[label]][idx] = NA
    }

    breaks_with_thresh = function(...) c(p, scales::log_breaks(base=10)(df[[y]], 5))

    # and do the actual plot
    df = dplyr::arrange(df, - !! sy)
    pl = ggplot(df, aes_string(x = x, y = y)) +
        scale_y_continuous(trans = .reverselog_trans(base=10),
                           labels = .scientific_10,
                           limits = ylim,
                           breaks = breaks_with_thresh) +
        scale_x_continuous(limits = xlim) +
        geom_point(size = ifelse(df$fill, sqrt(df[[size]]), NA), color=df$color, na.rm=TRUE) +
        geom_point(size = ifelse(df$circle, sqrt(df[[size]]), NA),
                   shape=1, color=ifelse(df$fill, '#00000088', df$color), na.rm=TRUE) +
        geom_vline(xintercept=0, color="#858585") +
        geom_hline(yintercept=p, linetype="dashed", color="#858585") +
        ylab(ylab) +
        theme_classic()

    if (repel) {
        pl + ggrepel::geom_label_repel(aes_string(x=x, y=y, label=label),
                colour="#353535", size=text.size, na.rm=TRUE, segment.alpha=0.3,
                max.iter=1e5, max.time=5, max.overlaps=max.overlaps,
                label.size=NA, fill="#ffffff80",
                label.padding = unit(0.12, "lines"), box.padding = unit(0.01, "lines"))
    } else {
        pl + geom_text(aes_string(x=x, y=y, label=label), colour="#353535", size=text.size,
                      vjust=-1, na.rm=TRUE, check_overlap=check_overlap)
    }
}

if (is.null(module_name())) {
    library(testthat)

    df = data.frame(estimate = -12:12/12)
    df$adj.p = 10^(-10*abs(df$estimate))
    df$label = LETTERS[1:25]
    df$size = 1:25
    df$circle = rep(c(T,F,T,F,T),5)

    p = volcano(df)

    df$label[df$label %in% c("L", "N")] = NA
#    testthat::expect_equal(df, p$data)
}


# static rf

dt <- rbind.data.frame(division[[1]],division[[2]], division[[3]])

to_exclude <- c('Start_date','End_date','time.timestamp', 'activity_name_short', 'Activity_code','group_short',
                'Number_of_executions','Producer_code','Section','Specialism_code','activity_nr')

dt_static <- dt[,!(colnames(dt) %in% to_exclude)]
length(unique(dt_static$sequence_nr))
dt_static <- unique(dt_static)

# splitting frequent_events to different factors (R cannot handle more than 33 levels on rf)
features_to_factorize <- function(data) {
  names(which(unlist(lapply(data, function(x) length(levels(x))>=25))==TRUE))
}

frequent_events_to_factors <- function(data, feature){
  feature_freq <- as.data.frame(table(data[[feature]]))
  feature_freq <- feature_freq[order(feature_freq$Freq, decreasing = T),]
  total_nr_values <- nrow(feature_freq)
  pieces <- seq(1, total_nr_values, by=25)
  if (total_nr_values > pieces[length(pieces)]){
    pieces <- c(pieces, total_nr_values)
  }
  for (j in 1:(length(pieces)-1)){
    name <- paste('freq_', feature, '_', j, sep='')
    data[[name]] <- ifelse(data[[feature]] %in% feature_freq$Var1[pieces[j]:(pieces[j+1]-1)], as.character(data[[feature]]), 'other')
    #test_data[[name]] <- ifelse(test_data[[feature]] %in% train_data[[name]], as.character(test_data[[feature]]), 'other')
    #validation_data[[name]] <- ifelse(validation_data[[feature]] %in% train_data[[name]], as.character(validation_data[[feature]]), 'other')
  }
  return(data)
}

features_factorize <- features_to_factorize(dt_static)
dt_t <- dt_static[,!(colnames(dt_static) %in% features_factorize)]
#dt_test <- dt_test_static[,!(colnames(dt_test_static) %in% features_factorize)]

for (feat in features_factorize) { #timestamp excluded here:
  print(feat)
  division_prep <- frequent_events_to_factors(data=dt_static, feature=feat)
  dt_t <- merge(dt_t, division_prep, by=c('sequence_nr','label','Age','Diagnosis_code'))
  #dt_test <- merge(dt_test, dt_basic_test, by=c('sequence_nr','label','Age','Diagnosis_code'))
}

dt_t <- dt_t[,-grep('.x',colnames(dt_t), fixed = T)]
dt_t <- dt_t[,-grep('.y',colnames(dt_t), fixed = T)]
dt_t <- dt_t[,!(colnames(dt_t) %in% features_factorize)]
dt_t <- as.data.frame(unclass(dt_t))

dt_train_idx <- sample(nrow(dt_t), 0.8*nrow(dt_t))
dt_train <- dt_t[dt_train_idx,]
dt_test <- dt_t[-dt_train_idx,]
#subdf <- lapply(merged_res, function(x) if(is.factor(x) & nlevels(x)==1) x <- NULL else x)
#merged_res <- as.data.frame(subdf[-(which(sapply(subdf,is.null),arr.ind=TRUE))])

model <- randomForest(data=dt_train[,!names(dt_basic_train)%in% 'sequence_nr'], label~., na.action=na.omit)

predictions_bin <- predict(model, dt_test[,!names(dt_test)%in% 'sequence_nr'])
table(pred=predictions_bin, real=dt_test$label)
predictions_p <- predict(model, dt_test[,!names(dt_test)%in% 'sequence_nr'], type='prob')
roc_crv <- roc(dt_test$label, predictions_p[,'true'])


library(BiocManager)
library(sesame)
library(preprocessCore)
# after upgrading R3.6-->R4.1 I had to move cache: https://bioconductor.org/packages/devel/bioc/vignettes/ExperimentHub/inst/doc/ExperimentHub.html#default-caching-location-update
# sesameDataCache("MM285") # run this once, before you can read mouse
# version 3.13 DOCS HERE: https://bioconductor.org/packages/devel/bioc/vignettes/sesame/inst/doc/sesame.html

in_dir = paste0('/Users/mmaxmeister/methylprep/docs/example_data/mouse/')

savefiles = function(sdfs, idx, thisname) {
    x_thisframe <- data.frame(rbind( IG(sdfs[[idx]]), IR(sdfs[[idx]]), II(sdfs[[idx]]) ))
    x_filename <- paste0('sesame_mouse_', thisname ,'.csv', sep="")
    x_file <- file.path(in_dir, x_filename)
    write.csv(x_file, x=x_thisframe, row.names=TRUE, na="")
}

# RAW INTENSITY
sdfs <- lapply(searchIDATprefixes(in_dir), readIDATpair) #readIdat is for one file; readIDATpair is for pairs.
savefiles(sdfs, 1, 'raw')

# INFER
sdfs = lapply(sdfs, inferTypeIChannel, verbose=TRUE)
savefiles(sdfs, 1, 'infer')

# POOBAH ssets <- lapply(ssets, detectionMask) # poobah and qualityMask now set in sdf@extra$mask by readIDATpair
sdfs <- lapply(sdfs, pOOBAH)
savefiles(sdfs, 1, 'poobah') # doesn't save the poobah filtered part

### -- these don't return a modified sdf. so they need a new location.
# NOOB
sdfs.noob <- lapply(sdfs, noob) # creates a bunch more sdf objects in a list here
savefiles(sdfs.noob, 1, 'noob') # noob doesn't actually exclude poobah probes here? unless auto

# DYE-BIAS
sdfs.dye <- lapply(sdfs.noob, dyeBiasCorrTypeINorm)
savefiles(sdfs.dye, 1, 'dye')

# BETAS
betas <- lapply(sdfs.dye, getBetas) # this uses @extra$mask
write.csv(file.path(in_dir, 'sesame_mouse_betas.csv'), x=betas, row.names=TRUE, na="")

Rprof(tf <- "log.log", memory.profiling = TRUE)
idat_dir = paste0('/Volumes/LEGX/Barnes/mouse_test/')
betas= openSesame(idat_dir, BPPARAM=BiocParallel::MulticoreParam(2))
Rprof (NULL) ; print(summaryRprof(tf))
system.time( openSesame(idat_dir, BPPARAM=BiocParallel::MulticoreParam(2)) )
# sesame_version user     system elapsed
# 3.13           42.691   2.705  23.291

#python:
# df5 = pd.read_csv(path+'sesame_mouse_betas.csv').set_index('Unnamed: 0')
# mdf5 = pd.read_pickle(path+'beta_values.pkl')
# combined = pd.DataFrame(data={'ses':df5['X204879580038_R06C02'], 'mprep': mdf5['204879580038_R06C02']}, index=mdf5.index)
# (combined['mprep']- combined['ses']).hist(bins=200, range=[-0.05,0.05])


# Read previous scripts
# source("R/dm01_utils.R")

# Load packages

# tidyverse for data management and visualization; cowplot for multipanel
# plotting; mgcv for non-linear
# modelling; lubridicate for working with dates

packages <- c(
  "tidyverse",
  "openxlsx",
  "modelr",
  "cowplot",
  "GGally",
  "survival",
  "mgcv",
  "lubridate",
  "broom",
  "sf",
  "knitr",
  "gridExtra",
  "simstudy"
)

suppressMessages(
  ipak(packages)
)


# 3. faza: Vizualizacija podatkov

library(ggplot2)
library(tmap)

povprecje.dijakovindiplomantov.po.regijah <- tabela1nova %>% group_by(regija,kategorija) %>% summarise(povprecje=sum(stevilo)/10)
seznam <- split(povprecje.dijakovindiplomantov.po.regijah, povprecje.dijakovindiplomantov.po.regijah$kategorija)
povprecje.dijakov.po.regijah <- seznam[[1]]
povprecje.diplomantov.po.regijah <- seznam[[2]]
povprecje.dijakov.po.regijah <- povprecje.dijakov.po.regijah[-12,] %>% select(-"kategorija")
povprecje.diplomantov.po.regijah <- povprecje.diplomantov.po.regijah[-12,] %>% select(-"kategorija")

# GRAF POVPRECJA DIJAKOV IN DIPLOMANTOV PO REGIJAH

graf_povprecja_po_regijah <- ggplot(povprecje.dijakovindiplomantov.po.regijah, aes(x=regija, y=povprecje, fill=kategorija)) +
  geom_col(position = 'dodge')  +
  coord_flip() +
  labs(x = "Regija", y = "Povprečno število", title = "Povprečno število dijakov in diplomantov na leto \nv posameznih statističnih regijah") +
  scale_fill_discrete(name = "Kategorija", labels = c("število dijakov", "število diplomantov")) +
  scale_fill_brewer()

# TORTNI DIAGRAM DIPLOMANTOV GLEDE NA NACIN STUDIJA s knjižnjico plotrix

# f <- tabela4nova %>% group_by(studij) %>% summarise(vsota=sum(stevilo))
#tortnidiagram <- ggplot(f) + aes(x="", y = vsota,fill=studij) + geom_col(width=1) + coord_polar(theta="y") + xlab("") + ylab("") + scale_fill_discrete(name = "Študij", labels = c("izredni", "rednii")) +
#  ggtitle("Razmerje med diplomanti na izrednem in rednem študiju")

chem <- c('izredni','redni')
vol <- c(208787,708342)
png(file = "pie.jpg")
tortni <- pie3D(vol,labels = chem,explode = 0.1, main = 'Razmerje med diplomanti na izrednem ter rednem študiju',col=c('purple','lightblue',clockwise = T))
dev.off()

# ZEMLJEVIDA POVPREČNEGA DELEŽA DIPLOMANTOV IN DIJAKOV V ODSTOTKIH GLEDE NA ŠTEVILO PREBIVALCEV V POSAMEZNI REGIJI V DESETIH LETIH

povprecjedipl <- skupnatabela2 %>% group_by(regija) %>% summarise(povprecje=sum(delez)/10)
graf8 <- povprecjedipl %>% ggplot(aes(x=povprecje, y=regija, fill = regija)) + geom_col()

zemljevida <- uvozi.zemljevid("https://biogeo.ucdavis.edu/data/gadm3.6/shp/gadm36_SVN_shp.zip", "gadm36_SVN_1")
zemljevida$NAME_1[zemljevida$NAME_1 == "GoriĹˇka"] <- "Goriška"
zemljevida$NAME_1[zemljevida$NAME_1 == "KoroĹˇka"] <- "Koroška"
zemljevida$NAME_1[zemljevida$NAME_1 == "Notranjsko-kraĹˇka"] <- "Notranjsko-kraška"
zemljevida$NAME_1[zemljevida$NAME_1 == "Obalno-kraĹˇka"] <- "Obalno-kraška"
zemljevid2 <- tm_shape(merge(zemljevida, povprecjedipl, by.x="NAME_1", by.y="regija" )) +
  tm_polygons("povprecje",title="Delež (%)",palette="Purples")+
  tm_style("grey") +
  tm_layout(main.title="Povprečni delež diplomantov po regijah \nv zadnjih desetih letih glede na \nštevilo prebivalcev v posamezni regiji") + tm_text(text='NAME_1', size=0.6)

povprecjedij <- skupnatabela %>% group_by(regija) %>% summarise(povprecje=sum(delez)/10)
zemljevida2 <- uvozi.zemljevid("https://biogeo.ucdavis.edu/data/gadm3.6/shp/gadm36_SVN_shp.zip", "gadm36_SVN_1")

zemljevida2$NAME_1[zemljevida2$NAME_1 == "GoriĹˇka"] <- "Goriška"
zemljevida2$NAME_1[zemljevida2$NAME_1 == "KoroĹˇka"] <- "Koroška"
zemljevida2$NAME_1[zemljevida2$NAME_1 == "Notranjsko-kraĹˇka"] <- "Notranjsko-kraška"
zemljevida2$NAME_1[zemljevida2$NAME_1 == "Obalno-kraĹˇka"] <- "Obalno-kraška"

zemljevid3 <- tm_shape(merge(zemljevida2, povprecjedij, by.x="NAME_1", by.y="regija" )) +
  tm_polygons("povprecje",title="Delež (%)",palette="Blues")+
  tm_style("grey") +
  tm_layout(main.title="Povprečni delež dijakov po regijah \nv zadnjih desetih letih glede na \nštevilo prebivalcev v posamezni regiji")+ tm_text(text='NAME_1', size=0.6)

# ZEMLJEVID POVPRECJA DIPLOMANTOV PO REGIJAH, KI GA NA KONCU NISEM UPORABILA, KER JE ZEMLJEVID2 BOLJŠI NAČIN PRIKAZOVANJA

zemljevid <- uvozi.zemljevid("https://biogeo.ucdavis.edu/data/gadm3.6/shp/gadm36_SVN_shp.zip", "gadm36_SVN_1")

zemljevid$NAME_1[zemljevid$NAME_1 == "GoriĹˇka"] <- "Goriška"
zemljevid$NAME_1[zemljevid$NAME_1 == "KoroĹˇka"] <- "Koroška"
zemljevid$NAME_1[zemljevid$NAME_1 == "Notranjsko-kraĹˇka"] <- "Notranjsko-kraška"
zemljevid$NAME_1[zemljevid$NAME_1 == "Obalno-kraĹˇka"] <- "Obalno-kraška"

zemljevid1 <- tm_shape(merge(zemljevid, povprecje.diplomantov.po.regijah, by.x="NAME_1", by.y="regija" )) +
  tm_polygons("povprecje",title="Povprečje",palette="Purples") +
  tm_style("grey") +
  tm_layout(title="Povprečno število diplomantov po regijah v zadnjih desetih letih")

# GRAF POVPRECJA DIJAKOV GLEDE NA VRSTO IZOBRAZEVANJA IN SPOL (TO SEM KASNEJE PRIKAZALA V SHINYJU)

podatki5 <- tabela2nova %>% group_by(izobrazevanje, spol) %>% summarise(povprecje=sum(stevilo)/10)
graf5 <- ggplot(podatki5, aes(x=izobrazevanje, y=povprecje, fill = spol)) +
  geom_col(position = 'dodge')  +
  coord_flip() +
  labs(x = "Vrsta izobraževanja", y = "Povprečno število", title = "Povprečno število moških in žensk na leto v \nposameznih vrstah izobraževanj v \nzadnjih desetih letih") +
  scale_fill_discrete(name = "Spol", labels = c("moški", "ženski")) +
  scale_fill_brewer()

# GRAF POVPRECJA DIPLOMANTOV GLEDE NA VRSTO IZOBRAZEVANJA IN SPOL (TO SEM KASNEJE PRIKAZALA V SHINYJU)

podatki6 <- tabela3nova %>% group_by(izobrazevanje, spol) %>% summarise(povprecje=sum(stevilo)/10)
graf6 <- ggplot(podatki6, aes(x=izobrazevanje, y=povprecje, fill = spol)) +
  geom_col(position = 'dodge')  +
  coord_flip() +
  labs(x = "Vrsta izobraževanja", y = "Povprečno število", title = "Povprečno število diplomantov na leto  \nposameznih vrstah izobraževanj v \nzadnjih desetih letih") +
  scale_fill_discrete(name = "Spol", labels = c("moški", "ženski")) +
  scale_fill_brewer()

# POISKUSI
#graf2 <- ggplot(povprecje.diplomantov.po.regijah, aes(regija, povprecje, group = 1)) + geom_col() + coord_flip() +
#  labs(x = "Regija", y = "Povprecje",
#       title = "Povprečno število diplomantov po regijah v zadnjih desetih letih")
#m <- tabela2nova %>% group_by(izobrazevanje, spol) %>% summarise(povprecje=sum(stevilo)/10) %>%filter(spol == "moski") %>% select(-"spol")
#z <- tabela2nova %>% group_by(izobrazevanje, spol) %>% summarise(povprecje=sum(stevilo)/10) %>%filter(spol == "zenski")%>% select(-"spol")
#graf3 <- ggplot(m, aes(izobrazevanje, povprecje, group = 1)) + geom_col() + coord_flip() + labs(x = "Vrsta izobraževanja", y = "Število moških",
#                                                                                title = "Povprečno število moških v \nposameznih vrstah izobraževanj v \nzadnjih desetih letih")
#graf4 <- ggplot(z, aes(izobrazevanje, povprecje, group = 1)) + geom_col() + coord_flip()+ labs(x = "Vrsta izobraževanja", y = "Število žensk",
#                                                                                title = "Povprečno število žensk v \nposameznih vrstah izobraževanj v \nzadnjih desetih letih")
#v graf5 združimo graf3 in graf4


multiloop <- function(...)
{
   # Retrieve inputs and convert to a list of character strings
   arguments <- lapply(list(...), as.character)

   # Get length of each input
   lengths <- sapply(arguments, length)

   # Loop over elements
   for(i in seq_len(max(lengths)))
   {
      # Loop over inputs
      for(j in seq_len(nargs()))
      {
         # print a value or a space (if that input has finished)
         cat(ifelse(i <= lengths[j], arguments[[j]][i], " "))
      }
      cat("\n")
   }
}
multiloop(letters[1:3], LETTERS[1:3], 1:3)