library(rstan)
library(data.table)
library(lubridate)
library(gdata)
library(dplyr)
library(tidyr)
library(EnvStats) # For gammaAlt functions
library(optparse)

## Code addapted to handle Western Pacific countries for WHO Regional
## Office (WPRO). Additional comments added to translate methods from
## Imperial report:
## * Seth Flaxman, Swapnil Mishra, Axel Gandy et al. Estimating the number
## of infections and the impact of nonpharmaceutical interventions on
## COVID-19 in 11
## European countries. Imperial College London (30-03-2020)
## doi: https://doi.org/10.25561/77731.

rm(list = ls()) # Don't like doing this but just in case

# User Options ------------------------------------------------------------
countries <- c(
  "Philippines",
  "Malaysia" #,
  # "Laos"
)

options <- list("include_ncd" = TRUE,
  "npi_on" = TRUE,
  "fullRun" = FALSE,
  "debug" = FALSE)

# Commandline options and parsing
parser <- OptionParser()
parser <- add_option(parser, c("-D", "--debug"), action="store_true",
  help="Perform a debug run of the model")
parser <- add_option(parser, c("-F", "--full"), action="store_true",
  help="Perform a full run of the model")
cmdoptions <- parse_args(parser, args = commandArgs(trailingOnly = TRUE),
  positional_arguments = TRUE)

# Default run parameters for the model
if(is.null(cmdoptions$options$debug) || options$debug) {
  DEBUG = Sys.getenv("DEBUG") == "TRUE"
} else {
  DEBUG = cmdoptions$options$debug
}

if(is.null(cmdoptions$options$full) || options$fullRun) {
  FULL = Sys.getenv("FULL") == "TRUE"
} else {
  FULL = cmdoptions$options$full
}

if(DEBUG && FULL) {
  stop("Setting both debug and full run modes at once is invalid")
}

if(length(cmdoptions$args) == 0) {
  StanModel = 'base_general' # Version 2 model
} else {
  StanModel = cmdoptions$args[1]
}

print(sprintf("Running %s",StanModel))
if(DEBUG) {
  print("Running in DEBUG mode")
} else if (FULL) {
  print("Running in FULL mode")
}

## Reading all data -------------------------------------------------------
d=readRDS('data_wpro/COVID-19-up-to-date.rds')

## Ensure that output directories exist
dateResults <- max(as.Date(d$DateRep,format='%d/%m/%Y'))
resultsDir <- paste0("results/DateRep-",dateResults, "/")
figuresDir <- paste0("figures/DateRep-",dateResults, "/")
dir.create(resultsDir, showWarnings = FALSE, recursive = TRUE)
dir.create(figuresDir, showWarnings = FALSE, recursive = TRUE)
#dir.create("web/", showWarnings = FALSE, recursive = TRUE)

## get IFR and population from same file
ifr.by.country = read.csv("data_wpro/popt_ifr.csv")
ifr.by.country$country = as.character(ifr.by.country[,2])
# ifr.by.country = read.csv("data_wpro/weighted_fatality.csv")
# ifr.by.country$country = as.character(ifr.by.country[,1])
if (options$include_ncd) {
  ifr.by.country$ifr = ifr.by.country$ifr_NCD
} else {
  ifr.by.country$ifr = ifr.by.country$ifr_noNCD
}

if (length(countries) == 1) {
  ifr.by.country = ifr.by.country[ifr.by.country$country == countries[1],]
  ifr.by.country = rbind(ifr.by.country,ifr.by.country)
}

# Get serial interval
serial.interval = read.csv("data_wpro/serial_interval.csv")
# Not sure why we serial interval instead of just specifying mean and cv below?? Maybe because it is discretized see page 19 of report.
# dgammaAlt(100, 6.5, cv = 0.62)

# Start sorting out NPIs which are given by dates of start.
covariates = read.csv('data_wpro/interventions.csv',
  stringsAsFactors = FALSE)
names_covariates = c('Schools + Universities','Self-isolating if ill',
  'Public events', 'Lockdown', 'Social distancing encouraged')
covariates <- covariates %>%
  filter((Type %in% names_covariates))
covariates <- covariates[,c(1,2,4)]
covariates <- spread(covariates, Type, Date.effective)
names(covariates) <- c('Country','lockdown', 'public_events',
  'schools_universities','self_isolating_if_ill',
  'social_distancing_encouraged')
covariates <- covariates[c('Country','schools_universities',
  'self_isolating_if_ill', 'public_events', 'lockdown',
  'social_distancing_encouraged')]
covariates$schools_universities <- as.Date(covariates$schools_universities,
  format = "%d.%m.%Y")
covariates$lockdown <- as.Date(covariates$lockdown, format = "%d.%m.%Y")
covariates$public_events <- as.Date(covariates$public_events,
  format = "%d.%m.%Y")
covariates$self_isolating_if_ill <- as.Date(covariates$self_isolating_if_ill, format = "%d.%m.%Y")
covariates$social_distancing_encouraged <- as.Date(covariates$social_distancing_encouraged, format = "%d.%m.%Y")

# If missing put far into future
# covariates[is.na(covariates)] <- "31/12/2020"

# Makes sure dates are right format
# covariates[,2:8] <- lapply(covariates[,2:8],
#   function(x) as.Date(x, format='%d/%m/%Y'))

# Hack if only one country
if (length(countries) == 1) {
  covariates = covariates[covariates$Country == countries[1],]
  covariates = rbind(covariates,covariates)
}

## using covariates as dates we want
covariates$schools_universities[covariates$schools_universities > covariates$lockdown] <- covariates$lockdown[covariates$schools_universities > covariates$lockdown]
covariates$public_events[covariates$public_events > covariates$lockdown] <- covariates$lockdown[covariates$public_events > covariates$lockdown]
covariates$social_distancing_encouraged[covariates$social_distancing_encouraged > covariates$lockdown] <- covariates$lockdown[covariates$social_distancing_encouraged > covariates$lockdown]
covariates$self_isolating_if_ill[covariates$self_isolating_if_ill > covariates$lockdown] <- covariates$lockdown[covariates$self_isolating_if_ill > covariates$lockdown]

forecast = 0

N2 = 90 # increase if you need more forecast

# Hack to handle one country
if (length(countries) == 1) {
  countries <- c(countries[1], countries[1])
}

# Initialize inputs ------------------------------------------------------
dates = list()
reported_cases = list()
stan_data = list(M=length(countries),N=NULL,covariate1=NULL,
  covariate2=NULL,covariate3=NULL,covariate4=NULL,covariate5=NULL,
  covariate6=NULL,deaths=NULL,f=NULL,N0=6,cases=NULL,
  SI=serial.interval$fit[1:N2],EpidemicStart = NULL, pop = NULL)
# N0 = 6 to make it consistent with Rayleigh
deaths_by_country = list()

# Various distributions required for modeling using gammaAlt functions
# from EnvStats package
mean1 = 5.1; cv1 = 0.86; # infection to onset
mean2 = 18.8; cv2 = 0.45 # onset to death
x1 = rgammaAlt(1e7,mean1,cv1) # infection-to-onset distribution
x2 = rgammaAlt(1e7,mean2,cv2) # onset-to-death distribution
# Combined rate - time from infection to deaths door
ecdf.saved = ecdf(x1+x2)

for(Country in countries) {
  IFR=ifr.by.country$ifr[ifr.by.country$country == Country]

  covariates1 <- covariates[covariates$Country == Country, c(2,3,4,5,6)]

  d1_pop = ifr.by.country[ifr.by.country$country==Country,]
  d1=d[d$Countries.and.territories==Country,c(1,5,6,7)]
  d1$date = as.Date(d1$DateRep,format='%d/%m/%Y')
  d1$t = decimal_date(d1$date)
  d1=d1[order(d1$t),]

  # Sort out day of first case and day when 10 deaths are reached
  date_min <- dmy('31/12/2019')
  if (as.Date(d1$DateRep[1], format='%d/%m/%Y') > as.Date(date_min,
    format='%d/%m/%Y')){
    print(paste(Country,'In padding'))
    pad_days <- as.Date(d1$DateRep[1], format='%d/%m/%Y') - date_min
    pad_dates <- date_min + days(1:pad_days[[1]]-1)
    padded_data <- data.frame("Countries.and.territories" = rep(Country,
      pad_days),
      "DateRep" = format(pad_dates, '%d/%m/%Y'),
      "t" = decimal_date(as.Date(pad_dates,format='%d/%m/%Y')),
      "date" = as.Date(pad_dates,format='%d/%m/%Y'),
      "Cases" = as.integer(rep(0, pad_days)),
      "Deaths" = as.integer(rep(0, pad_days)),
      stringsAsFactors=F)

    d1 <- bind_rows(padded_data, d1)
  }
  index = which(d1$Cases>0)[1]
  index1 = which(cumsum(d1$Deaths)>10)[1] # also 5
  # Assumed day of seeding of new infections. See page 20 of report.
  index2 = index1-30

  print(sprintf(paste("First non-zero cases is on day %d, and 30 days",
    "before 10 deaths is day %d"), index, index2))
  d1=d1[index2:nrow(d1),]
  stan_data$EpidemicStart = c(stan_data$EpidemicStart,index1+1-index2)
  stan_data$pop = c(stan_data$pop, d1_pop$popt)

  # Specify covariate being on/off using 0, 1. Assume 1 on and after date
  # of start
  for (ii in 1:ncol(covariates1)) {
    covariate = names(covariates1)[ii]
    d1[covariate] <- (as.Date(d1$DateRep,
      format='%d/%m/%Y') >= as.Date(covariates1[1,covariate]))*1
    # should this be > or >=?
  }

  dates[[Country]] = d1$date

  ## Hazard function and survival -----------------------------------------

  # Hazard estimation for death following infection
  # Gamma distributions for time to infection from onset and time from
  # onset to death (see parameters below).
  # Then multiply by IFR to get death probability.
  N = length(d1$Cases)
  print(sprintf("%s has %d days of data",Country,N))
  forecast = N2 - N # number of days to forecast?
  if(forecast < 0) {
    print(sprintf("%s: %d", Country, N))
    print("ERROR!!!! increasing N2")
    N2 = N
    forecast = N2 - N
  }

  # IFR is the overall probability of dying given infection
  convolution = function(u) (IFR * ecdf.saved(u))

  f = rep(0,N2) # f is the probability of dying on day i given infection

  # Discretized fatality
  f[1] = (convolution(1.5) - convolution(0))
  for(i in 2:N2) {
    f[i] = (convolution(i+.5) - convolution(i-.5))
  }

  # Set-up country epi data and stan inputs -------------------------------
  # y=c(as.vector(as.numeric(d1$Cases)),rep(-1,forecast))
  reported_cases[[Country]] = as.vector(as.numeric(d1$Cases))
  deaths=c(as.vector(as.numeric(d1$Deaths)),rep(-1,forecast))
  cases=c(as.vector(as.numeric(d1$Cases)),rep(-1,forecast))
  deaths_by_country[[Country]] = as.vector(as.numeric(d1$Deaths))

  # Extend covaraites to forecast days
  covariates2 <- as.data.frame(d1[, colnames(covariates1)])
  # x=1:(N+forecast)
  covariates2[N:(N+forecast),] <- covariates2[N,]

  ## Append data to forecast days into stan_data
  stan_data$N = c(stan_data$N,N)
  # stan_data$y = c(stan_data$y,y[1]) # just the index case!
  # stan_data$x = cbind(stan_data$x,x)
  stan_data$covariate1 = cbind(stan_data$covariate1,covariates2[,1])
  stan_data$covariate2 = cbind(stan_data$covariate2,covariates2[,2])
  stan_data$covariate3 = cbind(stan_data$covariate3,covariates2[,3])
  stan_data$covariate4 = cbind(stan_data$covariate4,covariates2[,4])
  stan_data$covariate5 = cbind(stan_data$covariate5,covariates2[,4])
  stan_data$covariate6 = cbind(stan_data$covariate6,covariates2[,5])
  stan_data$f = cbind(stan_data$f,f)
  stan_data$deaths = cbind(stan_data$deaths,deaths)
  stan_data$cases = cbind(stan_data$cases,cases)

  stan_data$N2=N2
  stan_data$x=1:N2
  if(length(stan_data$N) == 1) {
    stan_data$N = as.array(stan_data$N)
  }
}

if (options$npi_on) {
  # create the `any intervention` covariate
  stan_data$covariate4 = 1*as.data.frame((stan_data$covariate1+
      stan_data$covariate2+
      stan_data$covariate3+
      stan_data$covariate5+
      stan_data$covariate6) >= 1)
} else {
  # Turn off NPIs
  stan_data$covariate1 = 0 * stan_data$covariate1
  stan_data$covariate2 = 0 * stan_data$covariate2
  stan_data$covariate3 = 0 * stan_data$covariate3
  stan_data$covariate4 = 0 * stan_data$covariate4
  stan_data$covariate5 = 0 * stan_data$covariate5
  stan_data$covariate6 = 0 * stan_data$covariate6
}

# Check NPI dates
if(DEBUG) {
  for(i in 1:length(countries)) {
    write.csv(
      data.frame(date=dates[[i]],
        `school closure`=stan_data$covariate1[1:stan_data$N[i],i],
        `self isolating if ill`=stan_data$covariate2[1:stan_data$N[i],i],
        `public events`=stan_data$covariate3[1:stan_data$N[i],i],
        `government makes any intervention`=stan_data$covariate4[1:stan_data$N[i],i],
        `lockdown`=stan_data$covariate5[1:stan_data$N[i],i],
        `social distancing encouraged`=stan_data$covariate6[1:stan_data$N[i],i]),
      file=paste0(resultsDir, countries[i], "-check-dates.csv"),row.names=F)
      # file=sprintf("results/%s-check-dates.csv",countries[i]),row.names=F)
  }
}

# Combine covariates to an array of design matrices X
stan_data$P <- 6
stopifnot(dim(stan_data$covariate1) == c(stan_data$N2, stan_data$M))
stan_data$X <- array(c(stan_data$covariate1,
                       stan_data$covariate2,
                       stan_data$covariate3,
                       unname(as.matrix(stan_data$covariate4)),
                       stan_data$covariate5,
                       stan_data$covariate6),
                     dim = c( stan_data$N2 , stan_data$M , stan_data$P ))
stan_data$X <- aperm(stan_data$X, c(2,1,3))
stopifnot(all(stan_data$covariate1 == t(stan_data$X[,,1])))
stan_data$covariate1 <-
  stan_data$covariate2 <-
  stan_data$covariate3 <-
  stan_data$covariate4 <-
  stan_data$covariate5 <-
  stan_data$covariate6 <- NULL

# Set-up and run sampling -------------------------------------------------
# stan_data$y = t(stan_data$y)
options(mc.cores = parallel::detectCores())
rstan_options(auto_write = TRUE)
m = stan_model(paste0('stan-models/',StanModel,'.stan'))

if(DEBUG) {
  fit = sampling(m,data=stan_data,iter=40,warmup=20,chains=2)
} else if (FULL) {
  fit = sampling(m,data=stan_data,iter=4000,warmup=2000,chains=4,thin=4,
    control = list(adapt_delta = 0.95, max_treedepth = 10))
} else {
  fit = sampling(m,data=stan_data,iter=200,warmup=100,chains=4,thin=4,
    control = list(adapt_delta = 0.95, max_treedepth = 10))
}

# Extract outputs and save results ----------------------------------------
out = rstan::extract(fit)
prediction = out$prediction
estimated.deaths = out$E_deaths
estimated.deaths.cf = out$E_deaths0

JOBID = Sys.getenv("PBS_JOBID")
if(JOBID == "")
  JOBID = as.character(abs(round(rnorm(1) * 1000000)))
print(sprintf("Jobid = %s",JOBID))

save.image(paste0(resultsDir, StanModel,'-',JOBID,'.Rdata')) # don't like this

save(fit,out,prediction,dates,reported_cases,deaths_by_country,countries,
  estimated.deaths,estimated.deaths.cf,out,covariates, options,stan_data,
  file=paste0(resultsDir, StanModel,'-',JOBID,'-stanfit.Rdata'))

# Visualize results -------------------------------------------------------
print("To visualize results run code in wrpo-results.r script")

# library(bayesplot)
# filename <- paste0(StanModel,'-',JOBID)
# system(paste0("Rscript covariate-size-effects.r ", filename,
#   '-stanfit.Rdata'))
# mu = (as.matrix(out$mu))
# colnames(mu) = countries
# g = (mcmc_intervals(mu,prob = .9))
# ggsave(paste0(resultsDir, filename, "-mu.png"),g,width=4,height=6)
# # ggsave(sprintf("results/%s-mu.png",filename),g,width=4,height=6)
# tmp = lapply(1:length(countries), function(i) (out$Rt_adj[,stan_data$N[i],i]))
# Rt_adj = do.call(cbind,tmp)
# colnames(Rt_adj) = countries
# g = (mcmc_intervals(Rt_adj,prob = .9))
# ggsave(paste0(resultsDir, filename, "-final-rt.png"),g,width=4,height=6)
# ggsave(sprintf("results/%s-final-rt.png",filename),g,width=4,height=6)

# system(paste0("Rscript plot-3-panel.r ", filename,'-stanfit.Rdata'))
# source("plot-3-panel.r")
# summaryOutput <- make_three_panel_plot(paste0(filename, '-stanfit.Rdata'),
  # resultsDir, figuresDir)
# for (ii in 1:length(countries)) {
#   write.csv(summaryOutput[[ii]], paste0(figuresDir, 'SummaryResults-',JOBID,
#     '-',countries[[ii]],'.csv'))
# }
# system(paste0("Rscript plot-forecast.r ", paste0(resultsDir, filename),'-stanfit.Rdata'))
# system(paste0("Rscript make-table.r results/",filename,'-stanfit.Rdata'))
# verify_result <- system(paste0("Rscript web-verify-output.r ", filename,'.Rdata'),intern=FALSE)
# if(verify_result != 0){
#   stop("Verification of web output failed!")
# }


######### end user options #########
do.HCR.batch<-function(do.simulation=T,read.condense=T,do.plots=T,read.detailed=T,cutof.year.detailed=2006,NewPlot=T,stochastich=T,YieldPerRecruit=T) {

HCR<-new("FLSMS.predict.control")
HCR@years.wsea[1,1]<-min(refYear)
HCR@years.wsea[2,1]<-max(refYear)
HCR@years.weca<-HCR@years.wsea
HCR@years.propmat[1,1]<-min(refYearPropmat)
HCR@years.propmat[2,1]<-max(refYearPropmat)

HCR@HCR.F.TAC[1]<-0
HCR@rec.noise.input[1]<-0
HCR@inter.year[1]<-1
HCR@rec.noise[1,1]<- recruit.noise.low
HCR@rec.noise[2,1]<- recruit.noise.high

HCR@last.prediction.year<-2026

control<-read.FLSMS.control(file=file.path(data.path,'SMS.dat'))

#recruitment geometric mean
s<-Read.summary.data()
tmp<-subset(s,Year < (control@last.year.model-1) & Quarter==control@rec.season & Age==control@first.age,select=c(Year,N))
GM.mean.log<-mean(log(tmp$N))
GM.mean<-exp(GM.mean.log)
GM.sd.log<-sd(log(tmp$N))

if (stochastich) {
   HCR@no.MCMC.iterations<-no.MCMC.iterations
   HCR@read.rec.SSB.parm<-0
   include.probability<-T
   if (YieldPerRecruit) {
     HCR@read.rec.SSB.parm<-1
     pp<-file.path(data.path,'SSB_R.in')
     cat(paste("#model alfa  beta std \n",
                 "3 ",GM.mean.log, 0, GM.sd.log,"\n",sep=' '),file=pp)
     include.probability<-F
    }

} else {
    HCR@no.MCMC.iterations<-1
    HCR@read.rec.SSB.parm<-1
    if (YieldPerRecruit) {
     pp<-file.path(data.path,'SSB_R.in')
     cat(paste("#model alfa  beta std \n",
                 "3 ",GM.mean.log, 0, GM.sd.log,"\n",sep=' '),file=pp)
     include.probability<-F
    } else {
      p<-Read.SSB.Rec.data()
      pp<-file.path(data.path,'SSB_R.in')
      cat("#model alfa  beta std \n",file=pp)
      p<-subset(p,select=c(model,alfa,beta,std))
      p$std<-1E-4
      write.table(p,file=pp,append=T,row.names=F,col.names=F)
      include.probability<-F
    }
}

# make sms.psv file
source(file.path(prog.path,"make_psv.R"))

SMS.option<-" "

first.year.in.mean<-HCR@last.prediction.year-3    # years where output is independent of initial conditions and used as "equilibrium"
last.year.in.mean<-HCR@last.prediction.year-1

#Read refence points from file reference_points.in
ref<-Read.reference.points()
blim<-ref[,"Blim"]
bpa<-ref[,"Bpa"]
T1<-blim
T2<-bpa

#  files for output
ssb.out<-'HCR_SSB.dat'
yield.out<-'HCR_yield.dat'
F.out<-'HCR_F.dat'
prob.out<-'HCR_prob.dat'

ssb.out.all<-'mcout_SSB.out.all'
yield.out.all<-'mcout_yield.out.all'
F.out.all<-'mcout_mean_F.out.all'
prob.out.all<-'HCR_prob.dat.all'

if (do.simulation) {
  sp.name<-control@species.names

  percentiles<-c(0.025,0.05,0.10,0.25,0.50,0.75,0.95,0.975)

  # headers in output files
  heading<-"targetF"
  cat(paste(heading,"Species.n "),file=ssb.out)
  cat(paste("SSB",formatC(percentiles*1000,width=3,flag='0'),sep=''),file=ssb.out,append=T); cat('\n',file=ssb.out,append=T)
  cat(paste(heading,"Species.n "),file=yield.out)
  cat(paste("y",formatC(percentiles*1000,width=3,flag='0'),sep=''),file=yield.out,append=T); cat('\n',file=yield.out,append=T)
  cat(paste(heading,"Species.n "),file=F.out)
  cat(paste("F",formatC(percentiles*1000,width=3,flag='0'),sep=''),file=F.out,append=T); cat('\n',file=F.out,append=T)
  cat(paste(heading,"Species.n "," p.T1 p.T2 \n"),file=prob.out)

  iter<-0
  i<-0
  for (targetF in (targetFs)) i<-1+i
  #print(paste("You have asked for",i,"runs. Do you want to continue? (Y/N):"))
  #a<-readLines(n=1)
  #if(a=='N') stop("Script stopped'")
  #print('OK')
  tot.rep<-i

  for (targetF in (targetFs)) {
      iter<-iter+1
      print(paste("targetF:",targetF))
      print(paste("run no.:",iter, "out of a total of",tot.rep,"runs"))

      HCR@constant.F[1]<-targetF

      write.FLSMS.predict.control(HCR,SMS=control,file='HCR_options.dat')

      #run SMS
      shell(paste( file.path(data.path,"sms.exe"),"-mceval",SMS.option,sep=" "), invisible = TRUE)

      condense_file<-function(filename){
        file<-file.path(data.path,filename)
        a<-read.table(file,header=TRUE)
        a<-subset(a,Year>cutof.year.detailed)
        a<-data.frame(a,targetF=targetF)

        file<-paste(file,".all",sep='')
        if (iter==1) write.table(a, file =file, row.names = F,col.names = T,quote = F) else write.table(a, file =file, row.names =F,col.names =F, quote =F,append=T)
      }

      condense_file("mcout_SSB.out")
      condense_file("mcout_recruit.out")
      condense_file("mcout_mean_F.out")
      condense_file("mcout_yield.out")

      a<-Read.MCMC.SSB.rec.data()
      a<-subset(a,Year>=first.year.in.mean & Year<=last.year.in.mean ,drop=T)

      b<-tapply(a$SSB,list(a$Species.n), function(x) quantile(x,probs = percentiles))
      for (i in (1:length(b))) {
         cat(paste(targetF,i,' '),file=ssb.out,append=TRUE)
         cat(b[[i]],file=ssb.out,append=TRUE)
         cat('\n',file=ssb.out,append=TRUE)
      }

      dummy<-by(a,list(a$Species.n),function(x) {
        q<-tapply(x$SSB,list(x$Year,x$Repetion,x$Iteration),sum)
        sp<-x[1,"Species.n"]
        q[q>T2[sp]]<-0
        q[q>0]<-1
        p.T2<-sum(q)/(dim(q)[1]*dim(q)[2]*dim(q)[3])

        q<-tapply(x$SSB,list(x$Year,x$Repetion,x$Iteration),sum)
        q[q>T1[sp]]<-0
        q[q>0]<-1
        p.T1<-sum(q)/(dim(q)[1]*dim(q)[2]*dim(q)[3])
        cat(paste(targetF,sp,p.T1,p.T2,'\n'),file=prob.out,append=TRUE)
      })

      a<-Read.MCMC.F.yield.data(dir=data.path)
      a<-subset(a,Year>=first.year.in.mean & Year<=last.year.in.mean ,drop=T)
      b<-tapply(a$Yield,list(a$Species.n), function(x) quantile(x,probs = percentiles))
      for (i in (1:length(b))) {
         cat(paste(targetF,i,' '),file=yield.out,append=TRUE)
         cat(b[[i]],file=yield.out,append=TRUE)
         cat('\n',file=yield.out,append=TRUE)
      }

      b<-tapply(a$mean.F,list(a$Species.n), function(x) quantile(x,probs = percentiles))
      for (i in (1:length(b))) {
         cat(paste(targetF,i,' '),file=F.out,append=TRUE)
         cat(b[[i]],file=F.out,append=TRUE)
         cat('\n',file=F.out,append=TRUE)
      }
  }
}   # end do.simulations

if (read.condense) {

  # read data and options into FLR objects
  HCR<-read.FLSMS.predict.control(control=control,file='HCR_options.dat')

  sp.name<-control@species.names

  ssb<-read.table(ssb.out,header=TRUE)
  yield<-read.table(yield.out,header=TRUE)
  proba<-read.table(prob.out,header=TRUE)
  fi<-read.table(F.out,header=TRUE)

  a<-merge(ssb,yield)
  a<-merge(a,proba)
  a<-merge(a,fi)
  condensed<-data.frame(a,targetF.fac=as.factor(a$targetF))
  write.csv(condensed,file=file.path(data.path,"condensed_MSY.csv"))

 }

if (read.detailed) {

  # read data and options into FLR objects
  control<-read.FLSMS.control()
  #HCR<-read.FLSMS.predict.control(control=control,file='HCR_options.dat')

  sp.name<-control@species.names
  Years<- c(2010,2012,2014,2030)
  ssb<-read.table(ssb.out.all,header=TRUE)
  ssb<-subset(ssb,Year %in% Years)

  cat("Year targetF   p.T2 p.T1 Species.n\n",file=prob.out.all)
  dummy<-by(ssb,list(ssb$Species.n),function(x) {
        q<-tapply(x$SSB,list(x$Repetion,x$Iteration,x$Year,x$targetF),sum)
        sp<-x[1,"Species.n"]
        q[q>T2[sp]]<-0
        q[q>0]<-1
        p.T2<-apply(q,c(3,4),sum)/ (dim(q)[1]*dim(q)[2])

        q<-tapply(x$SSB,list(x$Repetion,x$Iteration,x$Year,x$targetF),sum)
        q[q>T1[sp]]<-0
        q[q>0]<-1
        p.T1<-apply(q,c(3,4),sum)/ (dim(q)[1]*dim(q)[2])

        a<-arr2dfny(p.T2,name="p.T2")
        b<-arr2dfny(p.T1,name="p.T1")
        a<-data.frame(merge(a,b),Species.n=sp)
        write.table(a,row.names=F,col.names=F,quote=F,file=prob.out.all,append=T)
   })

  #proba<-read.table(prob.out.all,header=TRUE)

  yield<-read.table(yield.out.all,header=TRUE)
  yield<-subset(yield,Year %in% Years)

  fi<-read.table(F.out.all,header=TRUE)
  fi<-subset(fi,Year %in% Years)

  a<-merge(ssb,yield)
  a<-merge(a,fi)
  detailed<-data.frame(a,Year.fac=as.factor(a$Year),targetF.fac=as.factor(a$targetF))

 }

if (do.plots) {
   # read data and options into FLR objects
  control<-read.FLSMS.control()

  sp.name<-control@species.names
  ssb<-read.table(ssb.out,header=TRUE)
  yield<-read.table(yield.out,header=TRUE)
  prob<-read.table(prob.out,header=TRUE)
  fi<-read.table(F.out,header=TRUE)

  a<-merge(ssb,yield)
  a<-merge(a,prob)
  a<-merge(a,fi)

  if (paper) dev<-"wmf" else dev<-"screen"
  if (NewPlot) newplot(dev,nox=nox,noy=noy,filename=paste("HCR_",sp.name,sep=''),Portrait=T);

  par(mar=c(4,4,3,5)+.1)  # c(bottom, left, top, right)
  s<-a$SSB500/1000
  y<-a$y500/1000
  x<-a$targetF
  x.lab<-'F(1-2)'

  plot(x,s,ylab='SSB & Yield (1000 t)',xlab=x.lab ,ylim=c(min(s,y,0),max(s,y)),lty=1,type='l',lwd=2,col=1,main=NULL)
  if (include.probability) {
    legend(legendPlace,  c('SSB','Yield', paste('p(SSB<',round(T1),'t)')), pch="  1",lty=c(1,2,3),col=c(1,2,4), lwd=rep(2,3))
  } else  legend(legendPlace,c('SSB','Yield'),pch="   ",lty=c(1,2),lwd=rep(2,2),col=c(1,2))

  lines(x,y,lty=2,lwd=2,col=2)

  if (include.probability) {
    par(new=T)
    plot(x,a$p.T1,axes=F,xlab=x.lab, ylab=' ',lty=3,lwd=2,ylim=c(0,1),type='b',pch="1",col=4)
    abline(h=0.05)
    axis(side=4)
    mtext(side=4,line=3.0,"Probability")
    par(xaxs="r")
  }

  #if (paper) cleanup()

} #end do.plots
}


library(tidyverse)
library(lubridate)
# "lubridate" %in% (.packages()) # how to check if package loaded

options(warn=1)

# read our weather data
head <- read_tsv('raw_data/Whangarei.txt', col_names=FALSE)[1:6,] # header rows
data <- read_tsv('raw_data/Whangarei.txt', skip=6, col_names=FALSE) # data rows
names(data) <- c('date',
                 'tmax_C', 'tmin_C',
                 'radn_MJ_m2', 'sun_hrs',
                 'windrun_km',
                 'rain_mm', 'rain_hrs',
                 'penman_mm', 'priestley_mm', 'open_pan_mm',
                 'blank1', 'blank2')

# erroneous dates?
data$date <- dmy(data$date)
plot(data$date)

# add extra variables
data <- data %>%
  mutate(station=1, #
         newdate=date, # parse date
         year=format(year(newdate), scientific=FALSE),
         doy=yday(newdate))

# test for missing rows
# temp1 <- data$newdate[2:nrow(data)]
# temp2 <- data$newdate[1:(nrow(data)-1)]
temp3 <- as.tibble(c(difftime(data$newdate[2:nrow(data)], data$newdate[1:(nrow(data)-1)], units='days'), 1))
missing <- which(temp3 != 1)
if (length(missing)>0) {
  print('Error: Illegal step sizes in time series (should all be 1)')
  print(missing + 6L)
  print(temp3$value[missing])
  stop()
  # print('Truncating time series')
  # data <- data[1:missing[1], ]
} else {
  print('Confirmed: No missing steps in time series')
}

# get variables for BASGRA weather file
data2 <- data %>%
  dplyr::select(station, year, doy, tmin_C, tmax_C, rain_mm, radn_MJ_m2, priestley_mm)

# simple handling of missing data
missing <- which(data2$tmin_C == -999)
print('Warning: Imputing data2$tmin_C == -999')
print(missing)
for (i in missing) {
  data2$tmin_C[i] <- data2$tmin_C[i-1]
}
missing <- which(data2$tmax_C == -999)
print('Warning: Imputing data2$tmax_C == -999')
print(missing)
for (i in missing) {
  data2$tmax_C[i] <- data2$tmax_C[i-1]
}
missing <- which(data2$rain_mm < 0)
print('Warning: Imputing data2$rain_mm < 0')
print(missing)
for (i in missing) {
  data2$rain_mm[i] <- data2$rain_mm[i-1]
}
missing <- which(data2$radn_MJ_m2 < 0)
print('Warning: Imputing data2$radn_MJ_m2 < 0')
print(missing)
for (i in missing) {
  data2$radn_MJ_m2[i] <- data2$radn_MJ_m2[i-1]
}
missing <- which(data2$priestley_mm < 0)
print('Warning: Imputing data2$priestley_mm < 0')
print(missing)
for (i in missing) {
  data2$priestley_mm[i] <- data2$priestley_mm[i-1]
}

# write BASGRA weather file
write_tsv(data2, 'raw_data/weather_Northland.txt')
print('Remember to copy weather to scenario folder!')


# Author: DeepakSharma
# For: Nuro Lab, Nueroinfo group
# License: The MIT License

# Input variable for sample data id named sd
# Read csv file and copy all data (all electrodes/channels) into it
setwd("~/Documents/Depmet")
sd = read.csv("sample.csv",head=TRUE,sep=",")
attach(sd)
names(sd)
data.frame(names(sd))

# Output data is contained in od variable (8 channels)
od = data.frame(sd$X17,sd$X22, sd$X23, sd$X25, sd$X27, sd$X28, sd$X29, sd$X30)
names(od)=c("FT8", "F4", "F8", "FT7","F3","FP2","F7","FP1")
# One sample electrode data
od2 = data.frame(sd$X17)
names(od2)=c("FT8")

# No. of rows(time in miliseconds)
r = nrow(od)
# No. of channels in output file
c = ncol(od)

# Plot a selected channel
plot(sd$X21,type = 'l');

# Write output file
write.csv(od,"out.csv")

# Variable initialization
# Iteration variable initialization
i <- 1; j <- 2; k <-0
n <- 0; p <- 0; nc <- 0; pc <- 0;
ncp <- 0; pcm <- 0;
# Counter variable initialization
neg <- 0; pos <- 0; cc <- 0;

# Get summary for one electrode channel
summ = summary(od$FT8)
var_od = var(od$FT8)

od2$FT8 <- as.numeric(as.character(od2$FT8))
C = length(od2$FT8)
for(i in 1:C)
{
  if(od2$FT8[i] < 0)
    n = n + 1
  if(od2$FT8[i] > 0)
    p = p + 1
  if(i==C-1)
  {
    if(od2$FT8[i+1] < 0)
      n = n + 1
    else
      p = p + 1
  }
  if(((od2$FT8[i] < 0 ) && (od2$FT8[i+1] > 0)) || ((od2$FT8[i] > 0 ) && (od2$FT8[i+1] < 0)))
    cc = cc + 1;
  if(od2$FT8[i] > 0 && od2$FT8[i+1] > 0)
  {
    pc++
    if(pcm <= pc)
      pcm = pc;
  }
  if(od2$FT8[i] < 0 && od2$FT8[i+1] < 0)
  {
    nc++
    if(ncm <= nc)
      ncm = nc;
  }
}


#! /usr/bin/env Rscript

##############################################################################
# Setup: process args, load function helper script, load packages
##############################################################################
ptm <- proc.time()

parentdir<-dirname(getwd())
cat("Loading functions and packages...\n")

source("R/get_functions.r")

adj <- 3
binw <- 1000000
summfile <- paste0(parentdir, "/output/7bp_1000k_common/full.summary")
binfile <- paste0(parentdir, "/output/7bp_1000k_common/full_bin.txt")

# Define additional variables for cleaner strings, etc.
bink <- binw/1000
nbp <- adj*2+1

datadir <- dirname(summfile)

tottime <- (proc.time()-ptm)[3]
cat("Done (", tottime, "s)\n")

##############################################################################
# Read in MAC10+ data
##############################################################################
ptm <- proc.time()

if(!file.exists(summfile)){
	cat("Merged summary/bin files do not exist---Merging now...\n")

	# Change ^SEQ to ^CHR--needed to fix bug in header of common variant data
	combinecmd <- paste0(
		"awk 'FNR==1 && NR!=1{while(/^SEQ/) getline; } 1 {print} ' ",
		datadir, "/chr*.expanded.summary > ", datadir, "/full.summary")
	combinecmd2 <- paste0(
		"awk 'FNR==1 && NR!=1{while(/^CHR/) getline; } 1 {print} ' ",
		datadir, "/chr*.bin_out.txt > ", datadir, "/full_bin.txt")
	system(combinecmd)
	system(combinecmd2)
}

summ_5bp_100k <- read.table(summfile, header=F, stringsAsFactors=F, skip=1)
names(summ_5bp_100k)<-c(
	"CHR", "POS", "REF", "ALT", "DP", "AN", "SEQ", "ALTSEQ", "GC")

summ_5bp_100k$BIN <- ceiling(summ_5bp_100k$POS/binw)

bins_5bp_100k <- read.table(binfile, header=T, stringsAsFactors=F, check.names=F)

source("R/update_dat.r")
dat_5bp_100k <- updateData(summ_5bp_100k, bins_5bp_100k, adj)
rm(summ_5bp_100k)
rm(bins_5bp_100k)

source("R/agg_dat.r")
aggV <- aggData(dat_5bp_100k, adj) #<-modify the adj value for 3bp data

agg_5bp_100k <- aggV$oe
rates5 <- aggV$agg
summagg2 <- aggV$summagg2

agg_5bp_100k_common <- agg_5bp_100k
rates5_common <- rates5
names(rates5_common)[8] <- "common_rel_prop"

##############################################################################
# Repeat with singletons
##############################################################################

summfile <- paste0(parentdir, "/output/7bp_1000k/full_j.summary")
binfile <- paste0(parentdir, "/output/7bp_1000k/full_bin.txt")

summ_5bp_100k <- read.table(summfile, header=F, stringsAsFactors=F, skip=1)
summ_5bp_100k <- summ_5bp_100k[sample(nrow(summ_5bp_100k), 12088037),]
names(summ_5bp_100k)<-c(
	"CHR", "POS", "REF", "ALT", "DP", "AN", "SEQ", "ALTSEQ", "GC")

summ_5bp_100k$BIN <- ceiling(summ_5bp_100k$POS/binw)

bins_5bp_100k <- read.table(binfile, header=T, stringsAsFactors=F, check.names=F)

dat_5bp_100k <- updateData(summ_5bp_100k, bins_5bp_100k, adj)
rm(summ_5bp_100k)
rm(bins_5bp_100k)

aggV <- aggData(dat_5bp_100k, adj) #<-modify the adj value for 3bp data

agg_5bp_100k <- aggV$oe
rates5 <- aggV$agg
summagg2 <- aggV$summagg2

##############################################################################
# Merge data
##############################################################################
r5m <- merge(rates5[,c(2,3,4,7,8)],
	rates5_common[,c(2,3,4,7,8)], by=c("Sequence", "Category2")) %>%
	mutate(Category=gsub("cpg_", "", Category2)) %>%
	#group_by(Category) %>%
	mutate(nsing=sum(num.x),
		ncommon=sum(num.y),
		prop_s=num.x/nsing,
		prop_p=num.y/ncommon,
		prop_diff=prop_p/prop_s)

r5m <- r5m %>%
	mutate(Category2 = plyr::mapvalues(Category2, orderedcats1, orderedcats2))

r5m$Category2 <- factor(r5m$Category2, levels=orderedcats2)

r5m$prop_diff3 <- r5m$prop_diff
r5m$prop_diff3[r5m$prop_diff< 0.5] <- 0.5
r5m$prop_diff3[r5m$prop_diff>2] <- 2

r5m$prop_diff4 <- r5m$num.y/r5m$num.x
r5m$prop_diff4 <- r5m$prop_diff4/mean(r5m$prop_diff4)

r5m$prop_diff5 <- r5m$prop_diff4
r5m$prop_diff4[r5m$prop_diff4< 0.5] <- 0.5
r5m$prop_diff4[r5m$prop_diff4>2] <- 2

r5m$v2 <- substr(r5m$Sequence,1,adj)
r5m$v2a <- as.character(lapply(as.vector(r5m$v2), reverse_chars))
r5m$v2a <- factor(r5m$v2a)
r5m$v3 <- substr(r5m$Sequence,adj+2,adj*2+1)

##############################################################################
# Compare subtypes
##############################################################################
# r5m %>% group_by(Category2) %>% summarise(cor=cor(rel_prop, common_rel_prop))

ggplot(data=r5m, aes(x=rel_prop, y=common_rel_prop))+
	geom_point(aes(group=Category2, colour=Category2), alpha=0.3, size=2, shape=1)+
  xlab("Relative mutation rate (ERVs)")+
  ylab("Relative mutation rate (MAC10+)")+
	geom_abline(intercept=0, linetype="dashed")+
	scale_x_log10(labels=c(0.0001, 0.001, 0.01, 0.1),
		breaks=c(0.0001, 0.001, 0.01, 0.1),
		limits=c(0.000025, 0.1))+
  scale_y_log10(labels=c(0.0001, 0.001, 0.01, 0.1),
		breaks=c(0.0001, 0.001, 0.01, 0.1),
		limits=c(0.000025, 0.1))+
	coord_fixed()+
	scale_colour_manual(values=cols)+
	guides(colour = guide_legend(title=NULL, nrow=3, override.aes = list(alpha=1, shape=16)))+
  theme_bw()+
  theme(
		legend.position="bottom",
    strip.text.x=element_text(size=14),
    legend.title=element_text(size=12),
    axis.title.x=element_text(size=14),
    axis.title.y=element_text(size=14),
		axis.text.x=element_text(size=12, angle=45, hjust=1, vjust=1),
		axis.text.y=element_text(size=12))
ggsave(paste0(parentdir, "/images/sing_com_cor_rates_no_facet.png"),
	width=4, height=5)

r5m2 <- r5m %>% dplyr::select(-Category2)

r5mcor <- r5m %>%
	group_by(Category2) %>%
	summarise(cor=cor(rel_prop, common_rel_prop, method="spearman")) %>%
	mutate(label=paste0("rho=", round(cor,2)))

ggplot(data=r5m, aes(x=rel_prop,  y=common_rel_prop))+
  geom_point(data=r5m2, alpha=0.1, size=2, colour="grey70")+
  geom_hex(bins=50)+
	geom_text(data=r5mcor, aes(label=paste0("rho==", round(cor,2))),
            x=-Inf, y=Inf, hjust=0, vjust=1, parse=TRUE, size=4)+
	xlab("Relative mutation rate (ERVs)")+
	ylab("Relative mutation rate (MAC10+)")+
  # geom_smooth(se=F, colour="red", linetype="dashed", aes(alpha=0.6))+
  geom_abline(intercept=0, linetype="dashed")+
  scale_x_log10(labels=c(0.0001, 0.001, 0.01, 0.1),
		breaks=c(0.0001, 0.001, 0.01, 0.1),
		limits=c(0.000025, 0.1))+
  scale_y_log10(labels=c(0.0001, 0.001, 0.01, 0.1),
		breaks=c(0.0001, 0.001, 0.01, 0.1),
		limits=c(0.000025, 0.1))+
	coord_fixed()+
  scale_colour_manual("Mutation Type", values=cols)+
  scale_fill_gradientn(colours = myPalette(6))+
	facet_wrap(~Category2, dir="v")+
  theme_bw()+
  theme(
    legend.position="none",
    strip.text.x=element_text(size=14),
    legend.title=element_text(size=12),
    axis.title.x=element_text(size=14),
    axis.title.y=element_text(size=14),
		axis.text.x=element_text(size=12, angle=45, hjust=1, vjust=1),
    axis.text.y=element_text(size=12))
ggsave(paste0(parentdir, "/images/sing_com_cor_rates_facet_dens.png"),
	width=6, height=6)

##############################################################################
# Plot 1d densities
##############################################################################
r5ma<-r5m %>%
	dplyr::select(Sequence, Category2, rel_prop, common_rel_prop) %>%
	gather(gp, prop, rel_prop:common_rel_prop) %>%
	mutate(group=recode(gp, rel_prop = "ERVs", common_rel_prop="MAC10+"))

kspvals <- r5m %>%
	group_by(Category2) %>%
	summarise(pval=ks.test(rel_prop, common_rel_prop)$p.value) #%>%
	# mutate()

kspvals$pv2<-ifelse(kspvals$pval==0, "2.2e-16", signif(kspvals$pval,2))

ggplot()+
	geom_density(data=r5ma, aes(x=log10(prop), group=group, colour=group))+
	geom_text(data=kspvals, aes(label=paste0("P<",pv2)),
						x=-Inf, y=Inf, hjust=0, vjust=1, parse=TRUE, size=4)+
	xlab("log10(relative mutation rate)")+
  facet_wrap(~Category2, scales="free", dir="v")+
  theme_bw()+
  theme(
    strip.text.x=element_text(size=14),
    legend.title=element_text(size=16),
    axis.title.x=element_text(size=18),
    axis.title.y=element_text(size=18))
ggsave(paste0(parentdir, "/images/sing_com_cor_rates_facet_densl.png"),
	width=9, height=9)

##############################################################################
# Compare subtypes (restrict to >50 observations)
##############################################################################
r5ma <- r5m %>% filter(num.x>=50 & num.y>=50)

ggplot(data=r5ma, aes(x=rel_prop, y=common_rel_prop))+
	geom_point(aes(group=Category2, colour=Category2),
		alpha=0.3, size=2, shape=1)+
  xlab("Relative mutation rate (ERVs)")+
  ylab("Relative mutation rate (MAC10+)")+
	geom_abline(intercept=0, linetype="dashed")+
	scale_x_log10(labels=c(0.0001, 0.001, 0.01, 0.1),
		breaks=c(0.0001, 0.001, 0.01, 0.1),
		limits=c(0.000025, 0.1))+
  scale_y_log10(labels=c(0.0001, 0.001, 0.01, 0.1),
		breaks=c(0.0001, 0.001, 0.01, 0.1),
		limits=c(0.000025, 0.1))+
	coord_fixed()+
	scale_colour_manual(values=cols)+
	guides(colour = guide_legend(title=NULL, nrow=3,
		override.aes = list(alpha=1, shape=16)))+
  theme_bw()+
  theme(
		legend.position="bottom",
    strip.text.x=element_text(size=14),
    legend.title=element_text(size=12),
    # axis.title.x=element_text(size=14),
    # axis.title.y=element_text(size=14),
		axis.text.x=element_text(size=12, angle=45, hjust=1, vjust=1),
		axis.text.y=element_text(size=12))
ggsave(paste0(parentdir, "/images/sing_com_cor_rates_no_facet_sub.png"),
	width=4, height=5)

r5m2a <- r5ma %>% dplyr::select(-Category2)

r5mcora <- r5ma %>%
	group_by(Category2) %>%
	summarise(cor=cor(rel_prop, common_rel_prop, method="spearman")) %>%
	mutate(label=paste0("rho=", round(cor,2)))

ggplot(data=r5ma, aes(x=rel_prop,  y=common_rel_prop))+
  geom_point(data=r5m2a, alpha=0.1, size=2, colour="grey70")+
  geom_hex(bins=50)+
	geom_text(data=r5mcora, aes(label=paste0("rho==", round(cor,2))),
            x=-Inf, y=Inf, hjust=0, vjust=1, parse=TRUE, size=4)+
	xlab("Relative mutation rate (ERVs)")+
	ylab("Relative mutation rate (MAC10+)")+
  # geom_smooth(se=F, colour="red", linetype="dashed", aes(alpha=0.6))+
  geom_abline(intercept=0, linetype="dashed")+
	scale_x_log10(labels=c(0.0001, 0.001, 0.01, 0.1),
		breaks=c(0.0001, 0.001, 0.01, 0.1),
		limits=c(0.000025, 0.1))+
  scale_y_log10(labels=c(0.0001, 0.001, 0.01, 0.1),
		breaks=c(0.0001, 0.001, 0.01, 0.1),
		limits=c(0.000025, 0.1))+
	coord_fixed()+
  scale_colour_manual("Mutation Type", values=cols)+
  scale_fill_gradientn(colours = myPalette(6))+
	facet_wrap(~Category2, dir="v")+
  theme_bw()+
  theme(
    legend.position="none",
    strip.text.x=element_text(size=14),
    legend.title=element_text(size=12),
    axis.title.x=element_text(size=14),
    axis.title.y=element_text(size=14),
		# axis.text.x=element_text(size=12),
    # axis.text.y=element_text(size=12),
		axis.text.x=element_text(size=12, angle=45, hjust=1, vjust=1),
		axis.text.y=element_text(size=12))
ggsave(paste0(parentdir, "/images/sing_com_cor_rates_facet_dens_sub.png"),
	width=6, height=6)

for(j in 1:6){
	categ<-orderedcats[j]
	p1a<-rrheat3(r5ma[r5ma$Category==categ,])
	 png(paste0(parentdir, "/images/rare_common_diff2", categ, "_sub.png"),
	 	height=5, width=5, units="in", res=300)
	 pushViewport(viewport(width=unit(5, "in"), height=unit(5, "in")))
	 grid.draw(ggplotGrob(p1a))
	 dev.off()
}

# trim whitespace on panels with imagemagick mogrify
trimcmd <- paste0("mogrify -trim ", parentdir, "/images/rare_common_diff*_sub.png")
system(trimcmd)

##############################################################################
# Compare MAC10+ with A&V rates
##############################################################################

avrates <- read.table(paste0(parentdir, "/posterior_7bp.txt"),
	header=T, stringsAsFactors=F, sep="\t")
head(avrates)
names(avrates)[1] <- "SEQUENCE"
avrates$CAT <- paste0(substr(avrates$SEQUENCE,4,4), substr(avrates$alt, 4,4))
avrates$Category[avrates$CAT=="AC" | avrates$CAT=="TG"] <- "AT_CG"
avrates$Category[avrates$CAT=="AG" | avrates$CAT=="TC"] <- "AT_GC"
avrates$Category[avrates$CAT=="AT" | avrates$CAT=="TA"] <- "AT_TA"
avrates$Category[avrates$CAT=="GA" | avrates$CAT=="CT"] <- "GC_AT"
avrates$Category[avrates$CAT=="GC" | avrates$CAT=="CG"] <- "GC_CG"
avrates$Category[avrates$CAT=="GT" | avrates$CAT=="CA"] <- "GC_TA"
cat("Assigning avrates CpG categories...\n")
# Second category column to include +3 CpG categories
# avrates$Category <- ifelse(substr(avrates$SEQUENCE,4,5)=="CG",
#                              paste0("cpg_",avrates$Category),
#                              avrates$Category)
names(avrates)[1] <- "Sequence"
# avrates$Sequence<-paste0(avrates$Sequence, "(", avrates$alt, ")")
r5m1<-r5m
r5m1$Sequence<-substr(r5m1$Sequence, 1, 7)
rm<-merge(r5m1, avrates, by=c("Sequence", "Category"))

rm<-rm %>%
	mutate(Category2 = plyr::mapvalues(Category2, orderedcats1, orderedcats2))
rm$Category2 <- factor(rm$Category2, levels=orderedcats2)
rm2 <- rm %>% dplyr::select(-Category2)

ggplot(data=rm, aes(x=common_rel_prop, y=eur/(mean(eur)/mean(common_rel_prop))))+
	geom_point(aes(group=Category2, colour=Category2),
		alpha=0.3, size=2, shape=1)+
  xlab("Relative mutation rate \n (BRIDGES MAC10+)")+
  ylab("Relative mutation rate \n (1000G EUR intergenic variants)")+
	geom_abline(intercept=0, linetype="dashed")+
	scale_x_log10(labels=c(0.0001, 0.001, 0.01, 0.1),
		breaks=c(0.0001, 0.001, 0.01, 0.1),
		limits=c(0.000025, 0.1))+
  scale_y_log10(labels=c(0.0001, 0.001, 0.01, 0.1),
		breaks=c(0.0001, 0.001, 0.01, 0.1),
		limits=c(0.000025, 0.1))+
	coord_fixed()+
	scale_colour_manual(values=cols)+
	guides(colour = guide_legend(title=NULL, nrow=3,
		override.aes = list(alpha=1, shape=16)))+
  theme_bw()+
  theme(
		legend.position="bottom",
    strip.text.x=element_text(size=14),
    legend.title=element_text(size=12),
    axis.title.x=element_text(size=14),
    axis.title.y=element_text(size=14),
		axis.text.x=element_text(size=12, angle=45, hjust=1, vjust=1),
		axis.text.y=element_text(size=12))
ggsave(paste0(parentdir, "/images/com_av_cor_rates_no_facet.png"),
	width=4, height=5)

rmcora <- rm %>%
	group_by(Category2) %>%
	summarise(cor=cor(common_rel_prop, eur, method="spearman")) %>%
	mutate(label=paste0("rho=", round(cor,2)))

ggplot(data=rm, aes(x=common_rel_prop, y=eur/(mean(eur)/mean(common_rel_prop))))+
  geom_point(data=rm2, alpha=0.3, size=2, colour="grey70")+
	# geom_point(aes(group=Category2, colour=Category2), alpha=0.3, size=2)+
  xlab("Relative rate (BRIDGES MAC10+)")+
  ylab("Relative mutation rate \n (1000G EUR intergenic variants)")+
	geom_hex(bins=50)+
	geom_text(data=r5mcora, aes(label=paste0("rho==", round(cor,2))),
            x=-Inf, y=Inf, hjust=0, vjust=1, parse=TRUE, size=4)+
  # geom_smooth(se=F, colour="red", linetype="dashed", aes(alpha=0.6))+
  geom_abline(intercept=0, linetype="dashed")+
	scale_x_log10(labels=c(0.0001, 0.001, 0.01, 0.1),
		breaks=c(0.0001, 0.001, 0.01, 0.1),
		limits=c(0.000025, 0.1))+
  scale_y_log10(labels=c(0.0001, 0.001, 0.01, 0.1),
		breaks=c(0.0001, 0.001, 0.01, 0.1),
		limits=c(0.000025, 0.1))+
	coord_fixed()+
  scale_colour_manual("Mutation Type", values=cols)+
  scale_fill_gradientn(colours = myPalette(6))+
	facet_wrap(~Category2, dir="v")+
  theme_bw()+
  theme(
    legend.position="none",
    strip.text.x=element_text(size=14),
    legend.title=element_text(size=12),
    axis.title.x=element_text(size=14),
    axis.title.y=element_text(size=14),
		axis.text.x=element_text(size=12, angle=45, hjust=1, vjust=1),
		axis.text.y=element_text(size=12))
ggsave(paste0(parentdir, "/images/com_av_cor_rates_facet.png"),
  width=6, height=6)

rm$prop_diff <- (rm$eur/(mean(rm$eur)/mean(rm$common_rel_prop)))/rm$common_rel_prop
rm$prop_diff4 <- rm$prop_diff
rm$prop_diff4[rm$prop_diff< 0.5] <- 0.5
rm$prop_diff4[rm$prop_diff>2] <- 2

# rm$prop_diff4 <- rm$num.y/rm$num.x
# rm$prop_diff4 <- rm$prop_diff4/mean(rm$prop_diff4)
#
# rm$prop_diff5 <- rm$prop_diff4
# rm$prop_diff4[rm$prop_diff4< 0.5] <- 0.5
# rm$prop_diff4[rm$prop_diff4>2] <- 2

# r5m$v2 <- substr(r5m$Sequence,1,adj)
# r5m$v2a <- as.character(lapply(as.vector(r5m$v2), reverse_chars))
# r5m$v2a <- factor(r5m$v2a)
# r5m$v3 <- substr(r5m$Sequence,adj+2,adj*2+1)

for(j in 1:6){
	categ<-orderedcats[j]
	dat <- rm[rm$Category==categ,]
	dat$prop_diff <- (dat$eur/dat$common_rel_prop)*(mean(dat$common_rel_prop)/mean(dat$eur))
	dat$prop_diff4 <- dat$prop_diff
	dat$prop_diff4[dat$prop_diff< 0.5] <- 0.5
	dat$prop_diff4[dat$prop_diff>2] <- 2
	print(nrow(dat[(dat$prop_diff4==2 | dat$prop_diff4==0.5),]))
	p1a<-rrheat3(dat)
	 png(paste0(parentdir, "/images/rare_common_diff2", categ, "_com_av.png"),
	 	height=5, width=5, units="in", res=300)
	 pushViewport(viewport(width=unit(5, "in"), height=unit(5, "in")))
	 grid.draw(ggplotGrob(p1a))
	 dev.off()
}

# trim whitespace on panels with imagemagick mogrify
trimcmd <- paste0("mogrify -trim ", parentdir, "/images/rare_common_diff*_av.png")
system(trimcmd)

##############################################################################
# Plot A>G subtypes
##############################################################################
pcadat <- prcomp(r5m[r5m$Category2=="A>G",c(5,8)])

dat <- data.frame(cbind(pcadat$x, r5m[r5m$Category2=="A>G",]))
dat$cluster <- ifelse(dat$PC2>0.003, 2,1)
dat$Sequence <- substr(dat$Sequence, 0, 7)
dat$cgs <- ifelse(substr(dat$Sequence, 1,2)%in%c("CC", "CG", "GG", "GC"), 1,0)
dat$ts <- ifelse(grepl("T", dat$Sequence), 0,1)
dat$num_GC_flank <- ifelse(str_count(dat$Sequence, "A|T")<=3,">=4","<4")
dat$maxc <- ifelse(log(dat$prop_diff5)>0.69, ">2", "<2")
dat$maxc <- factor(dat$maxc, levels=c("<2", ">2"))

ggplot(data=dat,
		aes(x=rel_prop, y=common_rel_prop,
			group=Category2, colour=maxc, shape=num_GC_flank))+
  geom_point(alpha=0.7, size=2)+
	scale_colour_brewer(palette="Set2")+
	scale_x_log10()+
	scale_y_log10()+
	scale_shape(solid = FALSE)+
  xlab("Relative rate (downsampled BRIDGES ERVs)")+
  ylab("Relative rate (BRIDGES MAC10+ variants)")+
	guides(shape = guide_legend("#G/C bases in flanking region"),
		colour = guide_legend("MAC10+:ERV ratio", override.aes = list(alpha=1)))+
  theme_bw()+
  theme(legend.position = "bottom",
    legend.title=element_text(size=16),
    axis.title.x=element_text(size=18),
    axis.title.y=element_text(size=18))
ggsave(paste0(parentdir, "/images/AT_GC_scatter.png"), width=8, height=6)


library(ggplot2)
load(url("http://www.clutchmemes.com/cs125/dembubbledf.RData"))

##CODE WILL NOT WORK AS IS to PRODUCE THE 365 PNG'S ALTHOUGH IT WILL RUN WITHOUT A PROBLEM
##TO RUN THIS AS I RAN IT, YOU WILL NEED A IDE WITH A MACROS RECORDING SYSTEM
##FOR SUBLIME TEXT 3, THIS IS CTRL-Q TO RECORD, CTRL-Q TO STOP RECORDING, CTRL-SHIFT-Q TO ACTIVATE THE KEYSTROKES.

##THEREFORE IT IS A GIVEN THAT YOU WILL NEED SUBLIME TEXT, A PACKAGED CALLED REPL WHICH INSTALLS R AND PYTHON WORKING ENVIRONMENTS WITHIN SUBLIME, CUSTOM KEYBINDINGS FOR REPL, WHICH FOR ME, I HAVE IT SET TO COMMAND-OPT-S TO SELECTIVELY RUN SOMETHING

##STARTING RECORDING AT THE BEGINNING OF day1 <-..., OPT-SHIFT-RIGHT, COMMAND-RIGHT, COMMAND-SHIFT-LEFT, DELETE, COMMAND-UP, OPT-DOWN, DOWN, OPT-RIGHT, COMMAND-V, TYPE 'plot', OPT-RIGHT-RIGHT-RIGHT, OPT-SHIFT-LEFT, COMMAND-V, OPT-DOWN, DOWN, COMMAND-RIGHT, OPT-LEFT-LEFT-LEFT-LEFT-LEFT-LEFT, OPT-SHIFT-RIGHT, COMMANDV, OPT-DOWN, DOWN, COMMAND-SHIFT-UP, OPT-COMMAND-S, DOWN.

#Run the day1 <- ... day365 <- code first. and then move cursor to the beginning of the line at day1 <-...

#Run the day1 <- ... day365 <- code first. and then move cursor to the beginning of the line at day1 <-...

day1 <- ggplot(day1, aes(x = Percentage, y = Change.In.Polling.Percentage, size = Searched, fill=Candidate, label=Candidate)) +
  labs(x="Total Percentage of Democrat Vote", y="Change in Percentage")+
  geom_point(shape = 21, show_guide = FALSE) +
  geom_text(size=4)+
  # map z to area and make larger circles
  scale_size_area(max_size = 70) +
  scale_x_continuous(breaks = c(20, 40, 60, 80), limit = c(0, 100),
                     expand = c(0, 0)) +
  scale_y_continuous(breaks = c(-40, -20, 0, 20, 40), limit = c(-60, 60),
                     expand = c(0, 0)) +
  theme_bw() +
  theme(panel.grid.major = element_blank(),
        plot.title = element_text(size = rel(1.5), face = "bold", vjust = 1.5),
        axis.title=element_blank(),
        axis.text.x=element_text(size=10),
        axis.text.y=element_text(size=10))+

ggtitle(paste(as.character(day1$Date[1]), " Democrats"))
ggsave(filename="DEMday1.png")

day1 <- dembubbleDF[c(1, 366),]
day2 <- dembubbleDF[c(2, 367),]
day3 <- dembubbleDF[c(3, 368),]
day4 <- dembubbleDF[c(4, 369),]
day5 <- dembubbleDF[c(5, 370),]
day6 <- dembubbleDF[c(6, 371),]
day7 <- dembubbleDF[c(7, 372),]
day8 <- dembubbleDF[c(8, 373),]
day9 <- dembubbleDF[c(9, 374),]
day10 <- dembubbleDF[c(10, 375),]
day11 <- dembubbleDF[c(11, 376),]
day12 <- dembubbleDF[c(12, 377),]
day13 <- dembubbleDF[c(13, 378),]
day14 <- dembubbleDF[c(14, 379),]
day15 <- dembubbleDF[c(15, 380),]
day16 <- dembubbleDF[c(16, 381),]
day17 <- dembubbleDF[c(17, 382),]
day18 <- dembubbleDF[c(18, 383),]
day19 <- dembubbleDF[c(19, 384),]
day20 <- dembubbleDF[c(20, 385),]
day21 <- dembubbleDF[c(21, 386),]
day22 <- dembubbleDF[c(22, 387),]
day23 <- dembubbleDF[c(23, 388),]
day24 <- dembubbleDF[c(24, 389),]
day25 <- dembubbleDF[c(25, 390),]
day26 <- dembubbleDF[c(26, 391),]
day27 <- dembubbleDF[c(27, 392),]
day28 <- dembubbleDF[c(28, 393),]
day29 <- dembubbleDF[c(29, 394),]
day30 <- dembubbleDF[c(30, 395),]
day31 <- dembubbleDF[c(31, 396),]
day32 <- dembubbleDF[c(32, 397),]
day33 <- dembubbleDF[c(33, 398),]
day34 <- dembubbleDF[c(34, 399),]
day35 <- dembubbleDF[c(35, 400),]
day36 <- dembubbleDF[c(36, 401),]
day37 <- dembubbleDF[c(37, 402),]
day38 <- dembubbleDF[c(38, 403),]
day39 <- dembubbleDF[c(39, 404),]
day40 <- dembubbleDF[c(40, 405),]
day41 <- dembubbleDF[c(41, 406),]
day42 <- dembubbleDF[c(42, 407),]
day43 <- dembubbleDF[c(43, 408),]
day44 <- dembubbleDF[c(44, 409),]
day45 <- dembubbleDF[c(45, 410),]
day46 <- dembubbleDF[c(46, 411),]
day47 <- dembubbleDF[c(47, 412),]
day48 <- dembubbleDF[c(48, 413),]
day49 <- dembubbleDF[c(49, 414),]
day50 <- dembubbleDF[c(50, 415),]
day51 <- dembubbleDF[c(51, 416),]
day52 <- dembubbleDF[c(52, 417),]
day53 <- dembubbleDF[c(53, 418),]
day54 <- dembubbleDF[c(54, 419),]
day55 <- dembubbleDF[c(55, 420),]
day56 <- dembubbleDF[c(56, 421),]
day57 <- dembubbleDF[c(57, 422),]
day58 <- dembubbleDF[c(58, 423),]
day59 <- dembubbleDF[c(59, 424),]
day60 <- dembubbleDF[c(60, 425),]
day61 <- dembubbleDF[c(61, 426),]
day62 <- dembubbleDF[c(62, 427),]
day63 <- dembubbleDF[c(63, 428),]
day64 <- dembubbleDF[c(64, 429),]
day65 <- dembubbleDF[c(65, 430),]
day66 <- dembubbleDF[c(66, 431),]
day67 <- dembubbleDF[c(67, 432),]
day68 <- dembubbleDF[c(68, 433),]
day69 <- dembubbleDF[c(69, 434),]
day70 <- dembubbleDF[c(70, 435),]
day71 <- dembubbleDF[c(71, 436),]
day72 <- dembubbleDF[c(72, 437),]
day73 <- dembubbleDF[c(73, 438),]
day74 <- dembubbleDF[c(74, 439),]
day75 <- dembubbleDF[c(75, 440),]
day76 <- dembubbleDF[c(76, 441),]
day77 <- dembubbleDF[c(77, 442),]
day78 <- dembubbleDF[c(78, 443),]
day79 <- dembubbleDF[c(79, 444),]
day80 <- dembubbleDF[c(80, 445),]
day81 <- dembubbleDF[c(81, 446),]
day82 <- dembubbleDF[c(82, 447),]
day83 <- dembubbleDF[c(83, 448),]
day84 <- dembubbleDF[c(84, 449),]
day85 <- dembubbleDF[c(85, 450),]
day86 <- dembubbleDF[c(86, 451),]
day87 <- dembubbleDF[c(87, 452),]
day88 <- dembubbleDF[c(88, 453),]
day89 <- dembubbleDF[c(89, 454),]
day90 <- dembubbleDF[c(90, 455),]
day91 <- dembubbleDF[c(91, 456),]
day92 <- dembubbleDF[c(92, 457),]
day93 <- dembubbleDF[c(93, 458),]
day94 <- dembubbleDF[c(94, 459),]
day95 <- dembubbleDF[c(95, 460),]
day96 <- dembubbleDF[c(96, 461),]
day97 <- dembubbleDF[c(97, 462),]
day98 <- dembubbleDF[c(98, 463),]
day99 <- dembubbleDF[c(99, 464),]
day100 <- dembubbleDF[c(100, 465),]
day101 <- dembubbleDF[c(101, 466),]
day102 <- dembubbleDF[c(102, 467),]
day103 <- dembubbleDF[c(103, 468),]
day104 <- dembubbleDF[c(104, 469),]
day105 <- dembubbleDF[c(105, 470),]
day106 <- dembubbleDF[c(106, 471),]
day107 <- dembubbleDF[c(107, 472),]
day108 <- dembubbleDF[c(108, 473),]
day109 <- dembubbleDF[c(109, 474),]
day110 <- dembubbleDF[c(110, 475),]
day111 <- dembubbleDF[c(111, 476),]
day112 <- dembubbleDF[c(112, 477),]
day113 <- dembubbleDF[c(113, 478),]
day114 <- dembubbleDF[c(114, 479),]
day115 <- dembubbleDF[c(115, 480),]
day116 <- dembubbleDF[c(116, 481),]
day117 <- dembubbleDF[c(117, 482),]
day118 <- dembubbleDF[c(118, 483),]
day119 <- dembubbleDF[c(119, 484),]
day120 <- dembubbleDF[c(120, 485),]
day121 <- dembubbleDF[c(121, 486),]
day122 <- dembubbleDF[c(122, 487),]
day123 <- dembubbleDF[c(123, 488),]
day124 <- dembubbleDF[c(124, 489),]
day125 <- dembubbleDF[c(125, 490),]
day126 <- dembubbleDF[c(126, 491),]
day127 <- dembubbleDF[c(127, 492),]
day128 <- dembubbleDF[c(128, 493),]
day129 <- dembubbleDF[c(129, 494),]
day130 <- dembubbleDF[c(130, 495),]
day131 <- dembubbleDF[c(131, 496),]
day132 <- dembubbleDF[c(132, 497),]
day133 <- dembubbleDF[c(133, 498),]
day134 <- dembubbleDF[c(134, 499),]
day135 <- dembubbleDF[c(135, 500),]
day136 <- dembubbleDF[c(136, 501),]
day137 <- dembubbleDF[c(137, 502),]
day138 <- dembubbleDF[c(138, 503),]
day139 <- dembubbleDF[c(139, 504),]
day140 <- dembubbleDF[c(140, 505),]
day141 <- dembubbleDF[c(141, 506),]
day142 <- dembubbleDF[c(142, 507),]
day143 <- dembubbleDF[c(143, 508),]
day144 <- dembubbleDF[c(144, 509),]
day145 <- dembubbleDF[c(145, 510),]
day146 <- dembubbleDF[c(146, 511),]
day147 <- dembubbleDF[c(147, 512),]
day148 <- dembubbleDF[c(148, 513),]
day149 <- dembubbleDF[c(149, 514),]
day150 <- dembubbleDF[c(150, 515),]
day151 <- dembubbleDF[c(151, 516),]
day152 <- dembubbleDF[c(152, 517),]
day153 <- dembubbleDF[c(153, 518),]
day154 <- dembubbleDF[c(154, 519),]
day155 <- dembubbleDF[c(155, 520),]
day156 <- dembubbleDF[c(156, 521),]
day157 <- dembubbleDF[c(157, 522),]
day158 <- dembubbleDF[c(158, 523),]
day159 <- dembubbleDF[c(159, 524),]
day160 <- dembubbleDF[c(160, 525),]
day161 <- dembubbleDF[c(161, 526),]
day162 <- dembubbleDF[c(162, 527),]
day163 <- dembubbleDF[c(163, 528),]
day164 <- dembubbleDF[c(164, 529),]
day165 <- dembubbleDF[c(165, 530),]
day166 <- dembubbleDF[c(166, 531),]
day167 <- dembubbleDF[c(167, 532),]
day168 <- dembubbleDF[c(168, 533),]
day169 <- dembubbleDF[c(169, 534),]
day170 <- dembubbleDF[c(170, 535),]
day171 <- dembubbleDF[c(171, 536),]
day172 <- dembubbleDF[c(172, 537),]
day173 <- dembubbleDF[c(173, 538),]
day174 <- dembubbleDF[c(174, 539),]
day175 <- dembubbleDF[c(175, 540),]
day176 <- dembubbleDF[c(176, 541),]
day177 <- dembubbleDF[c(177, 542),]
day178 <- dembubbleDF[c(178, 543),]
day179 <- dembubbleDF[c(179, 544),]
day180 <- dembubbleDF[c(180, 545),]
day181 <- dembubbleDF[c(181, 546),]
day182 <- dembubbleDF[c(182, 547),]
day183 <- dembubbleDF[c(183, 548),]
day184 <- dembubbleDF[c(184, 549),]
day185 <- dembubbleDF[c(185, 550),]
day186 <- dembubbleDF[c(186, 551),]
day187 <- dembubbleDF[c(187, 552),]
day188 <- dembubbleDF[c(188, 553),]
day189 <- dembubbleDF[c(189, 554),]
day190 <- dembubbleDF[c(190, 555),]
day191 <- dembubbleDF[c(191, 556),]
day192 <- dembubbleDF[c(192, 557),]
day193 <- dembubbleDF[c(193, 558),]
day194 <- dembubbleDF[c(194, 559),]
day195 <- dembubbleDF[c(195, 560),]
day196 <- dembubbleDF[c(196, 561),]
day197 <- dembubbleDF[c(197, 562),]
day198 <- dembubbleDF[c(198, 563),]
day199 <- dembubbleDF[c(199, 564),]
day200 <- dembubbleDF[c(200, 565),]
day201 <- dembubbleDF[c(201, 566),]
day202 <- dembubbleDF[c(202, 567),]
day203 <- dembubbleDF[c(203, 568),]
day204 <- dembubbleDF[c(204, 569),]
day205 <- dembubbleDF[c(205, 570),]
day206 <- dembubbleDF[c(206, 571),]
day207 <- dembubbleDF[c(207, 572),]
day208 <- dembubbleDF[c(208, 573),]
day209 <- dembubbleDF[c(209, 574),]
day210 <- dembubbleDF[c(210, 575),]
day211 <- dembubbleDF[c(211, 576),]
day212 <- dembubbleDF[c(212, 577),]
day213 <- dembubbleDF[c(213, 578),]
day214 <- dembubbleDF[c(214, 579),]
day215 <- dembubbleDF[c(215, 580),]
day216 <- dembubbleDF[c(216, 581),]
day217 <- dembubbleDF[c(217, 582),]
day218 <- dembubbleDF[c(218, 583),]
day219 <- dembubbleDF[c(219, 584),]
day220 <- dembubbleDF[c(220, 585),]
day221 <- dembubbleDF[c(221, 586),]
day222 <- dembubbleDF[c(222, 587),]
day223 <- dembubbleDF[c(223, 588),]
day224 <- dembubbleDF[c(224, 589),]
day225 <- dembubbleDF[c(225, 590),]
day226 <- dembubbleDF[c(226, 591),]
day227 <- dembubbleDF[c(227, 592),]
day228 <- dembubbleDF[c(228, 593),]
day229 <- dembubbleDF[c(229, 594),]
day230 <- dembubbleDF[c(230, 595),]
day231 <- dembubbleDF[c(231, 596),]
day232 <- dembubbleDF[c(232, 597),]
day233 <- dembubbleDF[c(233, 598),]
day234 <- dembubbleDF[c(234, 599),]
day235 <- dembubbleDF[c(235, 600),]
day236 <- dembubbleDF[c(236, 601),]
day237 <- dembubbleDF[c(237, 602),]
day238 <- dembubbleDF[c(238, 603),]
day239 <- dembubbleDF[c(239, 604),]
day240 <- dembubbleDF[c(240, 605),]
day241 <- dembubbleDF[c(241, 606),]
day242 <- dembubbleDF[c(242, 607),]
day243 <- dembubbleDF[c(243, 608),]
day244 <- dembubbleDF[c(244, 609),]
day245 <- dembubbleDF[c(245, 610),]
day246 <- dembubbleDF[c(246, 611),]
day247 <- dembubbleDF[c(247, 612),]
day248 <- dembubbleDF[c(248, 613),]
day249 <- dembubbleDF[c(249, 614),]
day250 <- dembubbleDF[c(250, 615),]
day251 <- dembubbleDF[c(251, 616),]
day252 <- dembubbleDF[c(252, 617),]
day253 <- dembubbleDF[c(253, 618),]
day254 <- dembubbleDF[c(254, 619),]
day255 <- dembubbleDF[c(255, 620),]
day256 <- dembubbleDF[c(256, 621),]
day257 <- dembubbleDF[c(257, 622),]
day258 <- dembubbleDF[c(258, 623),]
day259 <- dembubbleDF[c(259, 624),]
day260 <- dembubbleDF[c(260, 625),]
day261 <- dembubbleDF[c(261, 626),]
day262 <- dembubbleDF[c(262, 627),]
day263 <- dembubbleDF[c(263, 628),]
day264 <- dembubbleDF[c(264, 629),]
day265 <- dembubbleDF[c(265, 630),]
day266 <- dembubbleDF[c(266, 631),]
day267 <- dembubbleDF[c(267, 632),]
day268 <- dembubbleDF[c(268, 633),]
day269 <- dembubbleDF[c(269, 634),]
day270 <- dembubbleDF[c(270, 635),]
day271 <- dembubbleDF[c(271, 636),]
day272 <- dembubbleDF[c(272, 637),]
day273 <- dembubbleDF[c(273, 638),]
day274 <- dembubbleDF[c(274, 639),]
day275 <- dembubbleDF[c(275, 640),]
day276 <- dembubbleDF[c(276, 641),]
day277 <- dembubbleDF[c(277, 642),]
day278 <- dembubbleDF[c(278, 643),]
day279 <- dembubbleDF[c(279, 644),]
day280 <- dembubbleDF[c(280, 645),]
day281 <- dembubbleDF[c(281, 646),]
day282 <- dembubbleDF[c(282, 647),]
day283 <- dembubbleDF[c(283, 648),]
day284 <- dembubbleDF[c(284, 649),]
day285 <- dembubbleDF[c(285, 650),]
day286 <- dembubbleDF[c(286, 651),]
day287 <- dembubbleDF[c(287, 652),]
day288 <- dembubbleDF[c(288, 653),]
day289 <- dembubbleDF[c(289, 654),]
day290 <- dembubbleDF[c(290, 655),]
day291 <- dembubbleDF[c(291, 656),]
day292 <- dembubbleDF[c(292, 657),]
day293 <- dembubbleDF[c(293, 658),]
day294 <- dembubbleDF[c(294, 659),]
day295 <- dembubbleDF[c(295, 660),]
day296 <- dembubbleDF[c(296, 661),]
day297 <- dembubbleDF[c(297, 662),]
day298 <- dembubbleDF[c(298, 663),]
day299 <- dembubbleDF[c(299, 664),]
day300 <- dembubbleDF[c(300, 665),]
day301 <- dembubbleDF[c(301, 666),]
day302 <- dembubbleDF[c(302, 667),]
day303 <- dembubbleDF[c(303, 668),]
day304 <- dembubbleDF[c(304, 669),]
day305 <- dembubbleDF[c(305, 670),]
day306 <- dembubbleDF[c(306, 671),]
day307 <- dembubbleDF[c(307, 672),]
day308 <- dembubbleDF[c(308, 673),]
day309 <- dembubbleDF[c(309, 674),]
day310 <- dembubbleDF[c(310, 675),]
day311 <- dembubbleDF[c(311, 676),]
day312 <- dembubbleDF[c(312, 677),]
day313 <- dembubbleDF[c(313, 678),]
day314 <- dembubbleDF[c(314, 679),]
day315 <- dembubbleDF[c(315, 680),]
day316 <- dembubbleDF[c(316, 681),]
day317 <- dembubbleDF[c(317, 682),]
day318 <- dembubbleDF[c(318, 683),]
day319 <- dembubbleDF[c(319, 684),]
day320 <- dembubbleDF[c(320, 685),]
day321 <- dembubbleDF[c(321, 686),]
day322 <- dembubbleDF[c(322, 687),]
day323 <- dembubbleDF[c(323, 688),]
day324 <- dembubbleDF[c(324, 689),]
day325 <- dembubbleDF[c(325, 690),]
day326 <- dembubbleDF[c(326, 691),]
day327 <- dembubbleDF[c(327, 692),]
day328 <- dembubbleDF[c(328, 693),]
day329 <- dembubbleDF[c(329, 694),]
day330 <- dembubbleDF[c(330, 695),]
day331 <- dembubbleDF[c(331, 696),]
day332 <- dembubbleDF[c(332, 697),]
day333 <- dembubbleDF[c(333, 698),]
day334 <- dembubbleDF[c(334, 699),]
day335 <- dembubbleDF[c(335, 700),]
day336 <- dembubbleDF[c(336, 701),]
day337 <- dembubbleDF[c(337, 702),]
day338 <- dembubbleDF[c(338, 703),]
day339 <- dembubbleDF[c(339, 704),]
day340 <- dembubbleDF[c(340, 705),]
day341 <- dembubbleDF[c(341, 706),]
day342 <- dembubbleDF[c(342, 707),]
day343 <- dembubbleDF[c(343, 708),]
day344 <- dembubbleDF[c(344, 709),]
day345 <- dembubbleDF[c(345, 710),]
day346 <- dembubbleDF[c(346, 711),]
day347 <- dembubbleDF[c(347, 712),]
day348 <- dembubbleDF[c(348, 713),]
day349 <- dembubbleDF[c(349, 714),]
day350 <- dembubbleDF[c(350, 715),]
day351 <- dembubbleDF[c(351, 716),]
day352 <- dembubbleDF[c(352, 717),]
day353 <- dembubbleDF[c(353, 718),]
day354 <- dembubbleDF[c(354, 719),]
day355 <- dembubbleDF[c(355, 720),]
day356 <- dembubbleDF[c(356, 721),]
day357 <- dembubbleDF[c(357, 722),]
day358 <- dembubbleDF[c(358, 723),]
day359 <- dembubbleDF[c(359, 724),]
day360 <- dembubbleDF[c(360, 725),]
day361 <- dembubbleDF[c(361, 726),]
day362 <- dembubbleDF[c(362, 727),]
day363 <- dembubbleDF[c(363, 728),]
day364 <- dembubbleDF[c(364, 729),]
day365 <- dembubbleDF[c(365, 730),]


library("monocle")
library("reshape")
args <- commandArgs(trailingOnly=TRUE)
HSMM <- readRDS('post_quality_control_data.rds')
pData(HSMM)$Size_Factor <- NULL
rownames(pData(HSMM)) <- NULL
pData(HSMM)$Total_mRNAs <- Matrix::colSums(exprs(HSMM))
write.table(pData(HSMM), "before_decision_heatmap_pData_table.txt", sep="\t",quote=FALSE)
write.table(exprs(HSMM), "before_decision_heatmap_exprs_table.txt", sep="\t",quote=FALSE)


rm(list=ls())
wd <- "/home/eric/Desktop/MXelsCalendGovt/elecReturns/datosBrutos/resultCasillas"
setwd(wd)

# secc-munn
sm <- read.csv(file = "../../../redistrict/ife.ine/equivSecc/tablaEquivalenciasSeccionalesDesde1994.csv", stringsAsFactors = FALSE)
sm <- sm[,c("edon","seccion","munn")]

###########
# df 2018 #
###########
df <- read.csv(file = "eum2018all/eum2018dfca.csv", stringsAsFactors = FALSE)
df$casn <- paste(df$casn, df$TIPO_CASILLA, sep = "")

# hace numéricos los votos
df$edon <- as.numeric(df$edon)
df$disn <- as.numeric(df$disn)
df$seccion <- as.numeric(df$seccion)
df$pan <- as.numeric(df$pan)
df$pri <- as.numeric(df$pri)
df$prd <- as.numeric(df$prd)
df$pvem <- as.numeric(df$pvem)
df$pt <- as.numeric(df$pt)
df$mc <- as.numeric(df$mc)
df$panal <- as.numeric(df$panal)
df$morena <- as.numeric(df$morena)
df$pes <- as.numeric(df$pes)
df$pan.prd.mc <- as.numeric(df$pan.prd.mc)
df$pri.pvem.panal <- as.numeric(df$pri.pvem.panal)
df$pt.morena.pes <- as.numeric(df$pt.morena.pes)
df$indep1 <- as.numeric(df$indep1)
df$indep2 <- as.numeric(df$indep2)
df$nr <- as.numeric(df$nr)
df$nul <- as.numeric(df$nul)
df$tot <- as.numeric(df$tot)
df$lisnom <- as.numeric(df$lisnom)

# cambia NAs por ceros
tmp <- df[, c("edon", "disn", "seccion", "pan", "pri", "prd", "pvem", "pt", "mc", "panal", "morena", "pes", "pan.prd.mc", "pri.pvem.panal", "pt.morena.pes", "indep1", "indep2", "nr", "nul", "lisnom")]
tmp[is.na(tmp)==TRUE] <- 0
df[, c("edon", "disn", "seccion", "pan", "pri", "prd", "pvem", "pt", "mc", "panal", "morena", "pes", "pan.prd.mc", "pri.pvem.panal", "pt.morena.pes", "indep1", "indep2", "nr", "nul", "lisnom")] <- tmp

# efec
df$efec <- df$tot - df$nr - df$nul

## # consolida frente
## df$cpan <- 0
## sel <- which(df$edon!=17 & df$edon!=19)
## tmp <- df[sel,]
## tmp$cpan <- tmp$pan + tmp$prd + tmp$mc + tmp$pan.prd.mc
## tmp$pan <- tmp$prd <- tmp$mc <- 0
## df[sel,] <- tmp
## df$pan.prd.mc <- NULL
## # consolida coalicion amlo
## df$cmorena <- 0
## sel <- which(df$edon!=13)
## tmp <- df[sel,]
## tmp$cmorena <- tmp$morena + tmp$pt + tmp$pes + tmp$pt.morena.pes
## tmp$morena <- tmp$pt <- tmp$pes <- 0
## df[sel,] <- tmp
## df$pt.morena.pes <- NULL
## # consolida coal pri
## df$cpri <- 0
## sel <- which(df$edon!=13) # hay que hacer un listado de dónde no hubo coal pri
## tmp <- df[sel,]
## tmp$cpri <- tmp$pri + tmp$pvem + tmp$panal + tmp$pri.pvem.panal
## tmp$pri <- tmp$pvem <- tmp$panal <- 0
## df[sel,] <- tmp
## df$pri.pvem.panal <- NULL
## #
## rm(sel)

# clean
df$tot <- df$nr <- df$nul <- NULL
df$CASILLA <- df$TIPO_CASILLA <- df$EXT_CONTIGUA <- df$CASILLA <- df$OBSERVACIONES <- df$FECHA_HORA <- NULL
#df <- df[, c("edon", "edo", "disn", "cabecera", "seccion", "casn", "pan", "cpan", "pri", "cpri", "prd", "pvem", "pt", "mc", "panal", "morena", "cmorena", "pes", "indep1", "indep2", "efec", "lisnom")] # sort columns
df <- df[, c("edon", "edo", "disn", "cabecera", "seccion", "casn", "pan", "pri", "prd", "pvem", "pt", "mc", "panal", "morena", "pes", "pan.prd.mc", "pri.pvem.panal", "pt.morena.pes", "indep1", "indep2", "efec", "lisnom")] # sort columns

# consolida secciones
df2 <- df # duplica datos
df$pan <- ave(df$pan, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
df$pri <- ave(df$pri, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
df$prd <- ave(df$prd, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
df$pvem <- ave(df$pvem, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
df$pt <- ave(df$pt, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
df$mc <- ave(df$mc, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
df$panal <- ave(df$panal, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
df$morena <- ave(df$morena, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
df$pes <- ave(df$pes, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
df$indep1 <- ave(df$indep1, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
df$indep2 <- ave(df$indep2, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
df$lisnom <- ave(df$lisnom, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
df$efec <- ave(df$efec, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
df$pan.prd.mc <- ave(df$pan.prd.mc, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
df$pri.pvem.panal <- ave(df$pri.pvem.panal, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
df$pt.morena.pes <- ave(df$pt.morena.pes, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
## df$cpan <- ave(df$cpan, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
## df$cpri <- ave(df$cpri, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
## df$cmorena <- ave(df$cmorena, as.factor(df$edon*10000+df$seccion), FUN=sum, na.rm=TRUE)
#
df <- df[duplicated(df$edon*10000+df$seccion)==FALSE, ]
df$casn <- NULL
#
dfse <- df # renames data approriately
df <- df2  # recupera datos casilla

# consolida distritos
df2 <- df # duplica datos
df$pan <- ave(df$pan, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
df$pri <- ave(df$pri, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
df$prd <- ave(df$prd, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
df$pvem <- ave(df$pvem, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
df$pt <- ave(df$pt, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
df$mc <- ave(df$mc, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
df$panal <- ave(df$panal, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
df$morena <- ave(df$morena, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
df$pes <- ave(df$pes, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
df$indep1 <- ave(df$indep1, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
df$indep2 <- ave(df$indep2, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
df$lisnom <- ave(df$lisnom, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
df$efec <- ave(df$efec, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
df$pan.prd.mc <- ave(df$pan.prd.mc, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
df$pri.pvem.panal <- ave(df$pri.pvem.panal, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
df$pt.morena.pes <- ave(df$pt.morena.pes, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
## df$cpan <- ave(df$cpan, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
## df$cpri <- ave(df$cpri, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
## df$cmorena <- ave(df$cmorena, as.factor(df$edon*100+df$disn), FUN=sum, na.rm=TRUE)
#
df <- df[duplicated(df$edon*100+df$disn)==FALSE, ]
dim(df)
df$casn <- df$seccion <- NULL
#
dfdf <- df # renames data approriately
dfca <- df2  # recupera datos casilla
rm(df)

dim(dfdf)
dfdf[1,]
write.csv(dfdf, file = "eum2018all/eum2018dfdf.csv", row.names = FALSE)

# who won
dfdf$win <- "."
v <- dfdf[, c("pan","cpan","pri","cpri","prd","pvem","pt","mc","panal","morena","cmorena","pes","indep1","indep2")] # saca votos solamente
tmp <- apply(v, 1, max)
sel <- which(v$pan==tmp); dfdf$win[sel] <- "pan"
sel <- which(v$cpan==tmp); dfdf$win[sel] <- "cpan"
sel <- which(v$pri==tmp); dfdf$win[sel] <- "pri"
sel <- which(v$cpri==tmp); dfdf$win[sel] <- "cpri"
sel <- which(v$prd==tmp); dfdf$win[sel] <- "prd"
sel <- which(v$pt==tmp); dfdf$win[sel] <- "pt"
sel <- which(v$pvem==tmp); dfdf$win[sel] <- "pvem"
sel <- which(v$mc==tmp); dfdf$win[sel] <- "mc"
sel <- which(v$panal==tmp); dfdf$win[sel] <- "panal"
sel <- which(v$morena==tmp); dfdf$win[sel] <- "morena"
sel <- which(v$cmorena==tmp); dfdf$win[sel] <- "cmorena"
sel <- which(v$pes==tmp); dfdf$win[sel] <- "pes"
sel <- which(v$indep1==tmp); dfdf$win[sel] <- "indep"
sel <- which(v$indep2==tmp); dfdf$win[sel] <- "indep"

sel <- which(dfdf$win=="cmorena")
dfdf[sel, c("edon", "disn")]


library(sf)
library(data.table)
library(dplyr)

pop_wz_sc <- read.csv("~/Dropbox/liverpool/retail_typology/data/wz/scots_pop.csv", stringsAsFactors = F)
setDT(pop_wz_sc)
pop_wz_ew <- read.csv("~/Dropbox/liverpool/retail_typology/data/wz/pop_ew.csv", stringsAsFactors = F, skip = 8, header = F, col.names = c("oa11", "pop"))
setDT(pop_wz_ew)

probs <- fread("~/Dropbox/liverpool/retail_typology/data/catchments_oa_lookup.csv")

all(unique(probs[substr(oa11, 1, 1) %in% c("E", "W"), ]$oa11 %in% pop_wz_ew$oa11)) # TRUE
all(unique(probs[substr(oa11, 1, 1) == "S", ]$oa11 %in% pop_wz_sc$oa11)) # F
sum(!unique(probs[substr(oa11, 1, 1) == "S", ]$oa11 %in% pop_wz_sc$oa11)) # 1

pop_wz <- rbindlist(list(pop_wz_ew, pop_wz_sc))

pop_wz_probs <- pop_wz[probs, on = "oa11", nomatch = 0]
# pop_wz_stats <- catchments_pop_wz[, {total_pop = sum(pop); list(total_pop, total_pop / sum(area))}, keyby = "cluster_id"]
# setnames(pop_wz_stats, 2:3, c("pop_total_wz", "pop_density_wz"))

pop_total <- pop_wz_probs[, sum(pop * max_huff_prob), keyby = "cluster_id"]
setnames(pop_total, "V1", "working_pop")
fwrite(pop_total, "~/Dropbox/liverpool/retail_typology/data/wz/working_pop_weighted.csv")


#source("italy_data.r")
#source("./ETL/CountrySources/spain_gov_etl.r")

source("./ETL/country_data.r")

#spain_regional_data <- ReadSpainCommunityDataFromCSV("https://covid19.isciii.es/resources/serie_historica_acumulados.csv")
spain_regional_data <-ReadDataForCountry("Spain")
spain_regions <- unique(spain_regional_data$region_code)
madrid_data <- subset(spain_regional_data, region_code=="MD")
madrid_data <- subset(madrid_data, total_cases > 100)
madrid_data <- tail(madrid_data, -3)
madrid_data$ID <- seq.int(nrow(madrid_data))

#italy_regional_data <- ReadItalyDataFromCSV("https://raw.githubusercontent.com/pcm-dpc/COVID-19/master/dati-regioni/dpc-covid19-ita-regioni.csv")
italy_regional_data <- ReadDataForCountry("Italy")
lombardy_data <- subset(italy_regional_data, italy_regional_data$region_code=="3")
lombardy_data <- subset(lombardy_data, total_cases > 100)
lombardy_data$ID <- seq.int(nrow(lombardy_data))

str(nrow(lombardy_data))

str(nrow(madrid_data))

#plot(lombardy_data$ID, lombardy_data$total_icu, type="l")
#lines(madrid_data$ID, madrid_data$total_icu, col="red")

plot(madrid_data$ID, madrid_data$total_hospitalized, type="b", col="red")
lines(lombardy_data$ID, lombardy_data$total_hospitalized)


# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

#' Generate genotype and editing genotype
#'
#' Build date: Nov 14, 2018
#' Last update: Oct 13, 2019
#'
#' @author Dong Yin
#'
#' @param rawgeno extrinsic genotype matrix
#' @param geno genotype matrix need dealing with
#' @param incols the column number of an individual in the input genotype matrix, it can be 1 or 2
#' @param num.marker number of the markers
#' @param num.ind population size of the base population
#' @param prob weight of "0" and "1" in genotype matrix, the sum of elements in vector equal to 1
#' @param blk.rg it represents the starting position and the ending position of a block
#' @param recom.spot whether to consider recombination in every block
#' @param range.hot range of number of chromosome crossovers in a hot spot block
#' @param range.cold range of number of chromosome crossovers in a cold spot block
#' @param rate.mut mutation rate between 1e-8 and 1e-6
#' @param verbose whether to print detail
#'
#' @return a genotype matrix with block and map information
#' @export
#'
#' @examples
#' # get map file and create genotype matrix
#' data(simdata)
#' num.marker = nrow(input.map)
#' num.ind = 100
#' incols = 2
#' basepop.geno <- genotype(num.marker = num.marker, num.ind = num.ind, verbose = TRUE)
#' basepop.geno[1:5, 1:5]
#'
#' # get block information and recombination information
#' nmrk <- nrow(basepop.geno)
#' nind <- ncol(basepop.geno) / incols
#' pos.map <- check.map(input.map = input.map, num.marker = nmrk, len.block = 5e7)
#' blk.rg <- cal.blk(pos.map)
#' recom.spot <- as.numeric(pos.map[blk.rg[, 1], 7])
#'
#' # genotype matrix after Exchange and Mutation
#' basepop.geno.em <-
#' genotype(geno = basepop.geno,
#'          incols = 2,
#'          blk.rg = blk.rg,
#'          recom.spot = recom.spot,
#'          range.hot = 4:6,
#'          range.cold = 1:5,
#'          rate.mut = 1e-8,
#'          verbose = TRUE)
#' basepop.geno.em[1:5, 1:5]
genotype <-
    function(rawgeno = NULL,
             geno = NULL,
             incols = 2,
             num.marker = NULL,
             num.ind = NULL,
             prob = c(0.5, 0.5),
	           blk.rg = NULL,
             recom.spot = NULL,
             range.hot = 4:6,
             range.cold = 1:5,
             rate.mut = 1e-8,
             verbose = TRUE) {

# Start genotype

  if (is.null(rawgeno) & is.null(geno) & is.null(num.marker) & is.null(num.ind)) {
    stop("Please input information of genotype!")
  }

  if (!is.null(rawgeno)) {
    logging.log(" Input outer genotype matrix...\n", verbose = verbose)
    if (!is.matrix(rawgeno)) {
      rawgeno <- as.matrix(rawgeno)
    }
    outgeno <- rawgeno

  } else if (!is.null(num.marker) && !is.null(num.ind)){
    logging.log(" Establish genotype matrix of base-population...\n", verbose = verbose)
    if (incols == 2) {
      codes <- c(0, 1)
    } else if (incols == 1) {
      codes <- c(0, 1, 2)
      if (!is.null(prob))
        prob <- c(prob[1]^2, 2*prob[1]*prob[2], prob[2]^2)
    } else {
      stop("incols should only be 1 or 2!")
    }
    outgeno <- matrix(sample(codes, num.marker*num.ind*incols, prob = prob, replace = TRUE), num.marker, incols*num.ind)

  } else if (!is.null(geno) & !is.null(recom.spot) & incols == 2) {
    logging.log(" Chromosome exchange and mutation on genotype matrix...\n", verbose = verbose)
    num.marker <- nrow(geno)
    num.ind <- ncol(geno) / incols
    # outgeno <- deepcopy(geno) # deepcopy() in bigmemory
    # ind.swap <- sample(c(0, 1), num.ind, replace = TRUE)

    geno.swap <- function(ind) {
      # if (ind.swap[ind] == 0) {
      #   t1 <- geno[, 2*ind-1]
      #   t2 <- geno[, 2*ind]
      #   return(cbind(t1, t2))
      # }

      # find swap range in the chromosome
      swap.rg <- do.call(rbind, lapply(1:nrow(blk.rg), function(blk) {
        num.swap <- ifelse(recom.spot[blk], sample(range.hot, 1), sample(range.cold, 1))
        spot.swap.raw <- sort(sample((blk.rg[blk, 1]+1):(blk.rg[blk, 2]-1), num.swap, replace = TRUE))
        spot.swap <- c(blk.rg[blk, 1], spot.swap.raw)
        # simplify the recombination process
        flag1.swap <- !(num.swap %% 2 == 0) # if the first block need swapping
        flag.swap <- rep(flag1.swap, (num.swap+1))
        flag.swap[seq(2, (num.swap+1), 2)] <- !flag1.swap
        flag.swap.raw <- flag.swap[-length(flag.swap)]
        swap.op <- spot.swap[flag.swap]
        swap.ed <- spot.swap.raw[flag.swap.raw]
        return(cbind(swap.op, swap.ed))
      }))

      geno.t <- geno[, (2*ind-1):(2*ind)]
      for (swap in 1:nrow(swap.rg)) {
        op <- swap.rg[swap, 1]
        ed <- swap.rg[swap, 2]
        geno.t[op:ed, ] <- geno.t[op:ed, 2:1]
      }

      return(geno.t)
    }# end geno.swap.ind
    outgeno <- do.call(cbind, lapply(1:num.ind, geno.swap))

    # mutation
    spot.total <- num.marker * incols * num.ind
    num.mut <- ceiling(spot.total * rate.mut)
    row.mut <- sample(1:num.marker, num.mut)
    col.mut <- sample(1:(incols*num.ind), num.mut)
    for (i in 1:length(row.mut)) {
      if (geno[row.mut[i], col.mut[i]] == 1) {
        outgeno[row.mut[i], col.mut[i]] <- 0
      } else {
        outgeno[row.mut[i], col.mut[i]] <- 1
      }
    }

  } else if ((!is.null(geno) & incols == 1)|(!is.null(geno) & is.null(recom.spot))) {
    logging.log(" Mutation on genotype matrix...\n", verbose = verbose)
    num.marker <- nrow(geno)
    num.ind <- ncol(geno) / incols
    outgeno <- geno
    # outgeno <- deepcopy(geno)

    # mutation
    spot.total <- num.marker * incols * num.ind
    num.mut <- ceiling(spot.total * rate.mut)
    row.mut <- sample(1:num.marker, num.mut)
    col.mut <- sample(1:(incols*num.ind), num.mut)
    for (i in 1:length(row.mut)) {
      if (geno[row.mut[i], col.mut[i]] == 1) {
        outgeno[row.mut[i], col.mut[i]] <- 0
      } else {
        outgeno[row.mut[i], col.mut[i]] <- 1
      }
    }

  } else {
    stop("Please input the correct genotype matrix!")
  }

  return(outgeno)
}

#' Get map containing block and recombination information
#'
#' Build date: Nov 14, 2018
#' Last update: Jul 30, 2019
#'
#' @author Dong Yin
#'
#' @param input.map map that should be input, the marker number should be consistent in both map file and genotype data
#' @param num.marker number of markers of genotype matrix
#' @param len.block length of every blocks
#'
#' @return a map containing block and recombination information
#' @export
#'
#' @examples
#' data(simdata)
#' nmrk <- nrow(input.map)
#' pos.map <- check.map(input.map = input.map, num.marker = nmrk, len.block = 5e7)
#' str(pos.map)
check.map <- function(input.map = NULL, num.marker = NULL, len.block = 5e7) {
  if (is.null(input.map))
    stop("Please input a map file!")
  if (num.marker != nrow(input.map))
    stop("The number of markers should be equal between genotype file and map file!")
  if (!is.data.frame(input.map))
    input.map <- is.data.frame(input.map)
  chrs <- unique(input.map[, 2])
  pos.mrk <- as.numeric(input.map[, 3])
  nc.map <- ncol(input.map)
  if (nc.map == 7) {
    map <- input.map
  } else {
    temp.recom <- lapply(chrs, function(chr) {
    f <- input.map[, 2] == chr
    if (nc.map == 5) {
      block <- (pos.mrk[f] %/% len.block) + 1
    } else if (nc.map == 6) {
      block <- input.map[f, 6]
    } else {
      stop("Please check the format of map!")
    }
    ub <- unique(block)
    tb <- table(block)
    if (tb[length(tb)] < 0.5*mean(tb[1:(length(tb)-1)])) {
      tb[length(ub)-1] <- tb[length(tb)-1] + tb[length(tb)]
      tb <- tb[-length(tb)]
      block[block == ub[length(ub)]] <- ub[length(ub)-1]
    }
    s1 <- length(tb)
    s2 <- s1 %/% 3
    r1 <- rep(c(1, 0, 1), c(s2, (s1-2*s2), s2))
    recom <- rep(r1, tb)
    t <- cbind(block, recom)
    return(t)
    })
    recom.spot <- do.call(rbind, temp.recom)
    map <- cbind(input.map[, 1:5], recom.spot)
  }

  return(map)
}

#' Generate Marker information
#'
#' Build date: Nov 9, 2020
#' Last update: Nov 9, 2020
#'
#' @author Dong Yin
#'
#' @param num.marker the number of markers
#' @param num.chr the number of chromosomes
#' @param len.chr the length of chromosomes
#'
#' @return marker information
#' @export
#'
#' @examples
#' input.map <- generate.map(num.marker = 50671)
#' str(input.map)
generate.map <- function(num.marker = NULL, num.chr = 18, len.chr = 1.5e8) {

  if(is.null(num.marker))
    stop("Please specify the number of markers!")

  # Number of markers in every chromosome
  num.every <- rep(num.marker %/% num.chr, num.chr)
  num.every[num.chr] <- num.every[num.chr] + num.marker %% num.chr

  SNP <- paste("M", 1:(num.marker), sep = "")
  Chrom <- rep(1:num.chr, num.every)
  BP <- do.call('c', lapply(1:num.chr, function(chr) {
    return(sort(sample(1:len.chr, num.every[chr])))
  }))

  base <- c("A", "T", "C", "G")
  ALT <- sample(base, num.marker, replace = TRUE)
  REF <- sample(base, num.marker, replace = TRUE)
  ff <- ALT == REF
  while (sum(ff) > 0) {
    REF[ff] <- sample(base, sum(ff), replace = TRUE)
    ff <- ALT == REF
  }

  # set map
  map <- data.frame(SNP, Chrom, BP, ALT, REF)
  return(map)
}

#' Calculate for block ranges in map
#'
#' Build date: Aug 15, 2019
#' Last update: Aug 15, 2019
#'
#' @author Dong Yin
#'
#' @param pos.map map with block information and recombination information
#'
#' @return block ranges
#' @export
#'
#' @examples
#' # get map with block and recombination information
#' data(simdata)
#' nmrk <- nrow(input.map)
#' pos.map <- check.map(input.map = input.map, num.marker = nmrk, len.block = 5e7)
#'
#' # calculate for block ranges
#' blk.rg <- cal.blk(pos.map)
#' dim(blk.rg)
#' head(blk.rg)
cal.blk <- function(pos.map) {
  chr.uni <- unique(pos.map[, 2])
  chr.tab <- sapply(1:length(chr.uni), function(chr) { return(sum(pos.map[, 2] == chr.uni[chr])) })
  chr.ed <- sapply(1:length(chr.tab), function(chr) { return(sum(chr.tab[1:chr])) })
  chr.op <- chr.ed - chr.tab + 1
  blk.rg <- do.call(rbind, lapply(1:length(chr.tab), function(chr) {
    blk.tab <- table(as.numeric(pos.map[chr.op[chr]:chr.ed[chr], 6]))
    blk.ed <- sapply(1:length(blk.tab), function(blk) { return(sum(blk.tab[1:blk])) })
    blk.op <- blk.ed - blk.tab + 1
    blk.rg <- cbind(blk.op, blk.ed)
    return(blk.rg + chr.op[chr] - 1)
  }))
  return(blk.rg)
}

#' Input genotype column by column if markers are dense
#'
#' Build date: Nov 14, 2018
#' Last update: Jul 30, 2019
#'
#' @author Dong Yin
#'
#' @param bigmtr total genotype matrix
#' @param mtr genotype matrix should be inputting
#' @param ed index of the last column in each process
#' @param mrk.dense whether markers are dense, it is TRUE when sequencing data
#'
#' @return none
#' @export
#'
#' @examples
#' bigmtr <- bigmemory::big.matrix(nrow = 1e4, ncol = 2e2, type = 'char')
#' bigmtr[1:5, 1:5]
#' options(bigmemory.typecast.warning=FALSE)
#' mtr <- matrix(0, 1e4, 1e2)
#' input.geno(bigmtr = bigmtr, mtr = mtr, ed = ncol(mtr), mrk.dense = FALSE)
#' bigmtr[1:5, 1:5]
input.geno <- function(bigmtr, mtr, ed, mrk.dense) {
  op <- ed + 1 - ncol(mtr)
  if (mrk.dense) {
    for (i in 1:ncol(mtr)) {
      bigmtr[, op+i-1] <- mtr[, i]
    }
  } else {
    bigmtr[, op:ed] <- mtr[]
  }
}

#' Get true position in the genotype matrix
#'
#' Build date: June 11, 2020
#' Last update: June 11, 2020
#'
#' @param index the position of individual in the genotype matrix
#' @param incols the column number of an individual in the input genotype matrix, it can be 1 or 2
#'
#' @return sub-genotype matrix
#' @export
#'
#' @examples
#' index <- c(1:2, 5:6)
#' gmt <- getgmt(index = index, incols = 2)
getgmt <- function(index, incols = 2) {
  if (incols == 2) {
    gmt.dam <- index * 2
    gmt.sir <- gmt.dam - 1
    gmt.comb <- c(gmt.sir, gmt.dam)
    gmt.comb[seq(1, length(gmt.comb), 2)] <- gmt.sir
    gmt.comb[seq(2, length(gmt.comb), 2)] <- gmt.dam
  } else if (incols == 1) {
    gmt.comb <- index
  } else {
    stop("Please input a correct incols!")
  }

  return(gmt.comb)
}


correlation_tab <- read.table("../4correlation/correlation_tab_Species.txt")
correlate_species <- rownames(correlation_tab)[which(correlation_tab$spearman.fdr<0.05)]
correlate_species_pearson <- rownames(correlation_tab)[which(correlation_tab$pearson.fdr<0.05)]

abun_tab <- read.table("../../d5/metaphlan2_unpair_merge_Species_d5.txt",sep="\t",header = T,row.names = 7)

tongue_id <- colnames(abun_tab)[grep("T",colnames(abun_tab))]
juice_id <- colnames(abun_tab)[grep("G",colnames(abun_tab))]

tongue_tab <- abun_tab[,tongue_id]
juice_tab <-  abun_tab[,juice_id]

tongue_tab <- tongue_tab[-which(rowSums(tongue_tab)==0),]
juice_tab <-  juice_tab[-which(rowSums(juice_tab)==0),]

tongue_stat <- as.matrix(table(rowSums(tongue_tab>0)))
juice_stat <- as.matrix(table(rowSums(juice_tab>0)))

data_stat <- merge(data.frame(num=rownames(tongue_stat),tongue=tongue_stat[,1]),data.frame(num=rownames(juice_stat),juice=juice_stat[,1]),by="num",all=T)

write.table(data_stat,file = "insight_exist_num_species_num.txt",row.names = F,sep="\t",quote = F)

library(ggplot2)

temp_tongue <- rowSums(tongue_tab>0)
temp_juice <- rowSums(juice_tab>0)

data <- merge(data.frame(species=names(temp_tongue),tongue_num=temp_tongue),data.frame(species=names(temp_juice),juice_num=temp_juice),by="species",all = T)

write.table(data,file = "insight_species_exist_num.txt",row.names = F,sep = "\t",quote = F)

ggplot(data,aes(tongue_num))+
  geom_bar()+
  scale_x_continuous(breaks=seq(0, 35, 2))+
  theme_bw()+
  labs(x="Frequence in all samples",y="Num of species",title = "Tongue coating")+
  ggsave("insight_species_count_tongue.pdf",width = 6,height = 4)

ggplot(data,aes(juice_num))+
  geom_bar()+
  scale_x_continuous(breaks=seq(0, 35, 2))+
  theme_bw()+
  labs(x="Frequence in all samples",y="Num of species",title = "Gastric fluid")+
  ggsave("insight_species_count_juice.pdf",width = 6,height = 4)

name_spearman <- setdiff(correlate_species,correlate_species_pearson)
name_pearson <- setdiff(correlate_species_pearson,correlate_species)
name_both <- intersect(correlate_species,correlate_species_pearson)

# pearson_t_tab <- abun_tab[name_pearson,tongue_id]
# rownames(pearson_t_tab) <- paste0(rownames(pearson_t_tab),"_t")
# colnames(pearson_t_tab) <- substr(colnames(pearson_t_tab),1,4)
# pearson_g_tab <- abun_tab[name_pearson,tongue_id]
# rownames(pearson_g_tab) <- paste0(rownames(pearson_g_tab),"_g")
# colnames(pearson_g_tab) <- substr(colnames(pearson_g_tab),1,4)
#
# temp1 <- cbind(rownames(pearson_t_tab),pearson_t_tab)
# temp2 <- cbind(rownames(pearson_g_tab),pearson_g_tab)
# pearson_tab <- rbind(cbind(name=rownames(pearson_t_tab),pearson_t_tab),cbind(name=rownames(pearson_g_tab),pearson_g_tab),stringsAsFactors=F)

write.table(abun_tab[name_pearson,tongue_id],file = "insight_pearson_tongue.txt",sep="\t",quote = F)
write.table(abun_tab[name_spearman,tongue_id],file = "insight_spearman_tongue.txt",sep="\t",quote = F)

write.table(abun_tab[name_pearson,juice_id],file = "insight_pearson_juice.txt",sep="\t",quote = F)
write.table(abun_tab[name_spearman,juice_id],file = "insight_spearman_juice.txt",sep="\t",quote = F)

write.table(abun_tab[name_both,tongue_id],file = "insight_both_tongue.txt",sep="\t",quote = F)
write.table(abun_tab[name_both,juice_id],file = "insight_both_juice.txt",sep="\t",quote = F)