## This replication file
## makes the following tables and figures:
# Figure S5
# Tables S8-S10

library(tidyverse)

data <- read.csv("covid.csv")
survey.dates <- c("0304", "0316", "0406", "0410")#, "0416", "0422", "0511", "0601")
#survey.date.col <- c(91, 103, 124, 128, 134, 140, 159, 180) - 51
survey.date.col <- c(91, 103, 124, 128, 134) - 51
t.test.pref <-
  t.test.miss <-
  fisher.test.pref <-
  fisher.test.miss <-
  outcome.out <- list()
table.category <- matrix(NA, 4, 3) #matrix(NA, 7, 3)
test.pref.out <- test.miss.out <- matrix(NA, 4, 2) #matrix(NA, 7, 2)

# Jan. 25 - Aug. 10
period <- 52:250 # indicator
YMD <- as.Date("2020-1-25") + 1:length(period) - 1 # year-month-day
survey.date.col.tab <- c(91, 103, 124, 128) - 51

#for(d in 1:7){
for(d in 1:4){
  if(d < 1){
    rm(data.analysis)
    rm(data.miss)
  }
  source("missing.subroutine.r")
}

# Table S8
table.S8 <- table.category[, c(3,2,1)]
colnames(table.S8) <- c("Analyzed", "Missing", "Outsiude the target")
rownames(table.S8) <- as.character(YMD[survey.date.col.tab])
table.S8
write.csv(table.S8, "output/Fukumoto_TableS8.csv")

#for(d in 1:7){
for(d in 1:4){
  test.pref <- c(t.test.pref[[d]], fisher.test.pref[[d]])
  test.miss <- c(t.test.miss[[d]], fisher.test.miss[[d]])
  test.pref.out[d, 1] <- length(test.pref)
  test.pref.out[d, 2] <- sum(test.pref < 0.05)
  test.miss.out[d, 1] <- length(test.miss)
  test.miss.out[d, 2] <- sum(test.miss < 0.05)
}

# Table S9
test.miss.out <- cbind(test.miss.out[, 1:2],
                       round(test.miss.out[, 2]*100/test.miss.out[,1], 1))
colnames(test.miss.out) <- c("All", "Different", "(%)")
rownames(test.miss.out) <- as.character(YMD[survey.date.col.tab])
test.miss.out
write.csv(test.miss.out, "output/Fukumoto_TableS9.csv")

# Table S10
test.pref.out <- cbind(test.pref.out[, 1:2],
                       round(test.pref.out[, 2]*100/test.pref.out[,1], 1))
colnames(test.pref.out) <- c("All", "Different", "(%)")
rownames(test.pref.out) <- as.character(YMD[survey.date.col.tab])
test.pref.out
write.csv(test.pref.out, "output/Fukumoto_TableS10.csv")

outcome.out.all <- NULL
#for(d in 1:7){
for(d in 1:4){
  outcome.out.all <- rbind(outcome.out.all, outcome.out[[d]])
}
#outcome.out.all <- outcome.out.all[-90, ]

# "The differences are never significantly different from zero " (SI, p. 18).
sum(outcome.out.all[, 6] < 0.05)

survey.date.pos <- survey.date.col - 39
part.adj <- 94:(93 + nrow(outcome.out.all)) - 54
part.adj.rev <- 94:(93 + nrow(outcome.out.all) + 1) - 54
X <- YMD[part.adj]
XX <- YMD[part.adj.rev]

y.max <- max(outcome.out.all[, 3:4])
y.min <- min(outcome.out.all[, 3:4])

# Figure S5
savepdf <- function(file, width=7.28, height=3.54){
  fname <- paste("",file,".pdf",sep="")
  pdf(fname, width=width, height=height,
      pointsize=7)
  par(mgp=c(2.2,0.45,0), tcl=-0.4, mar=c(3.3,3.6,1.1,1.1))
}

savepdf("output/Fukumoto_FigS5")
par(mfcol=c(1,2))
# left panel
plot(X, outcome.out.all[, 1], type = "l", ylim = c(0, y.max - y.min),
     xaxt="n",
     xlab="Day", ylab="Outcome", main="a Average outcome")
axis(1, at = c(XX[1], XX[29], XX[59], XX[90]),
     labels = format(c(XX[1], XX[29], XX[59], XX[90]), "%b %d"))
lines(X, outcome.out.all[, 2], col = 2)
abline(0, 0, lty = 2)
for(d in 1:8){
  abline(v = XX[survey.date.pos[d]], col="Turquoise")
}
# right panel
plot(X, outcome.out.all[, 5], type = "n", ylim = c(y.min, y.max),
     xlab="Day", ylab="Difference in outcomes", main="b Difference in outcomes")
polygon(c(X, rev(X)),
        c(outcome.out.all[, 3], rev(outcome.out.all[, 4])),
        col = "gray90", border = "gray90")
lines(X, outcome.out.all[, 5], type = "l", ylim = c(y.min, y.max), lwd = 2)
abline(0, 0, lty = 2)
for(d in 1:8){
  abline(v = XX[survey.date.pos[d]], col="Turquoise")
}
dev.off()

rownames(outcome.out.all) <- as.character(X)
colnames(outcome.out.all) <- c("outcome average in analyzed municipalities",
                               "outcome average in missing municipalities",
                               "lower bound of 95% confidence interval",
                               "upper bound of 95% confidence interval",
                               "difference in the two outcome averages",
                               "p-value")
head(outcome.out.all)
write.csv(outcome.out.all, "output/Fukumoto_FigS5_source.csv")


theme_set(theme_bw(18))

setwd("~/cogsci/projects/stanford/projects/overinformativeness/models/7_qualitative_nom_S1_typ/")
source("rscripts/helpers.R")

# alpha = 7, t_super = .8
d = read.table(file="speakerOutput-alpha7.csv",sep=",", header=F, quote="")
colnames(d) = c("t_sub","d_sub","t_basic","d_basic","t_super","d_super","Utterance","Probability")

agr = d %>%
  filter(t_sub %in% c(0,.5,1) & t_basic %in% c(0,.5,1) & d_sub %in% c(0,.5,1) & d_basic %in% c(0,.5,1)) %>%
  select(t_sub,d_sub,t_basic,d_basic,Utterance,Probability)
agr = as.data.frame(agr)
# agr$YMin = agr$Probability - agr$ci.low
# agr$YMax = agr$Probability + agr$ci.high
head(agr)
agr$Utt = factor(x=as.character(agr$Utterance),levels=c("sub","basic","super"))

ggplot(agr[agr$d_basic == 0,], aes(x=t_sub,y=Probability,color=d_sub,group=d_sub)) +
  geom_point() +
  geom_line(size=2) +
  xlab("Target sub typicality") +
  scale_colour_continuous(name="Distractor\nsub typicality") +
  facet_grid(t_basic~Utt) +
  ggtitle("Rows: t basic typicality (d basic typicality = 0)")
ggsave("S1probs_dtyp0.png",width=8,height=6)

ggplot(agr[agr$d_basic == 0.5,], aes(x=t_sub,y=Probability,color=d_sub,group=d_sub)) +
  geom_point() +
  geom_line(size=2) +
  xlab("Target sub typicality") +
  scale_colour_continuous(name="Distractor\nsub typicality") +
  facet_grid(t_basic~Utt) +
  ggtitle("Rows: t basic typicality (d basic typicality = .5)")
ggsave("S1probs_dtyp.5.png",width=8,height=6)

ggplot(agr[agr$d_basic == 1,], aes(x=t_sub,y=Probability,color=d_sub,group=d_sub)) +
  geom_point() +
  geom_line(size=2) +
  xlab("Target sub typicality") +
  scale_colour_continuous(name="Distractor\nsub typicality") +
  facet_grid(t_basic~Utt) +
  ggtitle("Rows: t basic typicality (d basic typicality = 1)")
ggsave("S1probs_dtyp1.png",width=8,height=6)

agr = d
agr$Utt = factor(x=as.character(agr$Utterance),levels=c("sub","basic","super"))
agr$TTypicalityGain = agr$t_sub - agr$t_basic
agr$DTypicalityGain = agr$d_sub - agr$d_basic

# ggplot(agr, aes(x=TTypicalityGain,y=DTypicalityGain,color=Probability)) +
#   geom_point(size=4,shape=15) +
#   scale_colour_gradient(low="red") +
#   geom_vline(xintercept=0,color="gray80") +
#   geom_hline(yintercept=0,color="gray80") +
#   xlab("Target typicality gain") +
#   ylab("Distractor typicality gain") +
#   facet_wrap(~Utt)
# ggsave("S1probs_typgainmap.png",width=10,height=3.5)
# ggsave("S1probs_typgainmap_alpha7.png",width=10,height=3.5)

# simulate conditions
agr$SimCondition = as.factor(ifelse(agr$d_sub == 0 & agr$d_basic == .8 & agr$d_super == .8,"sub necessary",ifelse(agr$d_sub == 0 & agr$d_basic == .1 & agr$d_super == .8, "basic sufficient", ifelse(agr$d_sub == 0 & agr$d_basic == 0 & agr$d_super == 0,"super sufficient","other"))))
table(agr$SimCondition)
agr = droplevels(agr[agr$SimCondition != "other",])
agr$Condition = factor(x=as.character(agr$SimCondition),levels=c("sub necessary","basic sufficient","super sufficient"))

ggplot(agr, aes(x=t_sub,y=TTypicalityGain,color=Probability)) +
  geom_point(size=8,shape=15) +
  scale_colour_gradientn(colors=rev(rainbow(4,start=0,end=4/6)),name="Probability\nof utterance") +
  xlab("Target sub typicality") +
  ylab("Target typicality gain") +
  facet_grid(Condition~Utt)
ggsave("S1probs_typgainmap_alpha7.png",width=10.5,height=8)


################################################
#############ICD10 Codes########################
setwd("P:/2019 0970 151 000/User Data/Faraz")
library(tidyverse)
#data loading and preprocessing
df <- read.csv("NACRASCIHI.csv")
tabna <- function(x){table(x, useNA = "ifany")}
##
df$alc_status <- as.factor(df$alc_status)
##

code_vars <- names(df)[89:118]
str(df[code_vars])

## NA AND Null analysis
sapply(code_vars, function(x){
df[x] %>% is.na() %>% sum() %>% length()
})
# Mostly Null
sapply(code_vars, function(x){
df[df[x] == "",x]  %>% length() / nrow(df) * 100 %>% round(digits=2)
})

icd <- df["dx10code1"]
icd$alc <- as.numeric(df$alc_status) - 1
icd$c1 <- substr(icd$dx10code1, 1,1)

icd1 <- icd %>% group_by(c1) %>% summarise(n = n(),
 perc = round(n/nrow(df) * 100,digits=1), alc_perc_grp = round(mean(alc) * 100, digits=1) )

icd1 %>% arrange(desc(n)) %>% print(n=40)

##Category R is mostly symptoms---no particular summary
icd$complaint <- df$complaint1
icd %>% group_by(c1) %>% summarise( n= n(),
perc = round(n/nrow(df) * 100,digits=2),
alc_perc_grp = mean(alc) * 100,
no_complaint = sum(is.na(complaint)))%>%
mutate(no_complaint_perc_of_NA = round(no_complaint/ sum(no_complaint) * 100, digits=2)) %>%
arrange(desc(n)) %>% print(n=25)

#############Create binary variables#####

##one letter code with descending freq order
code_1 <- icd1 %>% arrange(desc(n))  %>% .$c1

for(code in code_1[1:16]){
	icd[,code] <- factor(ifelse(icd$c1 == code, 1, 0))
}
##merging the least 5 togethers
icd$Oth <- factor(ifelse(icd$c1 %in% code_1[17:21], 1, 0))

############ Logistic Regression on binary vars

icd$alc <- factor(icd$alc)
vars <- names(icd)[5:21]
lapply(vars, function(var){
	formula <- as.formula(paste("alc ~ ", var))
	glm.var <- glm(data = icd, formula, family = 'binomial')
	summary(glm.var)
})

##all significant
###
add_result <- function(var, or_ls){
	formula <- as.formula(paste("alc ~ ", var))
	glm.var <- glm(data = icd, formula, family = 'binomial')
	output <- summary(glm.var)
	z<-output$coefficients[,1]/output$coefficients[,2]
	pv<-(1-pnorm(abs(z),0,1))*2
	CI_lower<-exp(output$coefficients[,1]-1.96*output$coefficients[,2])
	CI_upper<-exp(output$coefficients[,1]+1.96*output$coefficients[,2])
	#profiling method for finding confidence interval is more accurate but too slow
	#or_ls <- rbind(or_ls, cbind(OR = exp(coef(glm.var)), confint(glm.var), pv))
	or_ls <- rbind(or_ls, cbind(OR = exp(coef(glm.var)), CI_lower, CI_upper, pv))
	return(or_ls)
}

result <- double()
for (x in vars){
	result <- add_result(x, result)
}
write.csv(result, "../Faraz-Export IDAVE folders/icd10_1L_univar_results.csv")

############# S,F and Z had biggest odds ratios

###Exploring more#######
icd$c3 <- substr(icd$dx10code1, 1,3)
#if categorized by 3 letters, have total groups of 1151
unique(icd$c3) %>% length()
icd$alc <- factor(icd$alc)

icd$alc_n <- as.numeric(icd$alc) - 1
icd %>% group_by(c3) %>% summarise( n= n(),
perc = round(n/nrow(df) * 100,digits=2),
alc_perc_grp = mean(alc_n) * 100) %>%
arrange(n) %>% print(n=1000)

#About 1000 of them have population less than 1000 which is too little

icd %>% group_by(c3) %>% summarise( n= n(),
perc = round(n/nrow(df) * 100,digits=2),
alc_perc_grp = mean(alc_n) * 100) %>%
arrange(desc(alc_perc_grp)) %>% print(n=25)

# have to filer by size

icd3_top <- icd %>% group_by(c3) %>% summarise( n= n(),
perc = round(n/nrow(df) * 100,digits=2),
alc_perc_grp = mean(alc_n) * 100) %>%
arrange(desc(alc_perc_grp)) %>% filter(n > 1000) %>% print(n=200)

icd3_top$alc_perc_grp %>% mean() #12%

code_3 <- icd3_top %>% filter(alc_perc_grp > mean(alc_perc_grp)) %>% .$c3

##apply logistic regression only on the above average codes (about 50 are here)

for(code in code_3){
	icd[,code] <- factor(ifelse(icd$c3 == code, "Y", "N"))
}

result_3 <- double()
for (x in code_3){
	result_3 <- add_result(x, result_3)
}

write.csv(result_3, "../Faraz-Export IDAVE folders/icd10_3L_univar_results.csv")

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

#Diabetes# CODE starts with E
# have to filer by size

icd3_top <- icd %>% group_by(c3) %>% summarise( n= n(),
perc = round(n/nrow(df) * 100,digits=2),
alc_perc_grp = mean(alc_n) * 100) %>%
arrange(desc(n)) %>% filter(str_detect(c3, "E")) %>% print(n=200)

# E11 being related to diabetes, had less alc_perc_grp than the mean,
# Therefore shouldn't have a high odds ratio!

##################Charlson Index


# By Yea-Hung Chen

# clear work space
rm(list=ls())

# set random seed
set.seed(2018)

# define time point of interest for survival analysis
TIME<-3

# load libraries
library(survival)
if_else<-dplyr::if_else

# load functions
source('impute dates.r')
source('define survival variables.r')
source('community-level estimates.r')
source('Preprocess_Functions.R')
source('Stage2_Functions.R')
source('Adapt_Functions.R')
source('s2.r')

# sec3pri: load data
load('prepared data.RData')

# sec3pri: define risk period
ii$start<-as.Date('1900-01-01')
is.na(ii$start)<-TRUE
ii$start<-if_else(ii$age_0<15,
                  ii$chc_start_0+(15-ii$age_0)*365.25,
                  ii$start)
is.na(ii$start)<-(ii$start<ii$chc_start_0)
is.na(ii$start)<-(ii$trk_end_3<ii$start)
ii$start<-pmax(ii$start,ii$chc_start_0,na.rm=TRUE)
ii$end<-ii$trk_end_3

# sec3pri: impute missing dates
ii<-impute_dates(c('di.end','do.end','om.end'))

# sec3pri: define survival variables
ovar<-c('di')
cvar<-c('do','om')
ii<-define_survival_variables(ii)

# sec3pri: define population
ii<-subset(ii,!data_flag)
ii<-subset(ii,!(dead_0|move_0))
ii<-subset(ii,!is.na(dead_3))
ii<-subset(ii,resident_0)
ii<-subset(ii,stable_0)

# sec3pri: define adjustment variables
ii$hiv<-ifelse(ii$hiv_0,1,0)
ii$wealth<-ifelse(ii$wealth_0=='0',1,0)

# sec3pri: initiate community-level data frame
cc<-c('com','community_name','pair','intervention')
cc<-unique(ii[,cc])
cc<-cc[order(cc$com),]
row.names(cc)<-NULL

# sec3pri: outcome variables
cc<-oo('sec3pri',method='rate')

# sec3pri: add adjustment variables to community-level data frame
aa('hiv')
aa('wealth')

# sec3pri: pre-process data
cc<-preprocess(cc,YHC=TRUE)

# sec3pri: stage-ii analysis
s2('sec3pri',CLUST.ADJ=c('U','hiv','wealth'),SURVIVAL=FALSE)

# sec1pri: load data
load('prepared data.RData')

# sec1pri: define risk period
ii$start<-ii$chc_start_0
ii$end<-ii$trk_end_3

# sec1pri: impute missing dates
ii<-impute_dates(c('di.end','do.end','om.end'))

# sec1pri: define survival variables
ovar<-c('di')
cvar<-c('do','om')
ii<-define_survival_variables(ii)

# sec1pri: define population
ii<-subset(ii,!data_flag)
ii<-subset(ii,!(dead_0|move_0))
ii<-subset(ii,!is.na(dead_3))
ii<-subset(ii,adult_0)
ii<-subset(ii,resident_0)
ii<-subset(ii,hiv_0)
ii<-subset(ii,stable_0)

# sec1pri: define adjustment variables
ii$cd4.350<-with(ii,ifelse(cd4_0<=350,1,0))
ii$cd4.50<-with(ii,ifelse(cd4_0<=50,1,0))
ii$vl.500<-ifelse(ii$supp_0,1,0)

# sec1pri: initiate community-level data frame
cc<-c('com','community_name','pair','intervention')
cc<-unique(ii[,cc])
cc<-cc[order(cc$com),]
row.names(cc)<-NULL

# sec1pri: outcome variables
cc<-oo('sec1pri',method='survival')

# sec1pri: add adjustment variables to community-level data frame
aa('cd4.350')
aa('cd4.50')
aa('vl.500')

# sec1pri: pre-process data
cc<-preprocess(cc,YHC=TRUE)

# sec1pri: stage-ii analysis
s2('sec1pri',CLUST.ADJ=c('U','cd4.350','cd4.50','vl.500'),SURVIVAL=TRUE)

# output estimates
tt<-rbind(sec3pri,sec1pri)
write.csv(tt,'mortality intervention effects.csv',row.names=FALSE)


#install.packages("nnls")
#install.packages("ggplot2")
#install.packages("jsonlite")

library(nnls)
library(ggplot2)
suppressMessages(library(jsonlite))

# Getting command arguments
args <- commandArgs(trailingOnly = TRUE)

context <- args[1]
signatures <- args[2]
outdir <- args[3]

context
signatures
outdir

# Getting absolute counts for each SNV trinucleotide context
#dataTable <- read.table(args[1], sep = "\t", header = TRUE)
dataTable <- read.table(context, sep = "\t", header = TRUE)
dataTable <- as.vector(dataTable$Count)

# Normalising frequencies to values between 0 and 1 like the signature table is
dataTable <- dataTable / sum(dataTable)

# Getting signature probabilities reference table
#signatureTable <- read.table(args[2], sep = "\t", header = TRUE)
signatureTable <- read.table(signatures, sep = "\t", header = TRUE)
signatureTable <- as.matrix(signatureTable[1:96,4:33])

# Applying non-negative least squares (NNLS)
coefficients <- nnls(signatureTable, dataTable)

#################################
# Calculating confidence values #
#################################

# Getting the original RSS value
RSSOriginal <- coefficients$deviance

# Optimising the RSS score by iteratively removing signatures with coefficients
# less than 0.06 and refitting the model.
# Optimisation is limitted to 10 iterations to avoid large computaional time
# and because model improvement will not be significant after 2-3 iterations
coefficientsCopy <- coefficients  # Copy of the nnls object
signatureTableCopy <- signatureTable  # Copy of COSMIC signature table
counter <- 0  # Iteration counter
toRemove <- which(coefficientsCopy$x < 0.06 & coefficientsCopy$x > 0 )

# Optimisation
while(length(toRemove) > 0 && counter < 10) {
  toRemove <- which(coefficientsCopy$x < 0.06 & coefficientsCopy$x > 0 )
  # Removing
  for (i in 1:length(toRemove)) {
    signatureTableCopy[, toRemove[i]] <- 0
  }
  # Recalculating coefficients
  coefficientsCopy <- nnls(signatureTableCopy, dataTable)
  counter <- counter + 1
  toRemove <- which(coefficientsCopy$x < 0.06 & coefficientsCopy$x > 0 )
}

# Explained Sum of Squares
#ESS <- sum((coefficientsCopy$fitted - apply(dataTable, 1, mean)) ^ 2)

# Residual Sum of Squares
RSS <- sum(coefficientsCopy$residuals^2)

# Total Sum of Squares
#TSS <- ESS + RSS

# Value to be reported: RSS
RSS <- round(RSS, digits = 4)

#####################
# Writing JSON file #
#####################

# Normalising coefficients to values between 0 and 100
coefficients <- coefficients$x / sum(coefficients$x) * 100

# Creating signature names
tags <- paste("Signature", 1:30, sep = " ")

# Writing coefficients and RSS to JSON file
dfCoeff <- as.data.frame(t(data.frame(coefficients)))
colnames(dfCoeff) <- sapply(sub(' ', '', tags), tolower)
rownames(dfCoeff) <- NULL
df <- NULL
df$coefficients <- dfCoeff
df$rss <- RSS
j <- gsub("\\[|\\]", "", toJSON(df))
write(j, paste0(outdir, "/signature_coefficients.json"))

############
# Plotting #
############

# Ordering coefficients by value
orderedIndex <- order(coefficients, decreasing = TRUE)
orderedCoefficients <- coefficients[orderedIndex]
orderedTags <- tags[orderedIndex]

# Filtering out coefficients below 5
coeffs2 <- orderedCoefficients[orderedCoefficients > 5]
tags2 <- orderedTags[orderedCoefficients > 5]

# Setting up boxes y-limits
cumulativeSum <- cumsum(c(0, coeffs2, 100 - sum(coeffs2)))
starts <- cumulativeSum[1:length(cumulativeSum) - 1]
ends <- cumulativeSum[2:length(cumulativeSum)]

# Setting up boxes colours
colours <- c("darkblue", "darkgreen", "gold2", "darkorange", "darkred", "purple4", "blue1", "chartreuse3", "darkgoldenrod1", "chocolate1", "firebrick1", "darkorchid3")

# Setting up ticks and ticks labels
tickPos <- 0:5 * 20
tickNames <- paste0(tickPos, "%")

# Setting up legend positions
numLegends <- 1:(length(coeffs2) + 1)
legendPos <- ((numLegends - (mean(numLegends))) * 7) + 50

# PLOTTING
png(paste0(outdir, "/signature_summary.png"), width = 1028, height = 800, type='cairo')
ggplot() +
  # Boxes
  geom_rect(mapping=aes(xmin = 0, xmax = 1, ymin = starts, ymax = ends - 0.3),
            fill = c(colours[1:length(starts) - 1], "white"),
            color = "black", alpha = 0.7) +
  # Plot width
  xlim(-1, 2) +
  # Y-axis line
  geom_segment(mapping = aes(x = -0.1, xend = -0.1, y = 0, yend = 100)) +
  # Y-axis ticks
  geom_segment(mapping = aes(x = -0.1, xend = -0.15,
                             y = tickPos, yend = tickPos)) +
  # Y-axis labels
  geom_text(mapping = aes(x = -0.3, y = tickPos), label = tickNames) +
  # Y-axis title
  geom_text(mapping = aes(x = -0.5, y = 50), label = "Signature contribution",
            angle = 90) +
  # Legend boxes
  geom_rect(mapping = aes(xmin = 1.2, xmax = 1.25,
                          ymin = (legendPos - 1), ymax = (legendPos + 1)),
            color = "black",
            fill = c(colours[1:length(legendPos) - 1], "white"),
            alpha = 0.7) +
  # Legend text
  geom_text(mapping = aes(x = 1.28, y = legendPos), label = c(tags2, "Other"),
            hjust = 0) +
  # Removing every other ggplot element from the plot
  theme(axis.text.x = element_blank(),
        axis.ticks.y = element_blank(),
        axis.ticks.x = element_blank(),
        axis.title.x = element_blank(),
        axis.title.y = element_blank(),
        axis.text.y = element_blank(),
        panel.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        plot.background = element_blank())

garbage <- dev.off()


# load libraries
# library("BiocParallel")
library("DESeq2")
library("RColorBrewer")
library("ggplot2")

# directories for results and figures
dn.out = file.path(PROJECT_DIR, "generated_data/RNAseq")
dir.create(dn.out, showWarnings = F, recursive = T)
dn.fig = file.path(PROJECT_DIR, "figure_generation/RNAseq")
dir.create(dn.fig, showWarnings = F, recursive = T)

## reading data from STAR counts output
counts = read.table(file = file.path(PROJECT_DIR, "data/RNAseq/counts.tab"),header = FALSE, row.names=1,sep =" ")
counts_run2 = read.table(file = file.path(PROJECT_DIR, "data/RNAseq/counts_run2.tab"),header = FALSE, row.names=1,sep =" ")
stopifnot(identical(rownames(counts), rownames(counts_run2)) & ncol(counts)==ncol(counts_run2))

countData = counts[5:22431,] + counts_run2[5:22431,]
countData = data.matrix(countData)

colData = read.csv(file = file.path(PROJECT_DIR, "data/RNAseq/colData.csv"), header = TRUE)
colnames(countData) = paste(colData$Donor, colData$Subset, sep=".")

# colSums(counts[5:22431,])
# colSums(counts_run2[5:22431,])
# colSums(countData)

# colSums(counts)
# colSums(countData)/10^6
# counts[1,]/colSums(counts) #percent unmapped
# counts[3,]/colSums(counts) #percent with no feature
# colSums(counts + counts_run2)/10^6

# removing a samples because of very low read counts due to low RNA/bad libraries
countData = countData[,-4]
colData = colData[-4,]

#Create DEseq object and run DEseq2

dds <- DESeqDataSetFromMatrix(countData = countData, colData = colData, design = ~ Donor + Subset)
dds = DESeq(dds)
vst = varianceStabilizingTransformation(dds)
# plotPCA(vst, intgroup = "Subset")
# plotPCA(vst, intgroup = "Donor")
# resultsNames(dds)

resCD19pCD20pvsCD19pCD20pCD38p=results(dds, contrast = c("Subset","CD19pCD20pCD38p","CD19pCD20p"))
summary(resCD19pCD20pvsCD19pCD20pCD38p)

write.csv(file = file.path(dn.out, "resCD19pCD20pvsCD19pCD20pCD38p.csv"), resCD19pCD20pvsCD19pCD20pCD38p, quote = FALSE)

vstData = assay(vst)
write.csv(file = file.path(dn.out, "VarianceStabilizedTransformCounts_CD38subsets.csv"), vstData)

CD38correlatedGenes = toupper(fread(file.path(PROJECT_DIR, "generated_data/signatures/CD38_ge_sig.txt"), header=F)[[1]])
CD38correlatedGenes = CD38correlatedGenes[CD38correlatedGenes %in% rownames(resCD19pCD20pvsCD19pCD20pCD38p)]

CD38correlatedGenes_resCD19pCD20pvsCD19pCD20pCD38p = as.data.frame(resCD19pCD20pvsCD19pCD20pCD38p[which(rownames(resCD19pCD20pvsCD19pCD20pCD38p) %in% CD38correlatedGenes),])
write.csv(file = file.path(dn.out, "CD38correlatedGenes_resCD19pCD20pvsCD19pCD20pCD38p.csv"), CD38correlatedGenes_resCD19pCD20pvsCD19pCD20pCD38p, quote = FALSE)

resCD19pCD20pvsCD19pCD20pCD38p_df = as.data.frame(resCD19pCD20pvsCD19pCD20pCD38p)
resCD19pCD20pvsCD19pCD20pCD38p_df_CD38correlatedGenes = resCD19pCD20pvsCD19pCD20pCD38p_df[CD38correlatedGenes,] %>%
  tibble::rownames_to_column("gene")
resCD19pCD20pvsCD19pCD20pCD38p_df_sig = resCD19pCD20pvsCD19pCD20pCD38p_df[which(resCD19pCD20pvsCD19pCD20pCD38p_df$padj <= 0.01 & log(resCD19pCD20pvsCD19pCD20pCD38p$baseMean) > 1),]

sig_GOcellactivation = c("KLF6","MZB1","ADAM9","ACTB","XBP1","ACTG1","BCL2","IGLL5","LILRB1","CD84","SLAMF6","ADRB2","CD9","FCGR2A","CD38","CD44","TNFRSF13B","UBASH3B","LEF1","BANK1","CDK6")
resCD19pCD20pvsCD19pCD20pCD38p_df_sig_GOcellactivation = resCD19pCD20pvsCD19pCD20pCD38p_df[sig_GOcellactivation,] %>%
  tibble::rownames_to_column("gene")

ggplot(data=resCD19pCD20pvsCD19pCD20pCD38p_df[which(log(resCD19pCD20pvsCD19pCD20pCD38p_df$baseMean) > 1),], aes(x=log2FoldChange, y=-log10(padj))) +
  geom_point(color = "red", alpha=0.4, size=1.75) +
  geom_point(data=resCD19pCD20pvsCD19pCD20pCD38p_df_CD38correlatedGenes, aes(x=log2FoldChange, y=-log10(padj)), size=2,colour="black") +
  geom_text(data=resCD19pCD20pvsCD19pCD20pCD38p_df_CD38correlatedGenes, aes(x=log2FoldChange, y=-log10(padj), label=gene, size=1.2),colour="black",hjust=0,vjust=1) +
  xlim(c(-7, 7)) +
  ylim(c(0, 9.5)) +
  xlab("log2 fold change") +
  ylab("-log10 FDR") +
  scale_colour_brewer(palette="Set1") +
  theme_bw() +
  theme(legend.position = "none")
fn.fig = file.path(dn.fig, "RNAseq_volcano")
ggsave(paste0(fn.fig, ".png"), w=6, h=5)

ggplot(data=resCD19pCD20pvsCD19pCD20pCD38p_df, aes(x=log(baseMean), y=log2FoldChange)) +
  geom_point(shape = 20, col="black", alpha=0.4, size=1.75) +
  ylim(c(-10,10)) +
  xlab("log(baseMean)") +
  ylab("log2 Fold Change") +
  geom_point(data=resCD19pCD20pvsCD19pCD20pCD38p_df_CD38correlatedGenes, aes(x=log(baseMean), y=log2FoldChange), size=2,colour="red") +
  geom_text(data=resCD19pCD20pvsCD19pCD20pCD38p_df_CD38correlatedGenes, aes(x=log(baseMean), y=log2FoldChange, label=gene, size=1.2),colour="red",hjust=0,vjust=1) +
  geom_point(data=resCD19pCD20pvsCD19pCD20pCD38p_df_sig_GOcellactivation, aes(x=log(baseMean), y=log2FoldChange), size=2,colour="deepskyblue") +
  geom_text(data=resCD19pCD20pvsCD19pCD20pCD38p_df_sig_GOcellactivation, aes(x=log(baseMean), y=log2FoldChange, label=gene, size=1.2),colour="deepskyblue",hjust=0,vjust=1) +
  theme_bw() +
  theme(legend.position = "none")
fn.fig = file.path(dn.fig, "RNAseq_MAplot")
ggsave(paste0(fn.fig, ".png"), w=6, h=6)
ggsave(paste0(fn.fig, ".pdf"), w=6, h=6)


# translate runDREAMZS_hmixbatch.m into R
# Simon Woodward, DairyNZ 2017-2018
# now allows keeping previous results or starting from scratch
# save runlist including diagnostics
# bach_driver11.r + bach_script11.stan:
# - apply priors to parameters (requires intial values to chains)
# - unique name for log file
# - increase weighting of llflow
# - reorganise parameter trace plots

# remove all variables
rm(list=ls())
# dev.off() # close figures if they exist

suppressMessages({
  library(rstan)
  library(tidyverse)
  library(cowplot)
  library(parallel)
  library(installr)
  library(truncnorm)
  library(ggthemes)
})

# functions
"%notin%" <- function(x,y)!("%in%"(x,y))

# which run directory?
out_path <- 'run - new_trend3/'
print(out_path)

# kill any processes that didn't terminate
kill_all_Rscript_s()

# open log_file
log_file_name <- paste(out_path, 'log', format(Sys.time(), "_%Y%m%d_%H%M"), '.txt', sep='')
log_file <- file(log_file_name, open='w') # delete duplicate log file if necessary
close(log_file)
log_file <- file(log_file_name, open='a') # open file for logging

# model and parameters
stan_model <- paste(out_path, 'bach_script15.stan', sep='')
stan_pars_raw <- c('medb0raw', 'medd1raw', 'slowb0raw', 'slowd1raw',
                   'chem1fastraw0', 'chem1medraw0', 'chem1slowraw0',
                   'chem2fastraw0', 'chem2medraw0', 'chem2slowraw0',
                   'chem1fastraw1', 'chem1medraw1', 'chem1slowraw1',
                   'chem2fastraw1', 'chem2medraw1', 'chem2slowraw1',
                   'chem1fastrawb1', 'chem1medrawb1', 'chem1slowrawb1',
                   'chem2fastrawb1', 'chem2medrawb1', 'chem2slowrawb1',
                   'chem1fastrawb2', 'chem1medrawb2', 'chem1slowrawb2',
                   'chem2fastrawb2', 'chem2medrawb2', 'chem2slowrawb2')
stan_pars_scale <- c(1, ((-0.1*log(1-0.99)) - (-0.1*log(1-0.1))) * 10, # NOTE -ln(1-a) needs special scaling
                     1, ((-0.1*log(1-0.9999)) - (-0.1*log(1-0.99))) * 10, # NOTE -ln(1-a) needs special scaling
                     2, 2, 2, 12, 12, 12,
                     2, 2, 2, 12, 12, 12,
                     2, 2, 2, 12, 12, 12,
                     2, 2, 2, 12, 12, 12)
stan_pars_label <- c('b0,m/(1-a1,m)', '-ln(1-a1,m)', 'b0,s/(1-a1,s)', '-ln(1-a1,s)',
                     'e0,fTP', 'e0,mTP', 'e0,sTP',
                     'e0,fTN', 'e0,mTN', 'e0,sTN',
                     'e1,fTP', 'e1,mTP', 'e1,sTP',
                     'e1,fTN', 'e1,mTN', 'e1,sTN',
                     'f1,fTP', 'f1,mTP', 'f1,sTP',
                     'f1,fTN', 'f1,mTN', 'f1,sTN',
                     'f2,fTP', 'f2,mTP', 'f2,sTP',
                     'f2,fTN', 'f2,mTN', 'f2,sTN')
stan_pars <- c('medb0', 'meda1', 'slowb0', 'slowa1',
               'medBFImax', 'medrec', 'slowBFImax', 'slowrec',
               'chem1fast0', 'chem1med0', 'chem1slow0',
               'chem2fast0', 'chem2med0', 'chem2slow0',
               'chem1fast1', 'chem1med1', 'chem1slow1',
               'chem2fast1', 'chem2med1', 'chem2slow1',
               'chem1fastb1', 'chem1medb1', 'chem1slowb1',
               'chem2fastb1', 'chem2medb1', 'chem2slowb1',
               'chem1fastb2', 'chem1medb2', 'chem1slowb2',
               'chem2fastb2', 'chem2medb2', 'chem2slowb2',
               'llchem1', 'llchem2')

# priors
priorwide <- 0.3
priornarrow <- 0.1
priortab <- tibble(
  parname = stan_pars_raw,
  parscale = stan_pars_scale,
  parlabel = stan_pars_label,
  parmin  = c(rep(0, 4), rep(0, 12), rep(-1, 12)),
  parmax  = 1,
  parmean = c(1.0, 0.4, 1.0, 0.7,
              0.2/2.0, 0.1/2.0, 0.1/2.0, 2.0/12.0, 3.0/12.0, 1.0/12.0,
              0.2/2.0, 0.1/2.0, 0.1/2.0, 2.0/12.0, 3.0/12.0, 1.0/12.0,
              0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
              0.0, 0.0, 0.0, 0.0, 0.0, 0.0),
  parsd   = c(priornarrow, priorwide, priornarrow, priorwide,
              rep(priorwide, 6), rep(priorwide, 6),
              rep(priornarrow, 6), rep(priornarrow, 6))
)

if (FALSE){
  medd1raw <- c(0, 0.4, 1)
  ((-0.1*log(1-0.99)) - (-0.1*log(1-0.1))) * priorwide * 10
  medd1scale = (-0.1*log(1-0.1)) + ((-0.1*log(1-0.99)) - (-0.1*log(1-0.1))) * medd1raw
  abs(medd1scale)*10
  meda1 = (1-exp(-abs(medd1scale)*10))

  slowd1raw <- c(0, 0.7, 1)
  ((-0.1*log(1-0.9999)) - (-0.1*log(1-0.99))) * priorwide * 10
  slowd1scale = (-0.1*log(1-0.99)) + ((-0.1*log(1-0.9999)) - (-0.1*log(1-0.99))) * slowd1raw
  abs(slowd1scale)*10
  slowa1 = (1-exp(-fabs(slowd1scale)*10))
}

# record version information
cat(R.version.string, file=log_file, sep='\n')
cat(paste('Stan version', stan_version()), file=log_file, sep='\n')

# init rstan
rstan_options(auto_write = TRUE)
options(mc.cores = detectCores())

# read data files
source('read_data9.r')
cat(paste(nrow(runlist),'lines in runlist.dat'), file=log_file, sep='\n')

# prepare output files
nruns <- nrow(runlist)
from_scratch <- all(runlist$control %notin% "keep")
source('prep_output9.r')

# loop through runlist
rows <- 1:nruns # to run all sites
# rows <- c(12) # to run a subset of sites, useful for testing
i <- rows[[1]] # set i useful for line by line testing
for (i in rows) {

  # seed
  set.seed(i)

  # write header
  data_file_name <- paste(runlist$catchfile[i], '_data.dat', sep='')
  opt_file_name <- runlist$optfile[i]
  header <- paste(i, data_file_name, opt_file_name, format(Sys.time(), "%a %d %b %H:%M:%S %Y"))
  print(header)
  cat(header, file=log_file, sep='\n')

  # get mode
  mode <- runlist[i, 'control']
  if (mode=='zero') {

    # report
    cat(paste('max(Rhat)  = zero'), file=log_file, sep='\n')
    cat(paste('elapsed(h) = 0'), file=log_file, sep='\n')

    # insert into output files
    irows <- (i*7-6):(i*7)
    bestxs[i, ] <- 0
    quartxs[irows, ] <- 0
    sbestxs[i, ] <- 0
    squartxs[irows, ] <- 0

  } else if (mode=='calib') {

    # assemble run options/data into vectors (?)
    arun <- runlist[i, ]
    adata <- data[grep(pattern=data_file_name, x=data$file), ]
    aarea <- tibble(area=adata$area[1])
    aoptions <- options[opt_file_name, ]
    aalloptions <- cbind(arun, aoptions, aarea) # combine into one data table
    startcalib <- aalloptions$startcalib
    endcalib <- aalloptions$endcalib
    catchname <- aalloptions$catchname
    setname <- aalloptions$setname
    keeps <- c('startrun', 'startcalib', 'endcalib', 'startvalid', 'endvalid')
    intoptions <- as.vector(t(aalloptions[keeps]))
    nintoptions <- length(intoptions)
    keeps <- c('chem1ae', 'chem1re', 'chem2ae', 'chem2re', 'area')
    realoptions <- as.vector(t(aalloptions[keeps]))
    nrealoptions <- length(realoptions)
    date <- as.vector(adata$date)
    ndate <- length(date)
    flow <- as.vector(adata$flow)
    TP <- as.vector(adata$TP)
    TN <- as.vector(adata$TN)
    # rain <- as.vector(adata$rain)
    # pet <- as.vector(adata$pet)
    meanTPcalib <- mean(TP[startcalib:endcalib], na.rm=TRUE)
    meanTNcalib <- mean(TN[startcalib:endcalib], na.rm=TRUE)
    TP[is.na(TP)] <- -1 # stan doesn't understand NA
    TN[is.na(TN)] <- -1 # stan doesn't understand NA

    # # catch bad pet
    # j <- which(pet < 0)
    # pet[j] <- (pet[j-1] + pet[j+1]) / 2
    # stopifnot(all(pet>=0))

    #
    nits <- aalloptions[1, 'nits']

    # fit the model
    wits <- nits # warmup iterations (minimum recommended = 150)
    sits <- 200 # sampling iterations FIXME enough? was 400 for bach

    # priors
    chain_init <- function(){
      x <- rtruncnorm(1, priortab$parmin, priortab$parmax, priortab$parmean, priortab$parsd)
      names(x) <- priortab$parname
      as.list(x)
    }
    # chain_init <- function(){list(
    #   medb0raw=rtruncnorm(1, 0, 1, 1.0, priornarrow),
    #   medd1raw=rtruncnorm(1, 0, 1, 0.4, priorwide),
    #   slowb0raw=rtruncnorm(1, 0, 1, 1.0, priornarrow),
    #   slowd1raw=rtruncnorm(1, 0, 1, 0.7, priorwide),
    #   chem1fastraw0=rtruncnorm(1, 0, 1, 0.2/2.0, priorwide), # initial conc
    #   chem1medraw0=rtruncnorm(1, 0, 1, 0.1/2.0, priorwide),
    #   chem1slowraw0=rtruncnorm(1, 0, 1, 0.1/2.0, priorwide),
    #   chem2fastraw0=rtruncnorm(1, 0, 1, 2.0/12.0, priorwide),
    #   chem2medraw0=rtruncnorm(1, 0, 1, 3.0/12.0, priorwide),
    #   chem2slowraw0=rtruncnorm(1, 0, 1, 1.0/12.0, priorwide),
    #   chem1fastraw1=rtruncnorm(1, 0, 1, 0.2/2.0, priorwide), # final conc
    #   chem1medraw1=rtruncnorm(1, 0, 1, 0.1/2.0, priorwide),
    #   chem1slowraw1=rtruncnorm(1, 0, 1, 0.1/2.0, priorwide),
    #   chem2fastraw1=rtruncnorm(1, 0, 1, 2.0/12.0, priorwide),
    #   chem2medraw1=rtruncnorm(1, 0, 1, 3.0/12.0, priorwide),
    #   chem2slowraw1=rtruncnorm(1, 0, 1, 1.0/12.0, priorwide),
    #   chem1fastrawb1=rtruncnorm(1, -1, 1, 0, priornarrow), # first harmonic
    #   chem1medrawb1=rtruncnorm(1, -1, 1, 0, priornarrow),
    #   chem1slowrawb1=rtruncnorm(1, -1, 1, 0, priornarrow),
    #   chem2fastrawb1=rtruncnorm(1, -1, 1, 0, priornarrow),
    #   chem2medrawb1=rtruncnorm(1, -1, 1, 0, priornarrow),
    #   chem2slowrawb1=rtruncnorm(1, -1, 1, 0, priornarrow),
    #   chem1fastrawb2=rtruncnorm(1, -1, 1, 0, priornarrow), # second harmonic
    #   chem1medrawb2=rtruncnorm(1, -1, 1, 0, priornarrow),
    #   chem1slowrawb2=rtruncnorm(1, -1, 1, 0, priornarrow),
    #   chem2fastrawb2=rtruncnorm(1, -1, 1, 0, priornarrow),
    #   chem2medrawb2=rtruncnorm(1, -1, 1, 0, priornarrow),
    #   chem2slowrawb2=rtruncnorm(1, -1, 1, 0, priornarrow)
    # )}

    stan_init <- list(chain_init(), chain_init(), chain_init(), chain_init())

    fit <- stan(stan_model,
                data=c('nintoptions', 'intoptions', 'nrealoptions', 'realoptions',
                       'ndate', 'date', 'flow', 'TP', 'TN', 'meanTPcalib', 'meanTNcalib'),
                # control=list(adapt_delta=0.90, stepsize=0.005, max_treedepth=15),
                warmup=wits,
                iter=wits+sits,
                chains=4,
                init=stan_init, # needed if priors
                # cores = 1, # disable parallel processing
                # save_warmup=FALSE, # warmup iterations required for some diagnostics
                seed=i)

    # memory management if necessary
    # save.image(file="temp.RData")
    # rm(list=ls())
    # load(file="temp.RData")

    # extract samples
    samples <- as.data.frame(rstan::extract(fit)) %>% # very large!
      select(-starts_with('bach')) %>% # discard model traces. This is a bit slow.
      mutate(setname=setname) # add identifier
    write_rds(samples, paste(out_path, setname, '_samples.rds', sep=''))

    # extract quartiles
    results <- summary(fit)$summary # quartiles
    keeps <- grep('bach*', rownames(results), invert=FALSE) # extract model traces 'bach[]'
    traces <- as.data.frame(results[keeps,]) # don't use tibble because want row names
    keeps <- grep('bach*', rownames(results), invert=TRUE) # discard model traces 'bach[]'
    results <- as.data.frame(results[keeps,]) # don't use tibble because want row names
    maxRhat <- max(results$Rhat, na.rm=TRUE) # should be < 1.2
    warning <- ''
    if (maxRhat >= 1.1) { # generate a warning and save fit
      warning <- paste('  Warning: max(Rhat) =', maxRhat, '>= 1.l')
      print(warning)
      # http://discourse.mc-stan.org/t/saving-and-sharing-an-rstan-model-fit/1059
      # fit@stanmodel@dso <- new("cxxdso") # have to kill the Dynamic Shared Object inside the stanmodel slot?
      # write_rds(fit, paste(out_path, setname, '_fit.rds', sep='')) # big file!
    }
    runtime <- as_tibble(get_elapsed_time(fit)) %>% mutate(total=warmup+sample)
    resultst <- cbind.data.frame(nms=names(results), t(results), stringsAsFactors=FALSE) # transpose, keeping names
    # don't use mutate; it kills row names
    resultst[, 1] <- 0 # replace first columns 'nms' with 0
    resultst[, 'totalgens'] <- wits + sits
    resultst[, 'gelmanr'] <- maxRhat
    resultst[, 'elapsed'] <- max(runtime$total)/3600 # hours
    resultst[, 'setname'] <- setname

    write_rds(traces, paste(out_path, setname, '_traces.rds', sep=''))
    write_rds(resultst, paste(out_path, setname, '_quartiles.rds', sep=''))

    # report
    cat(paste('iterations =', wits+sits), file=log_file, sep='\n')
    cat(paste('max(Rhat)  =', maxRhat, warning), file=log_file, sep='\n')
    cat(paste('elapsed(h) =', max(runtime$total)/3600), file=log_file, sep='\n')
    runrecord$gelmanr[i] <- maxRhat
    runrecord$elapsed[i] <- max(runtime$total)/3600

    # insert into output files
    irows <- (i*7-6):(i*7)
    keeps <- match(parcols, colnames(resultst), nomatch=1) # col numbers we want, use col 1 if missing
    bestxs[i, ] <- resultst['50%', keeps]
    quartxs[irows, ] <- resultst[c('2.5%','2.5%','25%','50%','75%','97.5%','97.5%'), keeps]
    keeps <- match(statcols, colnames(resultst), nomatch=1) # col numbers we want, use col 1 if missing
    sbestxs[i, ] <- resultst['50%', keeps]
    squartxs[irows, ] <- resultst[c('2.5%','2.5%','25%','50%','75%','97.5%','97.5%'), keeps]

  } else { # do nothing

    # report
    cat(paste('iterations = 0'), file=log_file, sep='\n')
    cat(paste('max(Rhat)  = unchanged'), file=log_file, sep='\n')
    cat(paste('elapsed(h) = 0'), file=log_file, sep='\n')

  } # fit the model

  # write results so far
  write_tsv(bestxs, file.path(out_path, 'bestxs.tsv'), col_names=FALSE, na='#N/A')
  write_tsv(quartxs, file.path(out_path, 'quartxs.tsv'), col_names=FALSE, na='#N/A')
  write_tsv(sbestxs, file.path(out_path, 'sbestxs.tsv'), col_names=FALSE, na='#N/A')
  write_tsv(squartxs, file.path(out_path, 'squartxs.tsv'), col_names=FALSE, na='#N/A')
  write_tsv(runrecord, file.path(out_path, 'runrecord.tsv'), col_names=TRUE)

  # continue
  i <- i + 1

} # end loop

#
cat(format(Sys.time(), "%a %d %b %H:%M:%S %Y"), file=log_file, sep='\n')
cat("\n")
close(log_file)
showConnections(all=FALSE)
closeAllConnections()
print("Finished.")

# report results of last fit
if (exists("fit")){
  print("Stan compile information:")
  print(fit@stanmodel@dso) # print compilation information
  source("bach_driver_last15.R")
}

# use this if necessary to kill processes that didn't terminate
# kill_all_Rscript_s()

# plot boxplots and traces
source('box_plots16.r')
source('trace_plots15.r')


#http://ggplot2.tidyverse.org/reference/#section-scales

library("ggplot2")
library("scales")
library("data.table")
library("stringi")

args = commandArgs(trailingOnly=TRUE)

cpu_usage_path = args[1]
mem_usage_path = args[2]
disk_usage_path = args[3]
proctimes_path = args[4]

cpu_usage = read.table(sep = ",", cpu_usage_path, header=TRUE)
mem_usage = read.table(sep = ",", mem_usage_path, header=TRUE)
disk_usage = read.table(sep = ",", disk_usage_path, header=TRUE)
proctimes = read.table(sep = " ", proctimes_path, header=FALSE)

# Cada proctime com label deve indicar o fim de o processamento desse label no script
proctimes = subset(proctimes, stri_length(V2) > 0)

cpu_min_TS = min(cpu_usage$TIMESTAMP)
mem_min_TS = min(mem_usage$TIMESTAMP)
disk_min_TS = min(disk_usage$TIMESTAMP)
proctimes_min_TS = min(proctimes$V1)

start_program_TS = min( c(cpu_min_TS, mem_min_TS, disk_min_TS, proctimes_min_TS) )

cpu_usage$IDLE = 100 - cpu_usage$IDLE

mem_usage$TOTAL = (mem_usage$USED/mem_usage$TOTAL)*100

cpu_usage$TIMESTAMP = cpu_usage$TIMESTAMP - start_program_TS
mem_usage$TIMESTAMP = mem_usage$TIMESTAMP - start_program_TS
disk_usage$TIMESTAMP = disk_usage$TIMESTAMP - start_program_TS
proctimes$V1 = proctimes$V1 - start_program_TS

cpu_usage = cpu_usage[c("TIMESTAMP", "IDLE", "GNICE")]
mem_usage = mem_usage[c("TIMESTAMP", "TOTAL", "BUFFER.CACHE")]
disk_read_usage = disk_usage[c("TIMESTAMP", "KB_READ.S", "KB_WRITE.S")]#TIMESTAMP, KB/S, TYPE(READ/WRITE)
disk_write_usage = disk_usage[c("TIMESTAMP", "KB_READ.S", "KB_WRITE.S")]

disk_write_usage$"KB_READ.S" = disk_write_usage$"KB_WRITE.S"

setnames(cpu_usage, c("TIMESTAMP", "USAGE", "TYPE"))
setnames(mem_usage, c("TIMESTAMP", "USAGE", "TYPE"))
setnames(disk_read_usage, c("TIMESTAMP", "MB.S", "TYPE"))
setnames(disk_write_usage, c("TIMESTAMP", "MB.S", "TYPE"))

cpu_usage$TYPE = 'CPU'
mem_usage$TYPE = 'MEM'
disk_read_usage$TYPE = 'READ'
disk_write_usage$TYPE = 'WRITE'

data_cpu_mem = rbind(cpu_usage, mem_usage)
data_disk = rbind(disk_write_usage, disk_read_usage)

data_disk$TYPE = as.character(data_disk$TYPE)
data_disk$TYPE = factor(data_disk$TYPE, levels = unique(data_disk$TYPE))

data_disk$MB.S = data_disk$MB.S/1024

med_proctimes = 0
previous = 0

for(i in 1:dim(proctimes)[1])
{
	med_proctimes[i] = (previous + proctimes$V1[i])/2.0
	previous = proctimes$V1[i]
}

pplot = ggplot(cpu_usage, aes(x=TIMESTAMP, y=USAGE, group=TYPE, colour=TYPE)) +
	geom_line(size=0.7) + xlab("TIME (s)") +
	ylab("USAGE (%)") +
	geom_vline(xintercept = proctimes$V1, linetype=2, size=0.4) +
	annotate("text", x = med_proctimes, y=0.0, label = proctimes$V2) +
	scale_colour_manual(values=c("#FF7777")) +
	theme_bw() +
	guides(fill=guide_legend(title=NULL)) +
	theme(legend.title=element_blank())

ggsave("usage_cpu.png", pplot, width=14)

pplot = ggplot(mem_usage, aes(x=TIMESTAMP, y=USAGE, group=TYPE, colour=TYPE)) +
	geom_line(size=0.7) + xlab("TIME (s)") +
	ylab("USAGE (%)") +
	geom_vline(xintercept = proctimes$V1, linetype=2, size=0.4) +
	annotate("text", x = med_proctimes, y=0.0, label = proctimes$V2) +
	scale_colour_manual(values=c("#0066CC")) +
	theme_bw() +
	guides(fill=guide_legend(title=NULL)) +
	theme(legend.title=element_blank())

ggsave("usage_mem.png", pplot, width=14)

pplot = ggplot(data_cpu_mem, aes(x=TIMESTAMP, y=USAGE, color=TYPE)) +
	geom_line(size=0.7) +
	xlab("TIME (s)") +
	ylab("USAGE (%)") +
	geom_vline(xintercept = proctimes$V1, linetype=2, size=0.4) +
	annotate("text", x = med_proctimes, y=0.0, label = proctimes$V2) +
	scale_colour_manual(values=c("#FF7777", "#0066CC")) +
	theme_bw() +
	guides(fill=guide_legend(title=NULL)) +
	theme(legend.title=element_blank())

ggsave("usage_cpu_mem.png", pplot, width=14)

pplot = ggplot(data_disk, aes(x=TIMESTAMP, y=MB.S, color=TYPE)) +
	geom_line(size=0.7) +
	xlab("TIME (s)") +
	ylab("MB/S") +
	geom_vline(xintercept = proctimes$V1, linetype=2, size=0.4) +
	annotate("text", x = med_proctimes, y=-10.0, label = proctimes$V2) +
	scale_colour_manual(values=c("#FF7777", "#0066CC")) +
	theme_bw() +
	guides(fill=guide_legend(title=NULL)) +
	theme(legend.title=element_blank())

ggsave("usage_disk.png", pplot, width=14)


#*********************
#
# Explore datasets
#
#*********************

library(tidyverse)
library(readxl)

#### 1. acs5 data dictionary ####
# acs : american community survey

acs_dict <- read_csv("./data/acs5_data_dictionary.csv")
dim(acs_dict)
head(acs_dict)

# extract type of variables

acs_dict %>%
  filter(!str_detect(variable,"PE")) %>%
  count(concept)

dh_est <- acs_dict %>%
  filter(!str_detect(variable,"PE") & concept == "ACS DEMOGRAPHIC AND HOUSING ESTIMATES")

house_chr <- acs_dict %>%
  filter(!str_detect(variable,"PE") & concept == "SELECTED HOUSING CHARACTERISTICS")

econ_chr <- acs_dict %>%
  filter(!str_detect(variable,"PE") & concept == "SELECTED ECONOMIC CHARACTERISTICS")

soc_chr <- acs_dict %>%
  filter(!str_detect(variable,"PE") & concept == "SELECTED SOCIAL CHARACTERISTICS IN THE UNITED STATES")

head(dh_est) %>%
  select(-concept)

#### 2. national acs census ####
# contain demographic and socioeconomic data

acs <- read_excel("./data/national_acs5-2018_census.xlsx")
dim(acs)

head(acs)[c(1:5,1034)]
acs$index[1]

acs %>%
  select(GEOID) %>%
  count(GEOID)

#### 3. brownfields data ####

brownfields <- read_csv("./data/brownfields_data_with_county_geoid.zip", guess_max = 60000)

dim(brownfields)
head(brownfields)[c(1:5,149)]

brownfields %>%
  select(GEOID) %>%
  count(GEOID)

id_96908 <- brownfields %>%
  filter(`ACRES Property ID` == 96908)


# rm(list=ls(all=TRUE)); samplerate <- 0.5;  con_layer <- 2; is_shallow=TRUE ; learningrate <- 0.01; is_norm <- FALSE; beta.coe<-1E-3;   iters <- 900000; source("Pro.training.metric.nlcd.r")

# test only
# rm(list=ls(all=TRUE)); samplerate <- 0.1;  con_layer <- 2; is_shallow=TRUE ; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 1800; source("Pro.training.metric.nlcd.r")

## 0.1
# rm(list=ls(all=TRUE)); samplerate <- 0.1;  con_layer <- 2; is_shallow=TRUE ; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 180000; source("Pro.training.metric.nlcd.r")
# rm(list=ls(all=TRUE)); samplerate <- 0.1;  con_layer <- 2; is_shallow=FALSE; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 180000; source("Pro.training.metric.nlcd.r")
# rm(list=ls(all=TRUE)); samplerate <- 0.1;  con_layer <- 2; is_shallow=5    ; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 180000; source("Pro.training.metric.nlcd.r")
# rm(list=ls(all=TRUE)); samplerate <- 0.1;  con_layer <- 2; is_shallow=10   ; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 180000; source("Pro.training.metric.nlcd.r")

## 0.25
# rm(list=ls(all=TRUE)); samplerate <- 0.25; con_layer <- 2; is_shallow=TRUE ; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 460000; source("Pro.training.metric.nlcd.r")
# rm(list=ls(all=TRUE)); samplerate <- 0.25; con_layer <- 2; is_shallow=FALSE; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 460000; source("Pro.training.metric.nlcd.r")
# rm(list=ls(all=TRUE)); samplerate <- 0.25; con_layer <- 2; is_shallow=5    ; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 460000; source("Pro.training.metric.nlcd.r")

## 0.5
# rm(list=ls(all=TRUE)); samplerate <- 0.5;  con_layer <- 2; is_shallow=TRUE ; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 900000; source("Pro.training.metric.nlcd.r")
# rm(list=ls(all=TRUE)); samplerate <- 0.5;  con_layer <- 2; is_shallow=FALSE; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 900000; source("Pro.training.metric.nlcd.r")
# rm(list=ls(all=TRUE)); samplerate <- 0.5;  con_layer <- 2; is_shallow=5    ; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 900000; source("Pro.training.metric.nlcd.r")
# rm(list=ls(all=TRUE)); samplerate <- 0.5;  con_layer <- 2; is_shallow=10   ; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 900000; source("Pro.training.metric.nlcd.r")

## 0.75
# rm(list=ls(all=TRUE)); samplerate <- 0.75; con_layer <- 2; is_shallow=TRUE ; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 1300000; source("Pro.training.metric.nlcd.r")
# rm(list=ls(all=TRUE)); samplerate <- 0.75; con_layer <- 2; is_shallow=FALSE; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 1300000; source("Pro.training.metric.nlcd.r")
# rm(list=ls(all=TRUE)); samplerate <- 0.75; con_layer <- 2; is_shallow=5    ; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 1300000; source("Pro.training.metric.nlcd.r")

## 0.9
# rm(list=ls(all=TRUE)); samplerate <- 0.9;  con_layer <- 2; is_shallow=TRUE ; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 1600000; source("Pro.training.metric.nlcd.r")
# rm(list=ls(all=TRUE)); samplerate <- 0.9;  con_layer <- 2; is_shallow=FALSE; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 1600000; source("Pro.training.metric.nlcd.r")
# rm(list=ls(all=TRUE)); samplerate <- 0.9;  con_layer <- 2; is_shallow=5    ; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 1600000; source("Pro.training.metric.nlcd.r")
# rm(list=ls(all=TRUE)); samplerate <- 0.9;  con_layer <- 2; is_shallow=10   ; learningrate <- 0.01; is_norm <- TRUE; beta.coe<-1E-3;   iters <- 1600000; source("Pro.training.metric.nlcd.r")

# Hank on Dec 5, 2017
currentwd <- getwd();
setwd("../");
source("rf.my.r");
source("cnn.metric.batch.validation.r");
source("split.training.testing.r");
setwd(currentwd);

##***************************************************************************************************
## parameters needed to be adjusted in your own computer
## input file name
linux_folder=".";
if (R.Version()$os == "linux-gnu") linux_folder="/gpfs/data2/workspace/zhangh/dump";
if (R.Version()$os == "linux-gnu") linux_folder="/gpfs/data1/hankui/zhangh/dump"; ## changed on Dec 30 2019 to reflect the broken hardware of /gpfs/data2
if (R.Version()$os == "linux-gnu") linux_folder="./"; ## changed on Aug 29 2021 to reflect new
filename <- paste(linux_folder, "/metric.ard.nlcd.Mar01.18.40.txt", sep="");
## number of threads when running paralleling computation depending on the number of available cores
MAX_THREADS <- 18L;
# MAX_THREADS <- 36L;
##***************************************************************************************************

if (!exists("dat")) dat <- read.table(filename, header=TRUE);
ptm <- proc.time();
ismetric <- 1;
permutation <- 0;
threshold <- 1000; ## throw those classes with samples smaller than this threshold
training_split_dir <- ".//random.numbers//";
if (! dir.exists(training_split_dir)) {print(paste("Creating dir", training_split_dir)); dir.create(training_split_dir); }
cat("\n", filename, " throwing class threshold =", threshold, "sample rate =", samplerate, "is metric =", ismetric, "\n");

## **************************************************
## find classes 1 & 5
classes_nlcd <- read.csv("./nlcd.legend.csv", header=TRUE);
uniqs <- sort(unique(dat$nlcd));
sub.index <- vector(mode="integer");
class_indexs <- vector(mode="integer");
class_names <- vector(mode="character");
class_ns <- vector(mode="integer");
for (i in uniqs) {
	index <- classes_nlcd$VALUE==i;

	indexi <- which (dat$nlcd==i);
	sample_subs <- length(indexi);
	if (sample_subs> threshold) {
		class_indexs <- c(class_indexs, i);
		class_names <- c(class_names, toString(classes_nlcd$CLASS_NAME[index]));
		class_ns <- c(class_ns, sample_subs);		# cat("\nindex: ", i,  toString(classes_nlcd$CLASS_NAME[index]), ":", sample_subs) ;
		sub.index <- c(sub.index, indexi);
	}
}

dat_corn_soy_all <- dat[sub.index, ];

nlcd_all <- dat_corn_soy_all$nlcd;
nlcdindex <- grep("nlcd", colnames(dat_corn_soy_all));

# hist(dat$nlcd, breaks=c(-1, sort(unique(dat$nlcd)), 1000)  )$counts;

## **************************************************
## input metric index
sta_metric_index <- grep("low25.green"  , colnames(dat_corn_soy_all));
end_metric_index <- grep("high75.ratio7", colnames(dat_corn_soy_all));
metric_index <- sta_metric_index:end_metric_index;

## **************************************************
## split the data into training & testing
classes <- sort(unique(nlcd_all));
classn <- length(classes);

sub.index <- vector(mode="integer");
steps <- c(1,1,1);
steps <- rep(1, times=classn);
for (i in 1:classn) {
	indexi <- which (nlcd_all==classes[i]);
	sample_subs <- length(indexi);
	sub.index <- c(sub.index, indexi[seq(from=1,to=sample_subs,by=steps[i])]);
}

nlcd <- nlcd_all[sub.index];
dat_corn_soy <- dat_corn_soy_all[sub.index, ];

train_test_file=paste(training_split_dir, "train_test_file.", basename(filename), ".", samplerate,".n", classn, ".threshold", threshold, sep="");

split.samples <- split.training.testing(train_test_file, classes, classn, class_ns, nlcd, samplerate);
train.index <- split.samples$train.index;
test.index  <- split.samples$test.index;
n_in_each_class_train <- split.samples$n_in_each_class_train;

## **************************************************
## start training & testing
temp.xtrain <- dat_corn_soy[train.index, metric_index];
temp.xtest  <- dat_corn_soy[ test.index, metric_index];

xtrain <- cbind(temp.xtrain[, 1:6], temp.xtrain[, 19:25], temp.xtrain[, c(1:6)+6], temp.xtrain[, c(19:25)+7], temp.xtrain[, c(1:6)+12], temp.xtrain[, c(19:25)+14]);
xtest  <- cbind(temp.xtest [, 1:6], temp.xtest [, 19:25], temp.xtest [, c(1:6)+6], temp.xtest [, c(19:25)+7], temp.xtest [, c(1:6)+12], temp.xtest [, c(19:25)+14]);

## ***********************************************************************************************************************************
## Permutation bands
# permutation <- sample(13);
# print(permutation);
# xtrain1 <- cbind(xtrain[, permutation], xtrain[, permutation+13], xtrain[, permutation+26]);
# xtest1  <- cbind(xtest [, permutation], xtest [, permutation+13], xtest [, permutation+26]);
# xtrain <- xtrain1;
# xtest  <- xtest1 ;

## ***********************************************************************************************************************************
## Permutation bands finished
# as.vector(xtrain[1,1:13] );
ytrain <- dat_corn_soy[train.index,    nlcdindex];
ytest  <- dat_corn_soy[ test.index,    nlcdindex];

itern <- 1;
# itern <- 11;
accuracies <- vector(mode="double", length=itern);
kapps <- vector(mode="double", length=itern);
users     <- matrix(, nrow=itern, ncol=classn);
producers <- matrix(, nrow=itern, ncol=classn);
train.time <- matrix(, nrow=itern, ncol=5);
test.time  <- matrix(, nrow=itern, ncol=5);
conf <- mat.or.vec(classn+2,classn+2);

## ********************************************************************************************************************************************************************
## random forest
ptm_sub <- proc.time();
print_classes(class_indexs, class_names, class_ns);
if (is_shallow==10) {
	cat("...now Random forest....\n");
	for (i in 1:itern)  {
		ntrees <- 500;
		yftrain <- factor(ytrain);
		yftext  <- factor(ytest );

		ptm1 <- proc.time();	## ris.rf2 <- randomForest(x=xtrain, y=yftrain, xtest=xtest, ytest=yftext, replace=FALSE, ntree=ntrees, keep.forest=TRUE); # FAILED
        if (samplerate != 0.9) {
            cat("...normal Random forest when samplerate != 0.9 ....\n");
            ## only training
            ris.rf2 <- randomForest(x=xtrain, y=yftrain, replace=FALSE, ntree=ntrees);
            train.time.i <- proc.time() - ptm1;
            cat(paste("\n", sprintf("%.3f",train.time.i[1]/3600),"\t", sprintf("%.3f",train.time.i[2]/3600),"\t", sprintf("%.3f",train.time.i[3]/3600),"hours\n"));
            # print(ris.rf2$test$confusion);

            ## only testing
            ptm2 <- proc.time();
            ris.predicted <- predict(object=ris.rf2, newdata=xtest); # ris.rf2 <- randomForest(x=xtrain, y=yftrain, replace=FALSE, ntree=ntrees);
            test.time.i <- proc.time() - ptm2;
            cat(paste("\n", sprintf("%.3f",test.time.i[1]/3600),"\t", sprintf("%.3f",test.time.i[2]/3600),"\t", sprintf("%.3f",test.time.i[3]/3600),"hours\n"));
            print(paste("Accuracy:", 100*sum(as.numeric(ris.predicted) == as.numeric(yftext))/length(ris.predicted) ) );

            ## training & testing & recording accuracy
            # ptm_sub <- proc.time();
            # result <- rf.my(xtrain, ytrain, xtest, ytest);
            result <- confusion(ris.predicted, ytest, filename=paste("random.forest.temp.confusion", ".csv", sep="") );

        } else { ## when samplerate == 0.9 the above training failed
            ## only training
            cat("...weird Random forest when samplerate != 0.9 ....\n");
            ris.rf2 <- randomForest(x=xtrain, y=yftrain,  xtest=xtest[1,], ytest=yftext[1], replace=FALSE, ntree=ntrees); ## keep.forest cannot be set TRUE
            train.time.i <- proc.time() - ptm1;
            cat(paste("\n", sprintf("%.3f",train.time.i[1]/3600),"\t", sprintf("%.3f",train.time.i[2]/3600),"\t", sprintf("%.3f",train.time.i[3]/3600),"hours\n"));
            ## training and testing
            ptm2 <- proc.time();
            result <- rf.my(xtrain, ytrain, xtest, ytest);
            test.time.i <- proc.time() - ptm2 - train.time.i;
            cat(paste("\n", sprintf("%.3f",test.time.i[1]/3600),"\t", sprintf("%.3f",test.time.i[2]/3600),"\t", sprintf("%.3f",test.time.i[3]/3600),"hours\n"));
        }
        # print (result)

        ## add results to matrices
		accuracies[i] <- result$Accuracy;
        kapps[i] <- result$Kappa;
        conf <- conf+(result$Confusion);
		users[i,] <- result$Confusion[classn+2, 1:classn]; producers[i,] <- result$Confusion[1:classn, classn+2];

        train.time[i,] <- train.time.i/3600; test.time[i,] <- test.time.i/3600;
	}
	print_sta(ptm_sub, conf, itern, accuracies, kapps, classn);
	# stop("I stopped here");
} else {

    ## ********************************************************************************************************************************************************************
    ## deep learning
    cat("\n...now Deep learning....\n");
    # conf <- mat.or.vec(classn+2,classn+2);
    # ptm_sub <- proc.time();
    for (i in 1:itern) {
        cat("\n", i, "th iteration \n");
        result <- cnn.metric.batch.validation(xtrain, ytrain, xtest, ytest, n_in_each_class_train,
            input_dim_x=13, input_dim_y=3, classes=classes, classn=classn, learningrate=learningrate,
            iters=iters, beta.coe=beta.coe, con_layer=con_layer, is_shallow=is_shallow);

        ## add results to matrices
        accuracies[i] <- result$Accuracy;
        kapps[i] <- result$Kappa;
        conf <- conf + result$Confusion;
        users[i,] <- result$Confusion[classn+2, 1:classn]; producers[i,] <- result$Confusion[1:classn, classn+2];
        train.time[i,] <- as.numeric(result$train.time); test.time[i,] <- as.numeric(result$test.time);
    }
}
print_sta(ptm_sub, conf, itern, accuracies, kapps, classn);
## class_names added on May 1st but not systematically run
save(samplerate, class_names, split.samples, accuracies, kapps, users, producers, train.time, test.time,
	file=paste0(".//itern", itern, "samplerate", samplerate, "is_shallow",  is_shallow, "nlcd") );
time.my <- proc.time() - ptm_sub;
cat(paste("\n", sprintf("%.3f",time.my[1]/3600),"\t", sprintf("%.3f",time.my[2]/3600),"\t", sprintf("%.3f",time.my[3]/3600),"hours\n"));
print(train.time)
# print( test.time)
print(accuracies)


source("rules.processing.r")
source("csv.to.rcf.r")
library("plyr")

rare.rules.ad <- function(Input.file, ## input csv context file
                          OutputScoresFile,
                          MinSup # Support
                          ) {

  cat("\n Ad detection without GT")

  options(max.print =  10000000)

  cat('\n ############### Rare Rule Mining Anomaly Detection ######################## \n')

  ################ Load objects, attributes and binary matrix from CSV file.

  cat('\n reading the current context file \n ',Input.file)

  ###We suppose that the RCF file exists in the same directory of the input csv file.
  ## Later we are going to add a check to test the existance of the RCF file.
  ## If it is missing we will use the csv_to_rcf function to create it.
  ContextFileRCF=gsub("csv","rcf",Input.file)
  if(!file.exists(ContextFileRCF)) {
    cat("The Context RCF file does not exist, creating it\n")
    csv.to.rcf(Input.file,ContextFileRCF)
  }

  cat("\n starting the extraction of the association rules \n")
  #RareAssRulescmd = paste0(getwd(),
  #    "/coron-0.8/core02_assrulex.sh  ",ContextFileRCF, " ",
  #    MinSup,"% 100% -names -alg:BtB -rule:rare  -full  -examples",sep="")
  RareAssRulescmd = paste0("java -Xmx16384m -cp jar/assrulex-pg-bin.jar:jar/coron-pg-bin.jar fr.loria.coronsys.assrulex.Main ",ContextFileRCF," ",MinSup,"% 100% -names -alg:BtB -rule:rare -full -examples")
  cat(RareAssRulescmd)
  RareAssRulesresult=try(system(RareAssRulescmd, intern = TRUE,  wait = TRUE))
  #####################
  rules.processing.results = rules.processing(RareAssRulesresult)
  cat('\n Rules extraction done! \n')

  ###########=========================================================================================
  ListScore <- list()
  RuleMaxScore <- list()

  ##reading the results
  PositivesList = rules.processing.results$Positives.List #
  RulesList = rules.processing.results$Rules.List
  objectsOfRules = rules.processing.results$objectsOf.Rules
  CondRules = rules.processing.results$Cond.Rules
  ResRules = rules.processing.results$Res.Rules
  Lift = rules.processing.results$OriginalLift.sc
  n = length(PositivesList)
  if (n > 0) {
    for (id in 1:n) {
      #cat("\n Scoring Object_ID", id, " : ", PositivesList[id],"\n")
      CurrentObject = PositivesList[id]
      maxscore = 0
      ## Check the toxicity of the current object % each rule.
      for (idRule in 1:length(RulesList)) {
          if(CurrentObject %in% objectsOfRules[[idRule]]) {

          #scoreLift = scoreLift-lengthRule*log2(1-as.double(Lift[[idRule]] ))
                                        #        scoreLift = max(scoreLift, as.double(Lift[[idRule]]))
          maxscore = max(maxscore,Lift[[idRule]])
          maxrule = str_c(CondRules[[idRule]]," -> ", ResRules[[idRule]])
        }
      }
      ListScore = c(ListScore,maxscore)
      RuleMaxScore = c(RuleMaxScore, maxrule)
    }
  }

  ListScore = lapply(ListScore, function(x)as.double(x))
                                        #export  results only
  df.ObjectsWithScores = data.frame(matrix(ncol = 3, nrow = 0))
  colnames(df.ObjectsWithScores) = c("UUID", "Score","Rule" )

  if(length(ListScore) > 0) {
    df.ObjectsWithScores = do.call(rbind, Map(data.frame,
                                              "UUID"=as.list(PositivesList),
                                              "Score"= ListScore,
                                              "Rule"=RuleMaxScore ))
    df.ObjectsWithScores = arrange(df.ObjectsWithScores ,desc(df.ObjectsWithScores$Score) )
  }
  ##Export the results
  write.csv(df.ObjectsWithScores,file=OutputScoresFile, row.names = FALSE)
  cat("\n *** Results saved for this context \n ")

}


library(ggplot2)
library(ggthemes)
library(waffle)

# pdf('peak_distribution.pdf',width=12.5417,height=4.9722)

data = read.csv(file='cleaned_data.csv', sep=',', header = TRUE)

oldpar <- par(mar=rep(0,4))
plot <- ggplot(data, aes(x=mode)) +
        geom_histogram(color='white', fill='blue', binwidth=1) +
        # geom_bar(color='white', fill='blue') +
        # scale_y_continuous(breaks = seq(0, 1000, by = 100)) +
        theme_wsj(color='white') +
        guides(alpha = FALSE) + theme(plot.margin=grid::unit(c(0,0,0,0), "mm"))

par(oldpar)
print(plot)
par(oldpar)
dev.off()


library(data.table)
library(arm)
source('../config.r')
source('../utils.r')

extra_path <- file.path('..', 'figure-2', 'inputs')

new_path <- file.path('..', 'figure-S2', 'inputs')

#' Get together all input files.
#' First the extra data files. We'll write a function for that.
#'

stack_wide2 <- function(DT)
{
  DT_wide <- data.table(eid = unique(DT$eid))

  DT_tmp <- merge(
    DT_wide,
    DT[target == 'Age'][, c("eid")])

  setkey(DT_wide, eid)
  DT_tmp <- DT[target == 'Age'][,
    .(age = true, age_pred = predicted, eid = eid)]

  setkey(DT_tmp, eid)
  DT_wide[DT_tmp, `:=`(age = i.age, age_pred = i.age_pred)]

  DT_tmp <- DT[target == 'Neuroticism'][,
      .(N = true, N_pred = predicted, eid = eid)]
  setkey(DT_tmp, eid)
  DT_wide[DT_tmp, `:=`(N = i.N, N_pred = i.N_pred)]

  DT_tmp <- DT[target == 'Fluid intelligence'][,
      .(FI = true, FI_pred = predicted, eid = eid)]
  setkey(DT_tmp, eid)
  DT_wide[DT_tmp, `:=`(FI = i.FI, FI_pred = i.FI_pred)]
  DT_wide
}

read_file_parts <- function(fname, path1, path2){
  fnames <- list.files(
    path1, paste0(strsplit(fname, ".csv")[[1]], "_"), full.names = T)

  # make sure not to use the old age outputs
  fnames <- Filter(function(x) {!(endsWith(x, 'age.csv') |
                                  endsWith(x, 'age_at_assessment.csv'))},
                   fnames)

  fnames2 <- list.files(
    path2, paste0(strsplit(fname, ".csv")[[1]], "_"), full.names = T)

  fnames <- c(fnames, fnames2)

  rbindlist(lapply(fnames, fread))
}

assemble_inputs <- function(fname, path1, path2)
{
  DT_pred <- read_file_parts(fname, path1 = path1, path2= path2)
  DT_pred$variable <- NULL
  has_var <- "variable" %in% names(DT_pred)

  # kick out unneccesary variables ... and average over folds (shuffle splits..).
  if (has_var) {
    DT_pred <- DT_pred[, .(predicted = mean(predicted), true = true[1]),
                       by = .(eid, variable, target, evaluation)]
  } else {
    DT_pred <- DT_pred[, .(predicted = mean(predicted), true = true[1]),
                       by = .(eid, target, evaluation)]
  }

  this_stack_wide <- ifelse(has_var, stack_wide, stack_wide2)

  DT_pred[, eid := factor(eid)]
  #' We need to clean up a bit now. Load test and train sets independently.
  #' Then make sure things look as expected. Then stack the two

  DT_pred_dev <- DT_pred[evaluation == "Validation"]
  DT_pred_dev[,c("evaluation")] <- NULL
  DT_pred_dev_wide <- this_stack_wide(DT_pred_dev)

  DT_pred_gen <- DT_pred[evaluation != "Validation"]
  DT_pred_gen[,c("evaluation")] <- NULL
  DT_pred_gen_wide <- this_stack_wide(DT_pred_gen)

  stopifnot(sum(DT_pred_dev_wide$eid %in%
                DT_pred_gen_wide$eid) == 0)

  DT_pred_dev_wide[, evaluation := "Validation"]
  DT_pred_gen_wide[, evaluation := "Generalization"]
  DT_pred_wide <- rbind(DT_pred_dev_wide, DT_pred_gen_wide)

  DT2 <- get_extras2(extra_path)

  DT_pred_wide2 <- merge(DT_pred_wide, DT2, by = "eid",
                         allow.cartesian = T)

  #' So far we have computed models grouped by predictor models. Hower, this
  #' brings the slight disadvantage of not combining the best models as different
  #' models were most predictive for each target. We can do better. Let's select
  #' subject the best predictions to multiple regression.

  if (has_var) {
    DT_pred_wide3 <- DT_pred_wide2[variable == 'Life style',
      .(eid, age, age_pred, evaluation, value, family, name)]

    DT_tmp <- DT_pred_wide2[variable == 'Mental Health', .(eid, N, N_pred, family)]
    setkey(DT_tmp, eid, family)
    setkey(DT_pred_wide3, eid, family)
    DT_pred_wide3[DT_tmp, `:=`(N_pred = N_pred, N = N)]

    DT_tmp <- DT_pred_wide2[variable == 'Education', .(eid, FI, FI_pred, family)]
    setkey(DT_tmp, eid, family)
    DT_pred_wide3[DT_tmp, `:=`(FI_pred = FI_pred, FI = FI)]
  } else {
    DT_pred_wide3 <- DT_pred_wide2
  }
  DT_pred_wide3
}

fname <-
  'post_predictive_analysis_all_models_combined_imaging_non_imaging.csv'

DT_pred <- assemble_inputs(fname, path1 = extra_path, path2 = new_path)

#' Get point estimates + standard outputs for conditional target model
DT_cond_proxy <- DT_pred[,
  {
    train <- .SD[evaluation == "Validation"]
    test <- .SD[evaluation == "Generalization"]
    deconf <- fit_train_deconfound(
      train = train, test = test, var = "value", confound = "age")
    value_adjusted <- deconf[['pred']]
    # fit association model on test set
    age_delta <- with(test, age_pred - age)  # ... XXX

    mod <- lm(scale(value) ~           # y
              scale(value_adjusted) +  # confound_train XXX
              scale(age_delta) +       # brain age
              scale(FI_pred) +              # Fluid Intelligence
              scale(N_pred), test)     # Neuroticism

    coefs <- coef(summary(mod))
    out <- data.frame(
      coef = coefs[-c(1, 2), 1],  # kick out intercept + confound term
      se = coefs[-c(1, 2), 2],    # ... and get columns for coef and error
      p.val = coefs[-c(1, 2), 4],
      target = c("Brain Age Delta", "Fluid Intelligence", "Neuroticism"))
    out['nobs'] = nobs(mod)
    out['name'] = name[1]
    out
  },
  by = family]

#' get parametric bootstrap for conditional proxy model.
DT_cond_proxy_bs <- DT_pred[,
  {
    train <- .SD[evaluation == "Validation"]
    test <- .SD[evaluation == "Generalization"]
    deconf <- fit_train_deconfound(
      train = train, test = test, var = "value", confound = "age")
    value_adjusted <- deconf[['pred']]

    # fit association model on test set
    age_delta <- with(test, age_pred - age)  # ... XXX

    mod <- lm(scale(value) ~           # y
              scale(value_adjusted) +  # confound_train XXX
              scale(age_delta) +       # brain age delta
              scale(FI_pred) +              # Fluid Intelligence
              scale(N_pred), test)     # Neuroticism
    n.sim <- 10000
    mod.sim <- arm::sim(mod, n.sim = n.sim)
    out <- data.table(mod.sim@coef)
    data.table(
      name = name[1],
      coef = c(out[['scale(age_delta)']],
                out[['scale(FI_pred)']],
                out[['scale(N_pred)']]),
      target = rep(c("Brain Age Delta", "Fluid Intelligence", "Neuroticism"),
        each = n.sim)
    )
  },
  by = family]

# Target models

#' Get point estimates + standard outputs for conditional target model
DT_cond_target <- DT_pred[,
  {
    train <- .SD[evaluation == "Validation"]
    test <- .SD[evaluation == "Generalization"]

    # fit association model on test set
    age_delta <- with(test, age_pred - age)  # ... XXX

    mod <- lm(scale(value) ~           # y
              scale(age) +       # brain age delta
              scale(FI) +              # Fluid Intelligence
              scale(N), test)     # Neuroticism

    coefs <- coef(summary(mod))
    out <- data.frame(
      coef = coefs[-1, 1],  # kick out intercept
      se = coefs[-1, 2],    # ... and get columns for coef and error
      p.val = coefs[-1, 4],
      target = c("Age", "Fluid Intelligence", "Neuroticism"))
    out['nobs'] = nobs(mod)
    out['name'] = name[1]
    out
  },
  by = family]

# get parametric bootstrap for conditional target model
DT_cond_target_bs <- DT_pred[,
  {
    train <- .SD[evaluation == "Validation"]
    test <- .SD[evaluation == "Generalization"]

    # fit association model on test set
    age_delta <- with(test, age_pred - age)  # ... XXX

    mod <- lm(scale(value) ~           # y
              scale(age) +       # brain age delta
              scale(FI) +              # Fluid Intelligence
              scale(N), test)     # Neuroticism
    n.sim <- 10000
    mod.sim <- arm::sim(mod, n.sim = n.sim)
    out <- data.table(mod.sim@coef)
    data.table(
      name = name[1],
      coef = c(out[['scale(age)']],
               out[['scale(FI)']],
               out[['scale(N)']]),
      target = rep(c("Age", "Fluid Intelligence", "Neuroticism"),
        each = n.sim)
    )
  },
  by = family]

fwrite(DT_cond_proxy, 'modS3_cond_proxy.csv')
fwrite(DT_cond_proxy_bs, 'modS3_cond_proxy_bs.csv')
fwrite(DT_cond_target, 'modS3_cond_target.csv')
fwrite(DT_cond_target_bs, 'modS3_cond_target_bs.csv')


#' Read a no-flow matrix text file
#'
#' This function reads a no-flow matrix text file. It first reads the model .dis file to
#' obtain the dimensions of the finite-diference grid.
#'
#' readnoflow(FILE, rootname)
#' @param FILE is the name of the no-flow matrix file
#' @param rootname is the rootname of the groundwater flow model.
#' This will be used to find and read the discretization file
#' @export
#' @examples
#' readnoflow(FILE = NF.dat, rootname = "FF_INIT")

readnoflow <- function(FILE, rootname){
    infl <- FILE
    d <- MFtools::readdis(rootname)
    conn <- file(infl, open = "r")
    linin <- readLines(conn)
    close(conn)
    NFin <- vector(mode = "integer", length = d$NCOL * d$NROW * d$NLAY)
    NFin <- linin[seq(1:(d$NROW * d$NLAY))] %>%
              strsplit("\\s+") %>%
              unlist() %>%
              subset(. != "") %>%
              as.integer()
    NF <- tibble::data_frame(
                  LAY = rep(1:d$NLAY, each = d$NCOL * d$NROW) %>% as.integer(),
                  ROW = rep(rep(1:d$NROW, each = d$NCOL), d$NLAY) %>% as.integer(),
                  COL = rep(rep(seq(1, d$NCOL, 1), d$NROW), d$NLAY) %>% as.integer(),
                  NF = NFin %>% as.integer())
    return(NF)
}


#' @title string2chron
#' @description convert a string representation of chron into a chron object
#' @family abysmally documented
#' @author  unknown, \email{<unknown>@@dfo-mpo.gc.ca}
#' @export
  string2chron = function(u, informat=c(dates="year-m-d", times="h:m:s"), outformat=c(dates="year-m-d", times="h:m:s") ) {
    require (chron)
    u = gsub("[()]", "", u)
    ii = which( is.na(u) )
    jj = which( ! is.na(u) )
    if (length (ii) > 0) u[ii] = "NA NA" # force a double NA entry to allow parsing below
    out = rep( NA, length(u) )  # initiate output vector
    y = matrix(unlist(strsplit(u, " ")),ncol=2,byrow=T)
    out[jj] = chron( dates(y[jj,1], format=informat[1]), times(y[jj,2],format=informat[2]) )
    out = as.chron(out, out.format=outformat )
    return(out)
  }


library(data.table)
K <- 100
set.seed(1)
#for (file in c("2e6", "1e7", "1e8")){
for (file in c("1e5")){
	N <- as.integer(file)
	DT <- data.table(
	  id1 = sample(sprintf("id%03d",1:K), N, TRUE),      # large groups (char)
	  id2 = sample(sprintf("id%03d",1:K), N, TRUE),      # large groups (char)
	  id3 = sample(sprintf("id%010d",1:(N/K)), N, TRUE), # small groups (char)
	  id4 = sample(K, N, TRUE),                          # large groups (int)
	  id5 = sample(K, N, TRUE),                          # large groups (int)
	  id6 = sample(N/K, N, TRUE),                        # small groups (int)
	  v1 =  sample(5, N, TRUE),                          # int in range [1,5]
	  v2 =  sample(1e6, N, TRUE),                        # int in range [1,1e6]
	  v3 =  sample(round(runif(100,max=100),4), N, TRUE) # numeric e.g. 23.5749
	)
	write.table(DT,paste0(file,".csv"),row.names=F, sep="\t")

	if (file == "2e6"){
		DT_merge <- unique(DT, by = c("id1", "id3"))
		write.table(DT_merge,"merge.csv",row.names=F, sep="\t")
	}
}


p <- qplot(factor(week), factor(wday, levels = unique(wday[order(wday_num)]), ordered = T),
           data=ledger_data, fill = amount, geom = "tile") +
           scale_fill_gradientn(name = commodity, colours = c("#D61818","#FFAE63","#FFFFBD","#B5E384")) +
           scale_x_discrete(name = "Week", breaks=seq(min(ledger_data$week), max(ledger_data$week), by=5)) +
           facet_wrap(~year) +
           theme(axis.title.y = element_blank()) # No title on the y-axis

suppressMessages(ggsave(file="tile-amount-vs-week-wday-facet-year.svg", plot=p,
                        width=1+max(ledger_data$month_num)-min(ledger_data$month_num), height=3))


setwd(dirname(rstudioapi::getActiveDocumentContext()$path))
library("seqinr")
library("Biostrings")
library("phytools")
library("phangorn")
library("ape")

ebola_names <- c('Zaire', 'TaiForest', 'Sudan', 'Reston', 'Bundibugyo')
gene_names <- c('NP', 'VP35', 'VP40', 'GP', 'VP30', 'VP24', 'L')

#------------------------------------reading data
genes_r <- list();#real genes
genes <- list();#founded genes
genomes <- list();# all genomes
genomes[['Marburg']] <- readDNAStringSet("Marburg_genome.fasta")
for(name in ebola_names) {
  genes_r[[name]] <- read.fasta(file = paste("RealGenes/",name,"_Genes.fasta",sep = ""))
  genes[[name]] <- read.fasta(file = paste("Founded_Genes/",name,"_Genes.fasta",sep = ""))
  genomes[[name]] <- readDNAStringSet(paste("Genomes/",name,"_genome.fasta",sep = ""))
  }
mar_genome = read.fasta(file = "Marburg_genome.fasta")

#reading distance matrices that was created in java code
dMat <- list()
dMat_r <- list()
for(name in gene_names) {
  dMat[[name]] <- matrix(scan(paste("CSVs/",name,".csv",sep = ""), sep=","),ncol=5)
  dMat_r[[name]] <- matrix(scan(paste("RealCSVs/",name,".csv",sep = ""), sep=","),ncol=5)
}
#----------------------------------------

#---------------creating Phylogeny Trees of each gene
upgma_trees <- list()
nj_trees <- list()
for(name in gene_names) {
  upgma_trees[[name]] <- upgma(dMat[[name]])
  upgma_trees[[name]][["tip.label"]] <- ebola_names
  nj_trees[[name]] <- nj(dMat[[name]])
  nj_trees[[name]][["tip.label"]] <- ebola_names
}

#----------------plotting the pheylogeny Trees of each gene
for(name in gene_names) {
  png(filename = paste("GeneTrees/UPGMA_",name,".png",sep = ""))
  plot(upgma_trees[[name]],use.edge.length = FALSE,main=paste("UPGMA - (",name,") Gene of Ebola"))
  edgelabels(round(upgma_trees[[name]]$edge.length), col="black", font=2)
  dev.off()
}

for(name in gene_names) {
  png(filename = paste("GeneTrees/NJ_",name,".png",sep = ""))
  plot(nj_trees[[name]],use.edge.length = FALSE,main=paste("Neighbor Joining - (",name,") Gene of Ebola"))
  edgelabels(round(nj_trees[[name]]$edge.length), col="black", font=2)
  dev.off()
}

#---------------creating combined phelogeny trees
upgma_tree_full <- list()
upgma_tree_full[['mean']] <- consensus.edges(upgma_trees)#mean
upgma_tree_full[['ls']] <- consensus.edges(upgma_trees,method="least.squares")#least squared

nj_tree_full <- list()
nj_tree_full[['mean']] <- consensus.edges(nj_trees)#mean
nj_tree_full[['ls']] <- consensus.edges(nj_trees,method="least.squares")#least squared

tree_full <- list()
tree_full[['mean']] <- consensus.edges(c(upgma_trees,nj_trees))#mean
tree_full[['ls']] <- consensus.edges(c(upgma_trees,nj_trees),method="least.squares")#least squared
#---------------plotting combined phelogeny trees
for (meth in c('mean','ls')) {
  png(filename = paste("CombinedTrees/UPGMA_",meth,".png",sep = ""))
  plot(upgma_tree_full[[meth]],use.edge.length = TRUE,main=paste("Combined UPGMA Trees - Method:",meth))
  edgelabels(round(upgma_tree_full[[meth]]$edge.length), col="black", font=2)
  dev.off()
  png(filename = paste("CombinedTrees/NJ_",meth,".png",sep = ""))
  plot(nj_tree_full[[meth]],use.edge.length = TRUE,main=paste("Combined NJ Trees - Method:",meth))
  edgelabels(round(nj_tree_full[[meth]]$edge.length), col="black", font=2)
  dev.off()
  png(filename = paste("CombinedTrees/ALL_",meth,".png",sep = ""))
  plot(tree_full[[meth]],use.edge.length = TRUE,main=paste("All Trees Combined - Method:",meth))
  edgelabels(round(tree_full[[meth]]$edge.length), col="black", font=2)
  dev.off()
}

#-----------------------------------creating trees based on global alignment
subMat <- nucleotideSubstitutionMatrix(match = 0, mismatch = -1, baseOnly = TRUE)

genomes_aligned <- array(list(),c(6,6))
dMat_glob = matrix(nrow = 6,ncol = 6)

#global alignment between genomes and calculating levenshtein distance

for (i in 1:5) {
  for (j in (i+1):6) {
    genomes_aligned[i,j][[1]] <- pairwiseAlignment(paste(genomes[[i]],collapse = ""),
                                                   paste(genomes[[j]],collapse = ""), type="global",
                                                   substitutionMatrix = subMat,
                                                   gapOpening = 0, gapExtension = 1)
    genomes_aligned[j,i][[1]] <- genomes_aligned[i,j][[1]]
    dMat_glob[i,j] <-stringDist(c(paste(genomes[[i]],collapse = ""),
                                  paste(genomes[[j]],collapse = "")), method = "levenshtein")
    dMat_glob[j,i] = dMat_glob[i,j]
  }
}
#dMat_glob <- dMat_glob_withmar
upgma_tree_glob <- list()
upgma_tree_glob <- upgma(dMat_glob[-1,-1])
upgma_tree_glob[["tip.label"]] <- ebola_names
nj_tree_glob <- list()
nj_tree_glob <- nj(dMat_glob[-1,-1])
nj_tree_glob[["tip.label"]] <- ebola_names

png(filename = paste("CombinedTrees/UPGMA_Glob.png",sep = ""))
plot(upgma_tree_glob,use.edge.length = TRUE,main="Global Alignment + UPGMA")
edgelabels(round(upgma_tree_glob$edge.length), col="black", font=2)
dev.off()
png(filename = paste("CombinedTrees/NJ_Glob.png",sep = ""))
plot(nj_tree_glob,use.edge.length = TRUE,main="Global Alignment + NJ")
edgelabels(round(nj_tree_glob$edge.length), col="black", font=2)
dev.off()

#creating trees with upgma and nj
upgma_tree_glob_withmar <- list()
upgma_tree_glob_withmar <- upgma(dMat_glob)
upgma_tree_glob_withmar[["tip.label"]] <- c("Marburg",ebola_names)
nj_tree_glob_withmar <- list()
nj_tree_glob_withmar <- nj(dMat_glob)
nj_tree_glob_withmar[["tip.label"]] <- c("Marburg",ebola_names)

#plotting the trees
png(filename = "CombinedTrees/UPGMA_Glob_withmar.png")
plot(upgma_tree_glob_withmar,use.edge.length = FALSE,main="Global Alignment + UPGMA + Marburg")
edgelabels(round(upgma_tree_glob_withmar$edge.length), col="black", font=2)
dev.off()
png(filename = "CombinedTrees/NJ_Glob_withmar.png")
plot(nj_tree_glob_withmar,use.edge.length = FALSE,main="Global Alignment + NJ + Marburg")
edgelabels(round(nj_tree_glob_withmar$edge.length), col="black", font=2)
dev.off()

#----------------------------Estimating times
#putting levinshtein distances in a matrix
p_mat <- matrix(nrow = 6, ncol = 6)
for (i in 1:6) {
  p_mat[i,i]<-1
}
#calculating simi
for (i in 1:5) {
  for (j in (i+1):6) {
    #calculating proportion of mismatches
    p_mat[i,j] <- nmismatch(genomes_aligned[i,j][[1]])/
      (nmatch(genomes_aligned[i,j][[1]])+nmismatch(genomes_aligned[i,j][[1]]))
    p_mat[j,i] = p_mat[i,j]
  }
}
time_mat <- matrix(nrow = 6, ncol = 6)
time_mat <- apply(p_mat,2,function (x) -0.75*(log(1-4*x/3)))#calculating Juke Cantor
time_mat <- round(time_mat/0.0019)#time distance between species
time_mat


# Packages -----------------------------------------------------------------
library(EpiNow2)
library(data.table)
library(future)
library(here)
library(readxl)

# Update delays -----------------------------------------------------------
generation_time <- readRDS(here::here("data-raw", "data", "generation_time.rds"))
incubation_period <- readRDS(here::here("data-raw", "data", "incubation_period.rds"))
reporting_delay <- readRDS(here::here("data-raw", "data", "reporting_delay.rds"))

# Get cases  ---------------------------------------------------------------
# read in and convert to data.table
cases <- read_excel(here::here("data-raw", "data", "data_covid_okresy.xlsx"), sheet = "data")
cases <- setDT(cases)

# make long format
cases <- melt(cases, id.vars = "Date", variable.name = "region", value.name = "confirm")

# change variable type to required input
cases <- cases[, .(date = as.Date(Date),
                   region = as.character(region),
                   confirm = as.integer(confirm))]

# get rid of internal total
cases <- cases[!(region %in% "grand_total")]

# add pilot regions
pilot_regions <- c("tvrdosin", "dolny_kubin", "namestovo", "bardejov")
pilot <- copy(cases)[region %in% pilot_regions]
pilot <- pilot[date <= "2020-10-22"]
sum_pilot <- copy(pilot)[, .(confirm = sum(confirm)), by = date]
sum_pilot <- sum_pilot[, region := "pilot"]

# add non-pilot regions
non_pilot <- copy(cases)[!(region %in% pilot_regions)]
sum_non_pilot <- copy(non_pilot)[, .(confirm = sum(confirm)), by = date]
sum_non_pilot <- sum_non_pilot[, region := "non-pilot"]

## all reginos
sum_all <- copy(cases)[, .(confirm = sum(confirm)), by = date]
sum_all <- sum_all[, region := "all"]

# link back together
cases <- rbindlist(list(pilot, sum_pilot, non_pilot, sum_non_pilot, sum_all),
                   use.names = TRUE)
setorder(cases, region, date)

# Run Rt estimation -------------------------------------------------------
# set up parallel cores
setup_future(cases, min_cores_per_worker = 4)
options(mc.cores = 4)

# estimate Rt by region
regional_epinow(reported_cases = cases,
                generation_time = generation_time,
                delays = delay_opts(incubation_period, reporting_delay),
                horizon = 8,
                rt = rt_opts(prior = list(mean = 1.0, sd = 0.2), future = -7),
                stan = stan_opts(samples = 4000, warmup = 1000, chains = 4),
                target_folder = here("data-raw", "data", "rt", "samples"),
                logs = here("data-raw", "data", "rt", "logs"),
                output = c("samples", "plots", "latest"))

# shut down cluster
future::plan("sequential")

# summarise output
regional_summary(reported_cases = cases,
                 results_dir = here("data-raw", "data", "rt", "samples"),
                 summary_dir = here("data-raw", "data", "rt"),
                 region_scale = "county", all_regions = TRUE)


library("sf")
library("maps")
library("rnaturalearth")
library("rnaturalearthdata")
library("tidyr")
library(dash)
library(dashCoreComponents)
library(dashHtmlComponents)
library(dashBootstrapComponents)
library(ggplot2)
library(plotly)
library(readr)
library(dashTable)
library(stringr)
library(scales)
library(rlang)
library(dplyr)
library(purrr)

# loading a cleaned data

#here::here("data", "raw", "provincial_voting_results.csv")

data <- read_csv("data/processed/cleaned_data.csv")

# grouping states data for map plot
states_data <- data %>%
  group_by(state) %>%
  drop_na(price) %>%
  summarise(mean_price = mean(price),
            mean_rating = mean(points),
            mean_value = mean(value),
            num_reviews = n())

# joing the state id

df <- read.csv("https://raw.githubusercontent.com/plotly/datasets/master/2011_us_ag_exports.csv")
states_data <- left_join(states_data, df %>% select(c('code','state')), by = c("state" = "state"))

app <- Dash$new(external_stylesheets = dbcThemes$BOOTSTRAP)

app$layout(
    dbcContainer(
        list(
            dccGraph(id='map'),
            dccGraph(id='bar'),
            dccDropdown(
                id='state',
                options = purrr::map(data %>% distinct(state) %>% pull(), function(state) list(label = state, value = state)),
                value='Oregon',
                multi=TRUE)
        )
    )
)
# callback for map
app$callback(
    output('map', 'figure'),
    list(input('state', 'value')),
    function(selected_state) {
        states_data = states_data %>% filter(state %in% selected_state)
        wine_colors <- c('#C7DBEA', '#CCCCFF', '#C1BDF4',
                        '#B6AEE9', '#948EC0', '#8475B2',
                        '#735BA4', '#624296', '#512888')
        p <- plot_ly(states_data,
        type = 'choropleth', locationmode = 'USA-states',
        z = ~num_reviews, locations = ~code, color = ~num_reviews, colors = wine_colors)
        p <- p %>% layout(geo = list(scope = 'usa', projection = list(type = 'albers usa')),
             title = 'USA exports')
    }
)
app$callback(
    output('scatter', 'figure'),
    list(input('state', 'value')),
    function(selected_state) {
        data = data %>% filter(state %in% selected_state)
        # data for scatter plot
        wine_data <- data %>%
            group_by(variety) %>%
            summarize(rating = mean(points),
            price = mean(price),
            value = mean(value)) %>%
            arrange(desc(rating)) %>%
            head(10)

    }
)

#call bak for barchart
app$callback(
    output('bar', 'figure'),
    list(input('state', 'value')),
    function(selected_state) {
        data = data %>% filter(state %in% selected_state)
        # data for bar plot
        wine_data <- data %>%
            group_by(variety) %>%
            summarize(rating = mean(points),
            price = mean(price),
            value = mean(value)) %>%
            arrange(desc(rating)) %>%
            head(10) %>%
            mutate(highlight_flag = ifelse(rating == max(rating), T, F))

        bar_plot <- ggplot(wine_data, aes(x=reorder(variety, -rating),
                                     rating, fill= variety)) +
                    geom_bar(stat='identity', show.legend = FALSE) +
                    scale_y_continuous(limits = c(min(wine_data$rating),
                                        max(wine_data$rating)),
                                        oob=rescale_none) +
                    xlab("Wine Variety") +
                    ylab("Rating") +
                    ggtitle(paste0("Rating", ' by ', "Wine Variety")) +
                    theme_bw() +
                    ggthemes::scale_fill_tableau() +
                    theme(axis.text.x = element_text(angle=60, hjust=1),
                    legend.position = 'none',
                    panel.grid.major = element_blank())

        scatter_plot <- ggplot(wine_data) +
                    aes(x = price,
                        y = value,
                        color = variety) +
                    geom_point(size = 2) +
                    ggthemes::scale_color_tableau()
                    #ggplotly(p, tooltip = 'variety') %>% layout(dragmode = 'select')

        subplot(ggplotly(bar_plot), ggplotly(scatter_plot), nrows = 1) %>% layout(dragmode = 'select')

        #ggplotly(new_plot, tooltip = 'rating') %>% layout(dragmode = 'select')
    }
)

app$run_server(debug = T)