############################################################
# For macaque paper, 08.19
# Makes de novo SV vs. paternal age plots
# Gregg Thomas
############################################################

this.dir <- dirname(parent.frame(2)$ofile)
setwd(this.dir)

library(ggplot2)
library(reshape2)
library(plyr)
library(ggpubr)
library(cowplot)

source("../lib/read_svs.r")
source("../lib/filter_svs.r")
source("../lib/subset_svs.r")
source("../lib/design.r")

cat("----------\n")

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

savefiles = T
color_plots = T
supp = F
rm_alus = T
# Run options

minlen = F
maxlen = 100000
# CNV length cutoffs

sv_list = readSVs()
sv_list = filterSVs(sv_list, minlen, maxlen)
mq_events = sv_list[[1]]; hu_events = sv_list[[2]];
# Read and filter data

if(rm_alus){
  hu_events = subset(hu_events, Length < 275 | Length > 325)
  mq_events = subset(mq_events, Length < 275 | Length > 325)
}
# For Alu stuff

cat("----------\nSubsetting macaque data...\n")
mqr = subsetSVs(mq_events)
mq_events = mqr[[1]];

cat("----------\nSubsetting human data...\n")
hur = subsetSVs(hu_events)
hu_events = hur[[1]];
# Subset data

######################
# Macaque de novos

cat("Counting denovos in macaques...\n")
f1s = c(39243,39317,39313,39242,39226,39230,39234,39316,39227,39231,39318,39314,39229,39319)
# A vector of the focal individuals

mq_denovo = subset(mq_events, Denovo=="Y")
mq_denovo_counts = count(mq_denovo, vars="Individual")
mq_denovo = merge(mq_denovo, mq_denovo_counts, by="Individual")
mq_denovo_counts = ddply(mq_denovo, .(Individual), summarize,
                  Num.dsv=mean(freq),
                  Maternal.age=mean(Maternal.age),
                  Paternal.age=mean(Paternal.age))
# Get the de novos.

cat(" -> Adding F1s with no denovos...\n")
for(ind in f1s){
  if(!ind %in% mq_denovo_counts$Individual){
    cur_mat = mq_events$Maternal.age[mq_events$Individual==ind][1]
    cur_pat = mq_events$Paternal.age[mq_events$Individual==ind][1]
    cur_row = data.frame("Individual"=ind, "Num.dsv"=0, "Maternal.age"=cur_mat, "Paternal.age"=cur_pat)
    mq_denovo_counts = rbind(mq_denovo_counts,cur_row)
  }
}
# Adding the trios with 0 counts back into the frame

cat(" -> Correlating age with denovos...\n")
pat_fit = lm(mq_denovo_counts$Num.dsv ~ mq_denovo_counts$Paternal.age)
mat_fit = lm(mq_denovo_counts$Num.dsv ~ mq_denovo_counts$Maternal.age)

mq_denovo_counts$Species = "Macaque"
mq_denovo_counts$Species = factor(mq_denovo_counts$Species, levels=c("Macaque", "Human"))

cat(" -> Plotting denovos...\n")
fig3a = ggplot(mq_denovo_counts, aes(Paternal.age, Num.dsv, color=Species)) +
  geom_point(size=3, alpha=0.5) +
  #geom_smooth(method="glm", method.args=list(family='poisson'), fullrange=T, size=0.75, linetype="dashed", alpha=0) +
  geom_smooth(method="glm", fullrange=T, size=0.75, linetype="dashed", alpha=0) +
  ggtitle("") +
  scale_y_continuous(limits=c(0, 5)) +
  labs(x="Paternal age (years)", y="# de novo CNVs") +
  bartheme()
if(color_plots){
  fig3a = fig3a + scale_color_manual(name="", values=c('#490092','#920000'), labels=c("Macaque","Human"), drop=FALSE)
}else{
  fig3a = fig3a + scale_color_grey(name="", labels=c("Macaque","Human"), drop=FALSE) +
    ggtitle("Macaque") +
    theme(plot.margin = unit(c(1,1,1,1), "cm"))
}
print(fig3a)
# Macaque de novo plot

mq_rate = mean(mq_denovo_counts$Num.dsv / 2)
mq_se = ((sd(mq_denovo_counts$Num.dsv) / 2) / sqrt(length(mq_denovo_counts$Individual))) * 1.96
cat(" -> Macaque CNV rate per haploid generation: ", mq_rate, " (95% CI +/-", mq_se, ")\n", sep="")
# Macaque rate per haploid generation

cat(" -> Macaque CNV paternal age correlation: r2 = ", summary(pat_fit)$r.squared, ", df = ", summary(pat_fit)$df[2], ", p = ", summary(pat_fit)$coefficients[2,4], "\n", sep="")
# Paternal age regression

# Macaque de novos
######################

######################
# Human de novos (Brandler's count)
cat("Reading Brandler data...\n")
brandler_svs = read.csv("../cnv-calls/brandler-denovo.csv", header=TRUE)
brandler_info = read.csv("../sample-info/brandler-samples-raw.csv", header=TRUE)
names(brandler_info)[2] = "ID"
brandler_info = subset(brandler_info, Relationship=="Proband" | Relationship=="Sibling")
brandler_svs$SVLEN = as.numeric(brandler_svs$SVLEN)
# Have to read the Brandler files

if(rm_alus){
  brandler_svs = subset(brandler_svs, SVLEN < 275 | SVLEN > 325)
}
# For Alu stuff

brandler_svs = subset(brandler_svs, SVTYPE %in% c("DEL","DUP"))
if(supp){
  brandler_svs = subset(brandler_svs, VALIDATION == 1)
}

brandler_counts = count(brandler_svs, vars="ID")
brandler_svs = merge(brandler_svs, brandler_counts, by="ID")

brandler_counts = merge(brandler_counts, brandler_info[, c("ID", "Mother_chrono_age")], by="ID")
brandler_counts = merge(brandler_counts, brandler_info[, c("ID", "Father_chrono_age")], by="ID")
names(brandler_counts)[2] = "Num.dsv"

for(ind in brandler_info$ID){
  if(!ind %in% brandler_counts$ID){
    cur_mat = brandler_info$Mother_chrono_age[brandler_info$ID==ind][1]
    cur_pat = brandler_info$Father_chrono_age[brandler_info$ID==ind][1]
    cur_row = data.frame("ID"=ind, "Num.dsv"=0, "Mother_chrono_age"=cur_mat, "Father_chrono_age"=cur_pat)
    brandler_counts = rbind(brandler_counts,cur_row)
  }
}
# Adding the trios with 0 counts back into the frame

brandler_counts$Mother_chrono_age = brandler_counts$Mother_chrono_age / 12
brandler_counts$Father_chrono_age = brandler_counts$Father_chrono_age / 12

cat(" -> Correlating age with denovos...\n")
pat_fit_h = lm(brandler_counts$Num.dsv ~ brandler_counts$Father_chrono_age)
mat_fit_h = lm(brandler_counts$Num.dsv ~ brandler_counts$Mother_chrono_age)

cat(" -> Plotting human denovos...\n")
fig3b = ggplot(brandler_counts, aes(Father_chrono_age, Num.dsv, color="Human")) +
  geom_point(size=3, alpha=0.5) +
  #geom_smooth(method="glm", method.args=list(family='poisson'), fullrange=T, size=0.75, linetype="dashed", alpha=0) +
  geom_smooth(method="glm", fullrange=T, size=0.75, linetype="dashed", alpha=0) +
  ggtitle("") +
  scale_y_continuous(limits=c(0, 5)) +
  labs(x="Paternal age (years)", y="") +
  bartheme()
if(color_plots){
  fig3b = fig3b + scale_color_manual(name="", breaks=c("Macaque","Human"), values=c("Macaque"='#490092',"Human"='#920000'), drop=FALSE)
}else{
  fig3b = fig3b + scale_color_grey(name="", labels=c("Macaque","Human"), drop=FALSE) +
    ggtitle("Human") +
    theme(plot.margin = unit(c(1,1,1,1), "cm"))
}
print(fig3b)

hu_rate = mean(brandler_counts$Num.dsv / 2)
hu_se = ((sd(brandler_counts$Num.dsv) / 2) / sqrt(length(brandler_counts$ID))) * 1.96
cat(" -> Human CNV rate per haploid generation: ", hu_rate, " (95% CI +/-", hu_se, ")\n", sep="")
# Macaque rate per haploid generation

cat(" -> Human CNV paternal age correlation: r2 = ", summary(pat_fit_h)$r.squared, ", df = ", summary(pat_fit_h)$df[2], ", p = ", summary(pat_fit_h)$coefficients[2,4], "\n", sep="")
# Paternal age regression

# Human de novos (Brandler's count)
######################

######################
# Combine plots for figure
cat("Combining plots...\n")
prow = plot_grid(fig3a + theme(legend.position="none"),
                 fig3b + theme(legend.position="none"),
                 align = 'vh',
                 labels = c("A", "B"),
                 label_size = 24,
                 hjust = -1,
                 nrow = 1)

legend_b = get_legend(fig3a + theme(legend.direction="horizontal", legend.justification="center", legend.box.just="bottom"))
# Extract the legend from one of the plots

if(color_plots){
  p = plot_grid(prow, legend_b, ncol=1, rel_heights=c(1, 0.1))
}else{
  p = prow
}
# For color plots: Add the legend underneath the row we made earlier with 10% of the height of the row
# Otherwise, don't add

print(p)

if(savefiles){
  outfile = "fig3"
  if(supp){
    outfile = paste(outfile, "_S7", sep="")
  }
  if(!color_plots){
    outfile = paste(outfile, "-grey", sep="")
  }
  outfile = paste(outfile, ".png", sep="")
  cat(" -> Outfile: ", outfile, "\n")
  ggsave(filename=outfile, p, width=10, height=5, units="in")
}
# Save the figure
######################


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

library(ggplot2)
library(xtable)
library(plyr)
library(dplyr)
library(tidyr)
library(readr)
library(kableExtra)
source('./_sequential_mnist_expand_name.r')

best.range = 5

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

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

safe.quantile = function (vec, prop) {
  if (length(vec) <= 1) {
    return(NA)
  } else if (length(vec) <= 3) {
    return(ifelse(prop < 0.5, min(vec), max(vec)))
  } else {
    return(median(vec, prop))
  }
}

eps = read_csv('../results/sequential_mnist_mse_expectation.csv') %>%
  mutate(
    epsilon = mse
  ) %>%
  select(operation, extrapolation.length, epsilon)

dat = expand.name(read_csv('../results/sequential_mnist_sum.csv')) %>%
  gather(
    key="extrapolation.length", value="extrapolation.error",
    loss.valid.extrapolation.1, loss.valid.extrapolation.10, loss.valid.extrapolation.100, loss.valid.extrapolation.1000
  ) %>%
  mutate(
    validation=loss.valid.validation,
    mnist=loss.valid.mnist_classification,
    extrapolation.length=as.integer(substring(extrapolation.length, 26))
  ) %>%
  merge(eps)

dat.last = dat %>%
  group_by(name, extrapolation.length) %>%
  summarise(
    epsilon = last(epsilon),
    best.model.step = best.model.step.fn(validation),

    validation.last = validation[best.model.step],
    mnist.last = mnist[best.model.step],
    extrapolation.error.last = extrapolation.error[best.model.step],

    extrapolation.step.solved = first.solved.step(step, extrapolation.error, epsilon),

    sparse.error.max = sparse.error.max[best.model.step],
    sparse.error.mean = sparse.error.sum[best.model.step] / sparse.error.count[best.model.step],

    solved = replace_na(extrapolation.error[best.model.step] < epsilon, FALSE),
    model = last(model),
    operation = last(operation),
    seed = last(seed),
    size = n()
  )

dat.last.rate = dat.last %>%
  group_by(model, operation, extrapolation.length) %>%
  summarise(
    size=n(),
    success.rate.mean = mean(solved),
    success.rate.upper = NA,
    success.rate.lower = NA,

    converged.at.mean = mean(extrapolation.step.solved[solved]),
    converged.at.upper = safe.quantile(extrapolation.step.solved[solved], 0.9),
    converged.at.lower = safe.quantile(extrapolation.step.solved[solved], 0.1),

    sparse.error.mean = mean(sparse.error.max[solved]),
    sparse.error.upper = safe.quantile(sparse.error.max[solved], 0.9),
    sparse.error.lower = safe.quantile(sparse.error.max[solved], 0.1)
  )

dat.gather.mean = dat.last.rate %>%
  mutate(
    success.rate = success.rate.mean,
    converged.at = converged.at.mean,
    sparse.error = sparse.error.mean
  ) %>%
  select(model, operation, extrapolation.length, success.rate, converged.at, sparse.error) %>%
  gather('key', 'mean.value', success.rate, converged.at, sparse.error)

dat.gather.upper = dat.last.rate %>%
  mutate(
    success.rate = success.rate.upper,
    converged.at = converged.at.upper,
    sparse.error = sparse.error.upper
  ) %>%
  select(model, operation, extrapolation.length, success.rate, converged.at, sparse.error) %>%
  gather('key', 'upper.value', success.rate, converged.at, sparse.error)

dat.gather.lower = dat.last.rate %>%
  mutate(
    success.rate = success.rate.lower,
    converged.at = converged.at.lower,
    sparse.error = sparse.error.lower
  ) %>%
  select(model, operation, extrapolation.length, success.rate, converged.at, sparse.error) %>%
  gather('key', 'lower.value', success.rate, converged.at, sparse.error)

dat.gather = merge(merge(dat.gather.mean, dat.gather.upper), dat.gather.lower) %>%
  mutate(
    model=droplevels(model),
    key = factor(key, levels = c("success.rate", "converged.at", "sparse.error"))
  )

p = ggplot(dat.gather, aes(x = extrapolation.length, colour=model)) +
  geom_point(aes(y = mean.value)) +
  geom_line(aes(y = mean.value)) +
  geom_errorbar(aes(ymin = lower.value, ymax = upper.value), width = 0.5) +
  scale_color_discrete(labels = model.to.exp(levels(dat.gather$model))) +
  scale_x_continuous(name = 'Extrapolation length', trans='log10', breaks=unique(dat.gather$extrapolation.length)) +
  scale_y_continuous(name = element_blank(), limits=c(0,NA)) +
  facet_wrap(~ key, scales='free_y', labeller = labeller(
    key = c(
      success.rate = "Success rate",
      converged.at = "Converged at",
      sparse.error = "Sparsity error"
    )
  )) +
  theme(legend.position="bottom") +
  theme(plot.margin=unit(c(5.5, 10.5, 5.5, 5.5), "points"))
print(p)
ggsave('../paper/results/sequential_mnist_sum.pdf', p, device="pdf", width = 13.968, height = 5, scale=1.4, units = "cm")


\name{hc_normal_points-HilbertCurve-method}
\alias{hc_normal_points,HilbertCurve-method}
\alias{hc_normal_points}
\title{
Add points to the Hilbert curve
}
\description{
Add points to the Hilbert curve
}
\usage{
\S4method{hc_normal_points}{HilbertCurve}(object, ir = NULL, x1 = NULL, x2 = x1, gp = gpar(),
    pch = 1, size = unit(1, "char"))
}
\arguments{

  \item{object}{A \code{\link{HilbertCurve-class}} object.}
  \item{ir}{an \code{\link[IRanges:IRanges-constructor]{IRanges}} object which specifies the input intervals.}
  \item{x1}{if start positions are not integers, they can be set by \code{x1}.}
  \item{x2}{if end positions are not integers, they can be set by \code{x2}.}
  \item{size}{size of the points. It should be a \code{\link[grid]{unit}} object, pass to \code{\link[grid]{grid.points}}.}
  \item{pch}{shape of points, pass to \code{\link[grid]{grid.points}}.}
  \item{gp}{graphic parameters for points. It should be specified by \code{\link[grid]{gpar}}.}

}
\details{
Points are added at the middle of the intervals in \code{ir} (or \code{x1} and \code{x2}),
so there is only one point for each interval.

This function is used internally. Please use \code{\link{hc_points,HilbertCurve-method}} instead.
}
\value{
A data frame which contains coordinates (in the 2D space) of points.
}
\seealso{
\code{\link{hc_points,HilbertCurve-method}}
}
\author{
Zuguang Gu <z.gu@dkfz.de>
}
\examples{
# see documentation of hc_points
NULL
}


## rankhospital ##
rankhospital <- function(state, outcome, num = "best") {
        ## Read outcome data
        df <- read.csv("outcome-of-care-measures.csv", colClasses = "character")

        ## Check that state and outcome are valid
        # Get the unique list of state and outcomes
        states <- unique(df$State)
        outcomeList <- list("heart attack", "heart failure", "pneumonia")

        ## check that state is valid or not
        if(!(state %in% states)){
          stop("invalid state")
        }
        ## check that outcome is valid or not
        if(!(outcome %in% outcomeList)) {
                stop("invalid outcome")
        }

        # Exclude the other states data
        maindf <- subset(df, df$State ==  state)

        if(is.numeric(num) && num > nrow(maindf)) {
                return(NA);
        }

        outcomeColumn = c("Hospital.Name")

        if(outcome == "heart attack") {
                stringRow = "Hospital.30.Day.Death..Mortality..Rates.from.Heart.Attack";
                outcomeColumn = c(outcomeColumn, stringRow)
                numericRow = 11
        } else if(outcome == "heart failure")  {
                stringRow = "Hospital.30.Day.Death..Mortality..Rates.from.Heart.Failure";
                outcomeColumn = c(outcomeColumn, stringRow)
                numericRow = 17
        } else if (outcome == "pneumonia") {
                stringRow = "Hospital.30.Day.Death..Mortality..Rates.from.Pneumonia";
                outcomeColumn = c(outcomeColumn, stringRow)
                numericRow  = 23
        } else {
                stop("invalid outcome")
        }

        maindf <- maindf[outcomeColumn]

        suppressWarnings(maindf[, c(stringRow)] <- sapply(maindf[, c(stringRow)], as.numeric))

        maindf <- subset(maindf, is.na(maindf[[stringRow]]) == FALSE)
        #print(maindf)

        if(num == "best") {
          oneHospital <- maindf[which.min(maindf[[stringRow]]), ]
          return(oneHospital$Hospital.Name)
        } else if(num == "worst") {
          oneHospital <- maindf[which.max(maindf[[stringRow]]), ]
          return(oneHospital$Hospital.Name)
        } else if(is.numeric(num)) {
          #print(class(maindf))
          #stop('hre')
          df <- maindf[order(maindf[[stringRow]], maindf$Hospital.Name),]
          return(as.character(df[num,]$Hospital.Name))
        } else {
          stop('invalid num')
        }
}


variable <- function(x) {
  UseMethod("variable", x)
}

variable.logical <- function (x) {
  x <- as.logical (x)

  levels <- c(FALSE, TRUE)

  obs <- sort(unique(x[!is.na(x)]))

  object <- list(levels = levels, obs = obs)
  class(object) <- c("vlogical", "categorical", "variable")

  return (object)
}

variable.integer <- function (x) {
  x <- as.integer(x)

  obs <- sort(unique(x[!is.na(x)]))

  mean <- as.integer(round(mean(x, na.rm = TRUE)))
  sd <- sd(x, na.rm = TRUE)

  object <- list(mean = mean, sd = sd, obs = obs)
  class(object) <- c("vinteger", "continuous", "variable")

  return (object)
}

variable.numeric <- function (x) {
    x <- as.numeric(x)

    obs <- sort(unique(x[!is.na(x)]))

    mean <- mean(x, na.rm = TRUE)
    sd <- sd(x, na.rm = TRUE)

    object <- list(mean = mean, sd = sd, obs = obs)
    class(object) <- c("vnumeric", "continuous", "variable")

    return (object)
}

variable.character <- function (x) {
    x <- as.factor (x)
    variable(x)
}

variable.factor <- function (x) {
    x <- as.factor (x)

    levels <- factor(levels(x), levels = levels(x))

    obs <- levels[levels %in% x]

    object <- list(levels = levels, obs = obs)
    class(object) <- c("vfactor", "categorical", "variable")

    return (object)
}

variable.Date <- function (x) {
  x <- as.Date (x)

  obs <- sort(unique(x[!is.na(x)]))

  mean <- mean(x, na.rm = TRUE)
  sd <- sd(x, na.rm = TRUE)

  object <- list(mean = mean, sd = sd, obs = obs)
  class(object) <- c("vdate", "continuous", "variable")

  return (object)
}

variable.POSIXt <- function (x) {
  x <- as.POSIXct (x)

  obs <- sort(unique(x[!is.na(x)]))

  mean <- mean(x, na.rm = TRUE)
  sd <- sd(x, na.rm = TRUE)

  object <- list(mean = mean, sd = sd, obs = obs)
  class(object) <- c("vposixt", "continuous", "variable")

  return (object)
}

variable.matrix <- function (x) {

  smode <- storage.mode(x)
  ndim <- 2

  obs <- sort(unique(x[!is.na(x)]))

  if (smode == "logical") {

    levels <- c(FALSE, TRUE)

    object <- list(levels = levels, obs = obs, ndim = ndim)
    class(object)<-c("mlogical", "categorical", "variable")
  } else if (smode == "integer") {

    mean <- as.integer(round(mean(x, na.rm = TRUE)))
    sd <- sd(x, na.rm = TRUE)

    object <- list(mean = mean, sd = sd, obs = obs, ndim = ndim)
    class(object) <- c("minteger", "continuous", "variable")
  } else if (smode == "double") {

    mean <- mean(x, na.rm = TRUE)
    sd <- sd(x, na.rm = TRUE)

    object <- list(mean = mean, sd = sd, obs = obs, ndim = ndim)
    class(object) <- c("mdouble", "continuous", "variable")
  } else
    stop(paste("storage mode", smode, "not recognised"))

  return (object)
}

variable.array <- function (x) {

  smode <- storage.mode(x)
  ndim <- length(dim(x))

  obs <- sort(unique(x[!is.na(x)]))

  if (smode == "logical") {

    levels <- c(FALSE, TRUE)

    object <- list(levels = levels, obs = obs, ndim = ndim)
    class(object)<-c("alogical", "categorical", "variable")
  } else if (smode == "integer") {

    mean <- as.integer(round(mean(x, na.rm = TRUE)))
    sd <- sd(x, na.rm = TRUE)

    object <- list(mean = mean, sd = sd, obs = obs, ndim = ndim)
    class(object) <- c("ainteger", "continuous", "variable")
  } else if (smode == "double") {

    mean <- mean(x, na.rm = TRUE)
    sd <- sd(x, na.rm = TRUE)

    object <- list(mean = mean, sd = sd, obs = obs, ndim = ndim)
    class(object) <- c("adouble", "continuous", "variable")
  } else
    stop(paste("storage mode", smode, "not recognised"))

  return (object)
}


#this script explore the conaminant in the rnaseq data, the result from FASTQ screen

setwd("Desktop/RNAseq_microbiome/")
result_fastq_screen <- read.table("mqc_fastq_screen-1_1.txt", header = T, row.names = 1)
str(result_fastq_screen)
summary(result_fastq_screen)
colSums(result_fastq_screen)
#in percentage
#round(df/rowSums(df), 2)
result_fastq_screen_percent <- round(result_fastq_screen/rowSums(result_fastq_screen),2)
#without the gutsamples (2x6 last samples)
result_fastq_screen_percent_abd <- result_fastq_screen_percent[1:130,]
summary(result_fastq_screen_percent_abd)


pdf_file<-"pdf/barcharts_multiple_all_2.pdf"
cairo_pdf(bg="grey98", pdf_file, width=13,height=10.5)

par(omi=c(0.25,0.75,1,0.75),mai=c(1.8,3.75,0.25,0),lheight=1.15,family="Lato Light",las=1)
library(RColorBrewer)

# Import data and prepare chart

source("scripts/inc_labels_za4753.r",encoding="UTF-8")
source("scripts/inc_data_za4753.r",encoding="UTF-8")

myC1<-rgb(0,208,226,maxColorValue=255)
myC2<-rgb(109,221,225,maxColorValue=255)
myC3<-rgb(255,138,238,maxColorValue=255)
myC4<-rgb(255,0,210,maxColorValue=255)
colours<-c("grey",myC1,myC2,myC3,myC4)

myData0<-cbind(z[,1]+z[,2],z[,3],z[,4],z[,5],z[,6])
myData1<-t(myData0)

# Create chart

barplot(-rep(100,7),names.arg=mynames,cex.names=1.1,horiz=T, border=par("bg"),xlim=c(-100,70),col=colours[1],axes=F)
barplot(-(100-myData1[1,]),names.arg=mynames,cex.names=1.1,horiz=T, border=par("bg"),xlim=c(-100,70),col=par("bg"),axes=F,add=T)
barplot(-myData1[3:2,],names.arg=mynames,cex.names=1.1,horiz=T, border=NA,xlim=c(-100,70),col=colours[3:2],axes=F,add=T)
barplot(myData1[4:5,],names.arg=mynames,cex.names=1.1,horiz=T, border=NA,xlim=c(-100,70),col=colours[4:5],axes=F,add=T)

# Other elements

arrows(0,-0.1,0,8.6,lwd=2.5,length=0,xpd=T,col="skyblue3")
px<-c(-98,-87,-41,15,65); tx<-c(-105,-60,-26,8,60); y<-rep(-1,5)
points(px,y,pch=15,cex=4,col=colours,xpd=T)
text(tx,y,myresponses,adj=1,xpd=T,font=3)
mtext(c(80,60,40,20,0,20,40,60),at=c(-80,-60,-40,-20,0,20,40,60),1,line=0,cex=0.95)

# Titling

mtext("It is often said that attitudes towards gender roles are changing",3,line=2.2,adj=0,cex=1.8,outer=T,family="Lato Black")
mtext("All values in percent",3,line=1,adj=1,cex=0.95,font=3)
mtext("Source: European Values Study 2008 Germany, ZA4753. www.gesis.org. Design: Stefan Fichtel, ixtract",1,line=5.2,adj=1,cex=0.95,font=3)
mtext("N=2,075",3,line=1,adj=0,cex=1.15,family="Lato",font=3)
dev.off()


rm(list=ls())

rootdir <- "~/Dropbox"
wd <- paste(rootdir, "data/elecs/MXelsCalendGovt/censos/munic/2010", sep="/")
setwd(wd)
# datos Valle-Jones
dd <- paste(rootdir, "data/mapas/seccionesIfe/2013secciones/download-maps12-master/ife", sep="/")

# section-level population filenames
files <- c(
"01Aguascalientes/01poblacion_seccion.csv",
"02BajaCalifornia/02poblacion_seccion.csv",
"03BajaCaliforniaSur/03poblacion_seccion.csv",
"04Campeche/04poblacion_seccion.csv",
"05Coahuila/05poblacion_seccion.csv",
"06Colima/06poblacion_seccion.csv",
"07Chiapas/07poblacion_seccion.csv",
"08Chihuahua/08poblacion_seccion.csv",
"09DistritoFederal/09poblacion_seccion.csv",
"10Durango/10poblacion_seccion.csv",
"11Guanajuato/11poblacion_seccion.csv",
"12Guerrero/12poblacion_seccion.csv",
"13Hidalgo/13poblacion_seccion.csv",
"14Jalisco/14poblacion_seccion.csv",
"15Mexico/15poblacion_seccion.csv",
"16Michoacan/16poblacion_seccion.csv",
"17Morelos/17poblacion_seccion.csv",
"18Nayarit/18poblacion_seccion.csv",
"19NuevoLeon/19poblacion_seccion.csv",
"20Oaxaca/20poblacion_seccion.csv",
"21Puebla/21poblacion_seccion.csv",
"22Queretaro/22poblacion_seccion.csv",
"23QuintanaRoo/23poblacion_seccion.csv",
"24SanLuisPotosi/24poblacion_seccion.csv",
"25Sinaloa/25poblacion_seccion.csv",
"26Sonora/26poblacion_seccion.csv",
"27Tabasco/27poblacion_seccion.csv",
"28Tamaulipas/28poblacion_seccion.csv",
"29Tlaxcala/29poblacion_seccion.csv",
"30Veracruz/30poblacion_seccion.csv",
"31Yucatan/31poblacion_seccion.csv",
"32Zacatecas/32poblacion_seccion.csv"
    )

# read aguascalientes and prepare data frame
tmp <- read.csv(file=paste(dd, files[1], sep="/"))
dat <- data.frame(edon=tmp$Entidad, munn=tmp$Municipio, secn=tmp$Seccion, ptot=tmp$Pob_tot, mun=tmp$Nom_mun)
# read remainder states
for (i in 2:32){
    tmp <- read.csv(file=paste(dd, files[i], sep="/"));
    dat <- rbind( dat, data.frame(edon=tmp$Entidad, munn=tmp$Municipio, secn=tmp$Seccion, ptot=tmp$Pob_tot, mun=tmp$Nom_mun) );
}
rm(tmp)

# agregate municipios
dat <- dat[order(dat$edon, dat$munn, dat$secn),]
dat$clave <- dat$edon*1000 + dat$munn
# así se hace en R un by yr mo: egen tmp=sum(invested) de stata
dat$ptota <- ave(dat$ptot, as.factor(dat$clave), FUN=sum, na.rm=TRUE)
dat$ptot <- NULL
colnames(dat) <- c("edon",  "munn",  "secn",  "mun",   "clave", "ptot")

dat <- dat[duplicated(dat$clave)==FALSE,]

table(dat$edon))

dim(dat)
head(dat)

data.frame(munn=dat$munn[dat$edon==30], mun=dat$mun[dat$edon==30], ptot=dat$ptot[dat$edon==30])


# ================================================================ #
# |             *** Implementation of CV
# | 1. Sequential implementation
# |    1.a local shrinkage
# |    1.b global shrinkage
# | 2. Distributed/Parallel implementation for global shrinkage
# ================================================================ #
library(lars) #, lib="/home/dabid/R/x86_64-unknown-linux-gnu-library/3.2/")

# ================================================================ #
# |                **** Helper functions ****                    | #
# ================================================================ #
lars.multi <- function(tdata,rdata,pert,prior,allowed)
{
  lars.paths <- list()
  targets <- seq(dim(tdata)[1])

  cat("Building path for target: ")
  for (i in targets)
  {
    cat(i,"")
    mindices <- which(pert[i,]==0)

    x <- rdata[,mindices] * prior[,i]
    x[which(allowed[,i]==0),]<-0;

    ##### YK patch 05-23-2017
    # results.lars <- lars(t(x),tdata[i,mindices],trace=FALSE,max.steps=600,type="lasso",normalize=FALSE,intercept=TRUE,use.Gram=FALSE);
    y <- tdata[i,mindices];
    results.lars.flag <- TRUE;
    sample.indx <- length(y);
    while (results.lars.flag) {
      results.lars <- try(lars(t(x[,1:sample.indx]),y[1:sample.indx],trace=FALSE,max.steps=600,type="lasso",normalize=FALSE,intercept=TRUE,use.Gram=FALSE));
      results.lars.flag <- class(results.lars) =='try-error';
      if (results.lars.flag) { cat(' *no soln* '); }
      sample.indx <- sample.indx-1;
    }
    #####
    #lars.paths[[i]] <- list(beta=results.lars$beta, mu=results.lars$mu, meanx=results.lars$meanx, C.Max=c(results.lars$C.Max,0))
    lars.paths[[i]] <- list(beta=results.lars$beta, mu=results.lars$mu, meanx=results.lars$meanx, C.Max=c(results.lars$lambda,0))  # for support in lars 1.2
  }
  cat("\n")

  cat("Building combined C.Max ranking\n")
  all.C.lars <- c()
  for (i in targets)
  {
    all.C.lars <- rbind(all.C.lars, cbind(lars.paths[[i]]$C.Max,rep(i,times=length(lars.paths[[i]]$C.Max)),1:length(lars.paths[[i]]$C.Max)))
  }
  R <- all.C.lars[sort.list(all.C.lars[,1],decreasing=TRUE),]
  lars.paths$R <- R
  lars.paths$targets <- targets
  lars.paths
}

# ================================================================ #
# |             **** END Helper functions ****                   | #
# ================================================================ #

# ================================================================ #
# |          **** Lochal Shrinkage functions ****                | #
# ================================================================ #

# ================================================================ #
# |          **** END Lochal Shrinkage functions ****            | #
# ================================================================ #
lars.multi.optimize <- function(tdata,rdata,pert,prior,allowed)
{
	cat(as.character(Sys.time()),"\n")
	lars.paths.cv <- lars.multi.cv(tdata,rdata,pert,prior,allowed,10)

	lars.paths <- lars.multi(tdata,rdata,pert,prior,allowed)
	B <- lars.multi.path.step(lars.paths,lars.paths.cv[[2]])

	B.adj <- matrix(0,nrow=dim(rdata)[1],ncol=dim(tdata)[1])

	for (i in seq(dim(tdata)[1]))
	{
		#Scale B.adj according to prior
		B.adj[,i] <- B[[i]] * prior[,i]
	}
	rval <- list()
	rval[[1]] <- B.adj
	rval[[2]] <- lars.paths
	rval[[3]] <- lars.paths.cv
	cat(as.character(Sys.time()),"\n")
	rval
}

lars.multi.cv <- function(tdata,rdata,pert,prior,allowed,fold)
{
	all.folds <- cv.folds(dim(tdata)[2], fold)
	lars.cv.paths <- list()
	cMax <- 0;
	for (f in 1:fold)
	{
		cat("Building path for cv",f,"of",fold,"\n")
		omit <- all.folds[[f]]
		lars.cv.paths[[f]] <- lars.multi(tdata[,-omit], rdata[,-omit], pert[,-omit],prior,allowed)
		if (lars.cv.paths[[f]]$R[1,1]>cMax)
		{
			cMax <- lars.cv.paths[[f]]$R[1,1]
		}

	}

	cSteps <- c()
	mse <- c()
	bnorm <- c()

	converged <- FALSE
	P <- c(cMax/10,0)
	FP <- c(lars.multi.cv.eval(P[1],fold,lars.cv.paths,all.folds,tdata,rdata,pert,prior,allowed),lars.multi.cv.eval(P[2],fold,lars.cv.paths,all.folds,tdata,rdata,pert,prior,allowed))

	while (!converged)
	{
		Imin <- which.min(FP)
		Imax <- which.max(FP)
		if (Imin==Imax)
			converged=TRUE

		cat("P:",P,"F(P):",FP,"Max/Min",Imax,Imin,"\n")
		Phat <- P[Imin]
		Pref <- 2*Phat - P[Imax]

		if (Pref>cMax)
			FPref <- max(FP) + (Pref-cMax)^2
		else if (Pref<0)
			FPref <- max(FP) + Pref^2
		else
			FPref <- lars.multi.cv.eval(Pref,fold,lars.cv.paths,all.folds,tdata,rdata,pert,prior,allowed)

			if (FPref < FP[Imin])
			{
				#Attempt expansion
				Pexp <- 2*Pref - Phat
				FPexp <- lars.multi.cv.eval(Pexp,fold,lars.cv.paths,all.folds,tdata,rdata,pert,prior,allowed)
				if (FPexp < FPref) #Expand
				{
					cat("Expand\n")
					P[Imax] <- Pexp
					FP[Imax] <- FPexp
				}
				else #Reflect
				{
					cat("Reflect\n")
					P[Imax] <- Pref
					FP[Imax] <- FPref
				}
			}
			else
			{
				#Contract
				if (FP[Imax] < FPref)
				{
					cat("Contract (1)\n")
					P[Imax] <- (P[Imax] + Phat)/2
					FP[Imax] <- lars.multi.cv.eval(P[Imax],fold,lars.cv.paths,all.folds,tdata,rdata,pert,prior,allowed)
				}
				else
				{
					cat("Contract (2)\n")
					P[Imax] <- (Pref + Phat)/2
					FP[Imax] <- lars.multi.cv.eval(P[Imax],fold,lars.cv.paths,all.folds,tdata,rdata,pert,prior,allowed)
				}
			}
	}
	rval <- list()
	rval[[1]] <- lars.cv.paths
	rval[[2]] <- P[which.min(FP)]
	rval[[3]] <- min(FP)
	rval[[4]] <- all.folds
	rval
}

lars.multi.cv.eval <- function(cVal,fold,lars.cv.paths,all.folds,tdata,rdata,pert,prior,allowed,targets=NULL)
{
		if (is.null(targets))
			targets <- seq(dim(tdata)[1])
		mse <- rep(0,times=fold)
		for (f in 1:fold)
		{
			B <- lars.multi.path.step(lars.cv.paths[[f]],cVal)
			for (i in targets)
			{
				omit <- all.folds[[f]]
				omit <- setdiff(omit,which(pert[i,]!=0))

				testx <- rdata[,omit]
				testy <- tdata[i,omit]
				testx[which(allowed[,i]==0),] <- 0
				testx <- testx * prior[,i]

				testp <- scale(t(testx) , lars.cv.paths[[f]][[i]]$meanx, FALSE) %*% matrix(B[[i]]) + lars.cv.paths[[f]][[i]]$mu
				testr <- apply((testp - testy)^2,2,mean)
				mse[f] <- mse[f] + testr
			}
			mse[f] <- mse[f]/length(targets)
		}
		totalmse <- sum(mse) / fold
		totalmse
}

lars.multi.path.step <- function(lars.paths,stepC)
{
	k <- 1
	if (length(which(lars.paths$R[,1]>stepC))>0)
	{
		k<-max(which(lars.paths$R[,1]>stepC))
	}

	B <- list()
	A <- c()
	Ai <- unique(lars.paths$R[1:k,2])
	for (i in Ai)
	{
		A <- rbind(A,c(i,lars.paths$R[max(which(lars.paths$R[1:k,2]==i)),3]))
	}

	for (i in lars.paths$targets)
	{
		indx <- which(A[,1]==i)
		if (length(indx)==0)
		{
			B[[i]] <- rep(0,times=dim(lars.paths[[i]]$beta)[2])
		}
		else
		{
			plen <- dim(lars.paths[[i]]$beta)[1]
			if (A[indx,2]==plen)
			{
				B[[i]] <- lars.paths[[i]]$beta[plen,]
			}
			else
			{
				if ( lars.paths$R[k,1] < lars.paths[[i]]$C.Max[A[indx,2]+1] )
				{
					if (A[indx,2] < plen)
						A[indx,2] <- A[indx,2] + 1
				}
				gamma <- (lars.paths[[i]]$C.Max[A[indx,2]] - lars.paths$R[k,1]) / (lars.paths[[i]]$C.Max[A[indx,2]] - lars.paths[[i]]$C.Max[A[indx,2]+1])
				u <- (lars.paths[[i]]$beta[A[indx,2]+1,] - lars.paths[[i]]$beta[A[indx,2],])
				B[[i]] <- lars.paths[[i]]$beta[A[indx,2],] + u * gamma
			}
		}
	}
	B
}

###

lars.multi.cv.singlefold <- function(tdata,rdata,pert,prior,allowed,nbr_cv_fold,seed,f)
{
	set.seed(seed)
	all.folds <- cv.folds(dim(tdata)[2], nbr_cv_fold)
	cat("Building path for cv",f,"of",nbr_cv_fold,"\n")
	omit <- all.folds[[f]]
	lars.cv.paths <- lars.multi(tdata[,-omit], rdata[,-omit], pert[,-omit],prior,allowed)
	lars.cv.paths
}

lars.single.cv <- function(tdata,rdata,pert,prior,allowed,fold,seed)
{
	targets <- seq(dim(tdata)[1])
	lars.paths.cv <- list()
	lars.paths <- list()
	B <- matrix(0,nrow=dim(rdata)[1],ncol=dim(tdata))

	minFrac <- c()
  cat("Building path for target: ")
  for (i in targets)
  {
    cat(i,"")
    mindices <- which(pert[i,]==0)
    x <- rdata[,mindices] * prior[,i]
    x[which(allowed[,i]==0),]<-0;
    set.seed(seed)
    lars.paths.cv[[i]] <-  cv.lars(t(x),tdata[i,mindices],K=fold,plot.it=FALSE,trace=FALSE,max.steps=600,type="lasso",normalize=FALSE,intercept=TRUE,se=FALSE);
		minFrac[i] <- lars.paths.cv[[i]]$index[which.min(lars.paths.cv[[i]]$cv)]
		lars.paths[[i]] <- lars(t(x),tdata[i,mindices],trace=FALSE,max.steps=600,type="lasso",normalize=FALSE,intercept=TRUE);
		B[,i] <- predict(lars.paths[[i]],s=minFrac[i],type="coefficients",mode="fraction")$coefficients
  }
	cat("\n")
	B
}

lars.local <- function(tdata,rdata,pert,prior,allowed,skip_reg,skip_gen)
{
  cat(as.character(Sys.time()),"\n")
  B.adj <- matrix(0,nrow=dim(rdata)[1],ncol=dim(tdata)[1])

  cat("Working on Gene:")
	for(i in 1:dim(tdata)[1]) {
		if (skip_gen[i] == 0) {
		 	cat(i,",")
			mindices <- which(pert[i,]==0)
			x <- rdata[,mindices] * prior[,i]
			x[which(allowed[,i]==0),]<-0;
			nindices <- which(skip_reg==0)
			x <- x[nindices,]
			lars.paths.cv <-  cv.lars(t(x),tdata[i,mindices],K=3,trace=FALSE,max.steps=600,type="lasso",normalize=FALSE,intercept=TRUE,se=FALSE, plot.it=FALSE,use.Gram=FALSE);
			minFrac <- lars.paths.cv$index[which.min(lars.paths.cv$cv)]
			lars.paths <- lars(t(x),tdata[i,mindices],trace=FALSE,max.steps=600,type="lasso",normalize=FALSE,intercept=TRUE,use.Gram=FALSE);
			# lars.paths <- lars(t(x),tdata[i,mindices],trace=FALSE,max.steps=600,type="lasso",normalize=FALSE,intercept=TRUE,use.Gram=TRUE);
			tempVec <- predict(lars.paths,s=minFrac,type="coefficients",mode="fraction")$coefficients
			# tempVec <- lars.paths$beta
			# print(tempVec)
			nindices <- which(skip_reg==1)
      tempCol <- c(tempVec, rep(0,length(nindices)))
      tempIndices <- c(seq_along(tempVec), nindices+.5)
      B.adj[,i] <- tempCol[order(tempIndices)]
      #Scale B.adj according to prior
			B.adj[,i] <- B.adj[,i] * prior[,i]
		}
	}
	cat("\n")

	rval <- list()
  rval[[1]] <- B.adj
  rval
}

# ====================================================================== #
# |           **** Distributed/Parallel Implementation ****            | #
# ====================================================================== #

create_lasso_global_shrinkage_parallel = function(df_expr_target
                                                 , df_expr_reg
                                                 , df_allowed
                                                 , df_perturbed
                                                 , df_prior
                                                 , seed
                                                 , p_out_dir
                                                 , nbr_cv_fold
                                                 , p_src_code){
  library("Rmpi")
  mpi.spawn.Rslaves(nslaves = nbr_cv_fold)
  mpi.bcast.Robj2slave(df_expr_target)
  mpi.bcast.Robj2slave(df_expr_reg)
  mpi.bcast.Robj2slave(df_prior)
  mpi.bcast.Robj2slave(df_allowed)
  mpi.bcast.Robj2slave(df_perturbed)
  mpi.bcast.Robj2slave(p_out_dir)
  mpi.bcast.Robj2slave(p_src_code)
  mpi.bcast.Robj2slave(seed)
  mpi.bcast.Robj2slave(nbr_cv_fold)
  mpi.remote.exec(source(paste(p_src_code, "src/build_np1/code/netprophet1/run_netprophet_parallel_single_process.r", sep="")))
  mpi.remote.exec(get_fold_nbr())
  # all.folds = cv.folds(dim(df_expr_target)[2], nbr_cv_fold)
  df_lasso_net = lars.multi.optimize.parallel(df_expr_target,df_expr_reg,df_perturbed,df_prior,df_allowed)[[1]]

  mpi.close.Rslaves()

  df_lasso_net
}

lars.multi.optimize.parallel <- function(df_expr_target,df_expr_reg,df_perturbed,df_prior,df_allowed)
{
  prior=df_prior
  allowed=df_allowed
  pert=df_perturbed
  tdata=df_expr_target
  rdata=df_expr_reg
  targets=seq(dim(tdata)[1])
  cat(as.character(Sys.time()),"\n")
  c.cvmin <- lars.multi.cv.parallel()

  # lars.paths <- lars.multi(tdata,rdata,pert,prior,allowed)
  lars.paths <- lars.multi(df_expr_target,df_expr_reg,df_perturbed,df_prior,df_allowed)
  B <- lars.multi.path.step(lars.paths,c.cvmin)

  B.adj <- matrix(0,nrow=dim(rdata)[1],ncol=dim(tdata)[1])

  for (i in seq(dim(tdata)[1]))
  {
    #Scale B.adj according to prior
    B.adj[,i] <- B[[i]] * prior[,i]
  }
  rval <- list()
  rval[[1]] <- B.adj
  rval[[2]] <- lars.paths
  cat(as.character(Sys.time()),"\n")
  rval
}

lars.multi.cv.cmax.parallel <- function()
{
  cat(cv.obj$R[1,1],"\n")
  cv.obj$R[1,1]
}

lars.multi.cv.parallel <- function()
{
  cMax <- max(as.numeric(mpi.remote.exec(lars.multi.cv.cmax.parallel())))
  cat("cMax: ", cMax, "\n")
  converged <- FALSE
  P <- c(cMax/10,0)

  FP <- c(mean(as.numeric(mpi.remote.exec(cmd=lars.multi.cv.eval.parallel,P[1]))),mean(as.numeric(mpi.remote.exec(cmd=lars.multi.cv.eval.parallel,P[2]))))

  while (!converged)
  {
    Imin <- which.min(FP)
    Imax <- which.max(FP)
    if (Imin==Imax)
      converged=TRUE

    cat("P:",P,"F(P):",FP,"Max/Min",Imax,Imin,"\n")
    Phat <- P[Imin]
    Pref <- 2*Phat - P[Imax]

    if (Pref>cMax)
      FPref <- max(FP) + (Pref-cMax)^2
    else if (Pref<0)
      FPref <- max(FP) + Pref^2
    else
      FPref <- mean(as.numeric(mpi.remote.exec(cmd=lars.multi.cv.eval.parallel,Pref)))

    if (FPref < FP[Imin])
    {
      #Attempt expansion
      Pexp <- 2*Pref - Phat
      FPexp <- mean(as.numeric(mpi.remote.exec(cmd=lars.multi.cv.eval.parallel,Pexp)))
      if (FPexp < FPref) #Expand
      {
        cat("Expand\n")
        P[Imax] <- Pexp
        FP[Imax] <- FPexp
      }
      else #Reflect
      {
        cat("Reflect\n")
        P[Imax] <- Pref
        FP[Imax] <- FPref
      }
    }
    else
    {
      #Contract
      if (FP[Imax] < FPref)
      {
        cat("Contract (1)\n")
        P[Imax] <- (P[Imax] + Phat)/2
        FP[Imax] <- mean(as.numeric(mpi.remote.exec(cmd=lars.multi.cv.eval.parallel,P[Imax])))
      }
      else
      {
        cat("Contract (2)\n")
        P[Imax] <- (Pref + Phat)/2
        FP[Imax] <- mean(as.numeric(mpi.remote.exec(cmd=lars.multi.cv.eval.parallel,P[Imax])))
      }
    }
  }

  cat(P[which.min(FP)],min(FP),"\n")

  P[which.min(FP)]
}

lars.multi.cv.eval.parallel <- function(cVal)
{
  mse <- 0;
  B <- lars.multi.path.step(cv.obj,cVal)
  prior=df_prior
  allowed=df_allowed
  pert=df_perturbed
  tdata=df_expr_target
  rdata=df_expr_reg
  targets=seq(dim(tdata)[1])
  # all.folds <- cv.folds(dim(tdata)[2], nbr_cv_fold)
  for (i in targets)
  {
    omit <- all.folds[[fold]]
    omit <- setdiff(omit,which(pert[i,]!=0))

    testx <- rdata[,omit]
    testy <- tdata[i,omit]
    testx[which(allowed[,i]==0),] <- 0
    testx <- testx * prior[,i]

    testp <- scale(t(testx) , cv.obj[[i]]$meanx, FALSE) %*% matrix(B[[i]]) + cv.obj[[i]]$mu
    testr <- apply((testp - testy)^2,2,mean)
    mse <- mse + testr
  }
  mse <- mse/length(targets)
  mse
}

# ====================================================================== #
# |          **** END Distributed/Parallel Implementation ****         | #
# ====================================================================== #


# Plot a color bar that keept layout function intact
# 'Plot color bar'

#' Plot color bar
#'
#' Plot color bar
#'
#' @param breaks vector of break values
#' @param colors vector of color
#' @param barlength relative length of the bar
#' @param barlwd line width for color bar
#' @param axislab axis label for the colorbar
#' @param axislabline spacing for the axis label
#' @param locut should the lower limit represent a slanted cutoff? (boolean)
#' @param hicut should the higher limit represent a slanted cutoff? (boolean)
#' @param slantwidth width of the slanted cutoff as a fraction of the total bar width (numeric)
#' @param smallticks plot small unlabeled ticks for each break (boolean)
#' @param axisbreaks labelled break values to use in the colorbar axis
#' @param axisbreaklab labels for the axisbreaks
#' @param tck1 length of small ticks
#' @param tck1 length of large ticks
#' @param axiscex cex for tick label
#' @param labelcex cex for axis label
#' @param pmgp temporary par 'mgp' to use
#' @param pmar temporary par 'mar' to use
#' @param ... other arguments passed to axis function
#' @return plotted colorbar
#' @export
colorBar <- function(breaks       = seq(0,1,0.1),
                     colors       = gray.colors(length(breaks)-1),
                     barlength    = 0.5,
                     barlwd       = 0.5,
                     axislab      = 'Colorscale',
                     axislabline  = 2.25,
                     locut        = F,
                     hicut        = F,
                     slantwidth   = 0.05,
                     smallticks   = F,
                     axisbreaks   = breaks,
                     axisbreaklab = axisbreaks,
                     tck1         = -0.015,
                     tck2         = -0.03,
                     axiscex      = 0.8,
                     labelcex     = 1.0,
                     pmgp         = c(2.5,0.66,0),
                     pmar         = c(3,0.5,0.5,0.5),
                     ...
                       ){

# set and store par
op <- par(mgp=pmgp, mar=pmar, xpd=NA)

bspan <- diff(range(breaks))
if (locut){
  breaks <- c(breaks[1]-bspan*slantwidth, breaks)
}
if (hicut){
  breaks <- c(breaks, tail(breaks,1)+bspan*slantwidth)
}

# get polygon coordinates
px.outer <- c(breaks,rev(breaks))
py.outer <- c(rep(0,length(breaks)), rep(1,length(breaks)))
if(locut){py.outer[c(1,length(py.outer))] <- 0.5}
if(hicut){py.outer[c(length(breaks),length(breaks)+1)] <- 0.5}

# get polygons for each break
polysplit <- c(rep(1:(length(breaks)-1),each=2), rev(rep(1:(length(breaks)-1),each=2)))
pxy <- lapply(1:(length(breaks)-1), function(i){
  ir <- length(px.outer)-i+1
  list(x=px.outer[c(i,i+1,ir-1,ir)],
       y=py.outer[c(i,i+1,ir-1,ir)])
})

# set xlimits of plot to scale the barlength
barlength <- barlength/diff(range(breaks))
xlimits <- c(mean(range(breaks)) - 0.5*(1/barlength),
             mean(range(breaks)) + 0.5*(1/barlength))

# set ylimits
ylimits <- c(0.2,0.8)

# make plot
plot(NA, axes=F,xlab='',ylab='',xlim=xlimits,ylim=c(0,1),xaxs='i',yaxs='i')
out <- sapply(1:length(pxy), function(i){
  polygon(pxy[[i]]$x,pxy[[i]]$y, col=colors[i], border=NA)
})
polygon(px.outer,py.outer, lwd=barlwd)

# create axis
axisticks <- breaks
if(locut){axisticks <- axisticks[-1]}
if(hicut){axisticks <- axisticks[-length(axisticks)]}
if(smallticks){axis(1,at=axisticks, label=NA, tck=tck1, lwd=barlwd)}
axis(1,at=axisbreaks, labels=axisbreaklab, tck=tck2, cex.axis=axiscex, lwd=barlwd, ...)
mtext(axislab,1, line=axislabline,cex=labelcex)

# restore par
par(op)

return(invisible())
}

#' @rdname colorBar
#' @export
pkColorbar <- colorBar


##
# plots results of transition matrix analysis
# predictor: child's decade of birth
# 6 plots for 6 subsets
##

rm(list=ls())
source('inread.r')
# get data
M.gen1 <- inread('analysis/tp_decade_m1.csv')
B.gen1 <- inread('analysis/tp_decade_b1.csv')
C.gen1 <- inread('analysis/tp_decade_c1.csv')

M.gen2 <- inread('analysis/tp_decade_m2.csv')
B.gen2 <- inread('analysis/tp_decade_b2.csv')
C.gen2 <- inread('analysis/tp_decade_c2.csv')

# get plotting functions
source("tp_plot_styles.r")
X.lab <- "Child's decade of birth"
nphrase <- "\nN of elder-child dyads ="

# make plots of parent-child transitions
m1 <- plot1(M.gen1) + scale_colour_manual(
  values = c(spreadcol, zerocol, linecol),
  labels = c("M to B", "M to C", "M to M")) +
  labs(title = paste("Proportion of spread by decade,",
  "\ngiven Mongolian-monolingual (M) elders:",
  nphrase, sum(M.gen1$n)/3, sep=" "))
b1 <- plot1(B.gen1) + scale_colour_manual(
  values = c(maintcol, shiftcol, linecol),
  labels = c("B to B", "B to C", "B to M")) +
  labs(title = paste(
  "Proportion of maintenance vs. shift by decade,",
  "\ngiven bilingual (B) elders:",
  nphrase, sum(B.gen1$n)/3, sep=" "))
c1 <- plot1(C.gen1) + scale_colour_manual(
  values = c(linecol, linecol, zerocol),
  labels = c("C to B", "C to C", "C to M")) +
  labs(title = paste(
  "Proportion of (M), (B) and (C) children by decade,",
  "\ngiven Chinese-monolingual (C) elders:",
  nphrase, sum(C.gen1$n)/3, sep=" "))

# make plots of child-parent transitions
m2 <- plot2(M.gen2) + scale_colour_manual(
  values = c(linecol, zerocol, linecol),
  labels = c("B to M", "C to M", "M to M")) +
  labs(title = paste(
    "Proportion of (M), (B) and (C) elders by decade,",
    "\ngiven Mongolian-monolingual (M) children:",
    nphrase, sum(M.gen2$n/3), sep=" "))
b2 <- plot2(B.gen2) + scale_colour_manual(
  values = c(maintcol, linecol, spreadcol),
  labels = c("B to B", "C to B", "M to B")) +
  labs(title = paste(
    "Proportion of maintenance vs. spread by decade,",
    "\ngiven bilingual (B) children:",
    nphrase, sum(B.gen2$n/3), sep=" "))
c2 <- plot2(C.gen2) + scale_colour_manual(
  values = c(shiftcol, linecol, zerocol),
  labels = c("B to C", "C to C", "M to C")) +
  labs(title = paste("Proportion of shift by decade,",
    "\ngiven Chinese-monolingual (C) children:",
    nphrase, sum(C.gen2$n/3), sep=" "))

# save plots
plots <- c("m1", "b1", "c1", "m2", "b2", "c2")
prefix <- "figures/plot_tp_dec_"
l <- mget(plots)
invisible(mapply(ggsave, file=paste0(prefix, names(l), ".pdf"),
  width=8, height=5, units="in", plot=l))
invisible(mapply(ggsave, file=paste0(prefix, names(l), ".jpg"),
  width=8, height=5, units="in", plot=l))


dyn.load('/Library/Java/JavaVirtualMachines/jdk1.8.0_131.jdk/Contents/Home/jre/lib/server/libjvm.dylib')
library(rJava)

setwd("/Users/mengmengjiang/all datas/print")

library(xlsx)

# reading ux and sd

k1<-read.xlsx("dotx.xlsx",sheetName="600",header=TRUE)
k2<-read.xlsx("dotx.xlsx",sheetName="1khz",header=TRUE)
k3<-read.xlsx("dotx.xlsx",sheetName="2khz",header=TRUE)
k4<-read.xlsx("dotx.xlsx",sheetName="2.5khz",header=TRUE)

# errorbar
error.bar <- function(x, y, upper, coll,lower=upper, length=0.05,...){
if(length(x) != length(y) | length(y) !=length(lower) | length(lower) != length(upper))
stop("vectors must be same length")
arrows(x,y+upper, x, y-lower,col=coll, angle=90, code=3, length=length, ...)
}

# par

# color setting

yan<-c("red","blue","black","green3")
pcc<-c(0,1,2,5)

ux1<-k1$ux
ux2<-k2$ux
ux3<-k3$ux
ux4<-k4$ux

A<-(ux1*1000/600)
B<-(ux2*1000/1000)
C<-(ux3*1000/2000)
D<-(ux4*1000/2500)

t1<-(A-k1$sdeva)/A
t2<-(B-k2$sdeva)/B # 标准 - Sd
t3<-(C-k3$sdeva)/C
t4<-(D-k4$sdeva)/D

n1<-(A-(k1$sdeva+k1$deva))/A
n2<-(B-(k2$sdeva+k2$deva))/B  # 标准-Sd-D
n3<-(C-(k3$sdeva+k3$deva))/C
n4<-(D-(k4$sdeva+k4$deva))/D

# plot

plot(k1$ux,k1$sdeva, col=0,xlab = expression(italic(U["x"]) (mm/s)),
          ylab = expression(italic(ratio_Sd/ratio_Sd+D)), mgp=c(1.1, 0, 0),tck=0.02,
               main = "", xlim = c(0,300),ylim=c(-0.5,1))

mtext("ratio of error in Sd and Sd+D",3,line=-1,font=2,cex=1)

lines(ux1,t1,col=yan[1],lwd=1.5,lty=2,pch=pcc[1],type="b")
lines(ux2,t2,col=yan[2],lwd=1.5,lty=2,pch=pcc[2],type="b")
lines(ux3,t3,col=yan[3],lwd=1.5,lty=2,pch=pcc[3],type="b")
lines(ux4,t4,col=yan[4],lwd=1.5,lty=2,pch=pcc[4],type="b")

lines(ux1,-n1,col=yan[1],pch=0,lwd=1.5)
lines(ux2,n2,col=yan[2],pch=1,lwd=1.5)
lines(ux3,n3,col=yan[3],pch=2,lwd=1.5)
lines(ux4,n4,col=yan[4],pch=5,lwd=1.5)

abline(h=0,col="yellow3",lwd=1.5,lty=2)
abline(h=0.5,col="red",lwd=1.5,lty=2)

leg<-c("600Hz-r_Sd","1KHz-r_Sd","2KHz-r_Sd","2.5KHz-r_Sd")
leg2<-c("|600Hz-r_Sd+D|","1KHz-r_Sd+D","2KHz-r_Sd+D","2.5KHz-r_Sd+D")

legend("bottomright",legend=leg,col=yan,lwd=1.5,inset=.02,bty="n",cex=0.8)
legend("bottomleft",legend=leg2,pch=c(0,1,2,5),col=yan,lty=2,lwd=1.5,inset=.02,bty="n",cex=0.8)


library(ggsignif)

df.test = fread("results/test_sig.genes_in_clusters_high_vs_low_responders.txt") %>%
  dplyr::filter(w.pv < 0.05, test.dir == "IN", test == "SigScore",
                clustering == "K1") %>%
  dplyr::mutate(sig.name = sig %>%
          str_replace("SLE.sig", "SLE-Sig") %>%
          str_replace("CD40.act", "CD40act") %>%
          str_replace("IFN26", "IFN-I-DCact")) %>%
  dplyr::mutate(clustern = 9-as.numeric(str_remove(cluster,"C"))) %>%
  dplyr::mutate(sig = factor(sig)) %>%
  dplyr::arrange(sig, cluster)

clustering = 1
sigs = levels(df.test$sig)
sig.label = sigs %>% str_replace("SLE.sig", "SLE-Sig") %>%
  str_replace("CD40.act", "CD40act") %>% str_replace("IFN26", "IFN-I-DCact") %>%
  setNames(sigs)

dn.fig = "figures/sig_test_boxplots"
dir.create(dn.fig, showWarnings = F, recursive = T)

for(s in sigs) {
  cat(s, "\n")
fn.score = glue::glue("results/sig_scores/scores_{s}_{clustering}.txt")
df.sc = fread(fn.score, data.table = F) %>%
  dplyr::mutate(subject = factor(subject)) %>%
  gather("cluster","score", -subject) %>%
  left_join(df.subj, by="subject") %>%
  dplyr::mutate(clustern = 9-as.numeric(str_remove(cluster,"C"))) %>%
  dplyr::mutate(response = factor(response, levels=c("low","high"))) %>%
  dplyr::arrange(cluster, response) %>%
  dplyr::mutate(resp_cl = ifelse(response=="low", clustern-0.15, clustern+0.15))

df.txt = df.test %>%
  dplyr::filter(sig == s) %>%
  dplyr::mutate(x = clustern, y = 1, label = "*")
yrng = c(-1, 1.55)
cm = pals::glasbey(13)[c(1:3,5:9,13,11)]
dotsz = diff(yrng)/(max(df.sc$score) - min(df.sc$score))
p = ggplot(df.sc, aes(resp_cl, score, group=resp_cl)) +
  coord_flip(ylim=yrng) +
  geom_boxplot(width=0.6, aes(fill=cluster), position = position_dodge2(preserve = "total"), lwd = 0.3, alpha = 0.5, outlier.shape = NA, show.legend = F) +
  geom_dotplot(aes(fill = response), binaxis = "y", stackdir = "center", dotsize = dotsz,
               position=position_dodge(), show.legend = F) +
  scale_fill_manual(values = c(cm,"black", "white")) +
  scale_x_continuous(breaks=0:10 ,labels = c(paste0("C",9:0) ,"All")) +
  xlab("Cell cluster") + ylab(paste(sig.label[s], "score")) +
  theme_classic()
if(nrow(df.txt)>0) {
  p = p + ggsignif::geom_signif(y_position = rep(1,nrow(df.txt)), textsize = 8, col="red",
                      xmin = df.txt$x-0.15, xmax = df.txt$x+0.15,
                      annotation=df.txt$label, tip_length = 0.01)
}

ggsave(glue::glue("{dn.fig}/sig_scores_box_{s}_K{clustering}.png"), plot=p, w=2, h=6)
ggsave(glue::glue("{dn.fig}/sig_scores_box_{s}_K{clustering}.pdf"), plot=p, w=2, h=6, useDingbats=F)
}


library("methylKit")

file.list = list("input_test1.myCpG.txt", "input_test2.myCpG.txt", "input_control1.myCpG.txt", "input_control2.myCpG.txt")

myobj=methRead( file.list,
                sample.id=list("test 1","test 2","control 1","control 2"),assembly="hg18",pipeline="amp",treatment=c(1,1,0,0))

pdf('output_statistics.pdf')
for (obj in myobj){
  getMethylationStats(obj,plot=TRUE,both.strands=FALSE)
  getCoverageStats(obj,plot=TRUE,both.strands=FALSE)
}
devname = dev.off()

# unite function
methidh = unite(myobj)

pdf("output_correlation.pdf")
getCorrelation(object = methidh, plot=TRUE, method = "pearson")
devname = dev.off()

# differential methylation
myDiff = calculateDiffMeth(methidh, overdispersion="none",
                           adjust="SLIM", effect="wmean", test="Chisq",
                           slim=FALSE, weighted.mean=FALSE)

bedgraph(myDiff, file.name="output_myDiff.bedgraph", col.name="meth.diff",
         unmeth=FALSE, log.transform=FALSE, negative=FALSE, add.on="")

MethPerChr = diffMethPerChr(myDiff, plot=FALSE,
                            qvalue.cutoff=0.01,
                            meth.cutoff=25)
write.table(MethPerChr, sep="\t", row.names=FALSE, quote=FALSE, file="output_MethPerChr.tsv")

MethylDiff = getMethylDiff(myDiff, difference=25,
                               qvalue=0.01, type="all")
bedgraph(MethylDiff, file.name="output_MethylDiff.bedgraph", col.name="meth.diff",
         unmeth=FALSE,log.transform=FALSE,negative=FALSE,add.on="")

pdf( "output_clustering.pdf" )
methClust = clusterSamples(methidh, dist="correlation", method="ward")
devname = dev.off()

pdf( "output_PCA.pdf" )
PCASamples(methidh)
devname = dev.off()

## methSeg works for methylRaw or methylDiff with resolution region,
## so methylBase has to be tiled before
tileRaw = tileMethylCounts(myobj[[1]])
tileBase = tileMethylCounts(methidh)
tileDiff = calculateDiffMeth(tileBase)

## methseg generates Granges
segRaw = methSeg(tileRaw, diagnostic.plot = FALSE)
segDiff = methSeg(tileDiff, diagnostic.plot = FALSE)

## and can be exported as BED
methSeg2bed(segments = segRaw, filename = "output_seg_raw.bed")
methSeg2bed(segments = segDiff, filename = "output_seg_diff.bed")


require(progress)
require(stringr)
require(yaml)

# Bring in any parameters we need  -----------------------------------------------
FLAGS <- yaml.load_file('./generate_text.yml')

# Bring helper functions  --------------------------------------------------------
source('load_corpus.r')
source('dnn_model.r')
source('utils.r')

# Load our corpus and create our model -------------------------------------------
corpus <- load_corpus('../data')
# override the coupus length because they are crazy
corpus$max_sentence_length <- FLAGS$max_sentence_length
model <- create_dnn(corpus$max_sentence_length, length(corpus$vocab))

# Training -----------------------------------------------------------------------
for(document in corpus$documents) {

  samples <- make_samples(document, corpus$max_sentence_length + 1)
  sz = dim(samples)

  # The `train_on_batch()` function is the most granular training.
  # In our lab, we like that level of control.
  # In your case just using `fit()` on the whole thing may make sense
  for(i in 1:FLAGS$epochs) {
    batch_i <- 1
    pb <-
      progress_bar$new(
        format = 'batch :current/:total [:bar] eta: :eta',
        total = ceiling(sz[1]/FLAGS$batch_size))
    pb$tick(0)
    while(batch_i <= sz[1]) {
      batch <- make_batch(samples, batch_i, FLAGS$batch_size)
      one_hot <- one_hot_batch(batch, corpus$vocab)
      loss = train_on_batch(model, one_hot$x, one_hot$y)
      rm(batch, one_hot)
      batch_i <- batch_i + FLAGS$batch_size
      pb$tick()
    }
    print(sprintf('Epoch: %i, Loss: %f', i, loss))
  }
}


library(ggplot2)
library(scales)

States <- read.csv('data/clean/states_10011230.csv')

Sleep <- subset(States, activity == 'sleep')
Sleep$start <- as.POSIXct(Sleep$start, origin = "1970-01-01", tz = "GMT")
Sleep$end <- as.POSIXct(Sleep$end, origin = "1970-01-01", tz = "GMT")
Sleep$date <- floor_date(Sleep$start, 'd')

# oof, why aren't there just *time* objects
# give them all the same arbitrary day
as.time <- function(dt) {
  hms(format(dt, format = '%H:%M:%S')) + ymd('2013-01-01')
}
Sleep$start.time <- with_tz(as.time(Sleep$start), 'America/Los_Angeles')
Sleep$end.time <- with_tz(as.time(Sleep$end), 'America/Los_Angeles')

p <- ggplot(Sleep, aes(xmin = date, xmax = date + hours(20), ymin = start.time, ymax = end.time))
p <- p + geom_rect() + scale_y_datetime(labels = date_format("%H:%M")) + xlab('Date') + ylab('Time')
ggsave(p, 'figures/sleep-plot.png', width = 6, height = 3)


library(shiny)
library(ggplot2)
library(magrittr)
library(leaflet)

pizza <- jsonlite::fromJSON('FavoriteSpots.json') %>%
    tidyr::unnest()

shinyServer(function(input, output, session){

    output$CarHistogram <- renderPlot(
        ggplot(mtcars, aes_string(x=input$ColumnName)) +
            geom_histogram(bins=input$NumBins)
    )

    output$PizzaTable <- DT::renderDataTable(
        pizza, rownames=FALSE
    )

    output$PizzaMap <- renderLeaflet({
        leaflet() %>%
            addTiles() %>%
            # addProviderTiles('Staman.Watercolor') %>%
            addMarkers(
                lng = ~ longitude, lat = ~ latitude,
                popup = ~ Name,
                data=pizza %>%
                    dplyr::slice(as.integer(input$PizzaTable_rows_selected))
            )
    })
})


# packages needed
rm(list = ls())
source("project_paths.r")

library(tidyverse)
library(plm)
library(lmtest)
library(broom)
# library(flextable)
# library(officer)
library(knitr)

source(paste(PATH_IN_ANALYSIS, "unconditionalModels.R", sep="/"))
source(paste(PATH_IN_ANALYSIS, "conditionalModels.R", sep="/"))

outcomes <- read_rds(paste(PATH_OUT_DATA, "outcomes.rds", sep="/"))
events_by_time <-  read_rds(paste(PATH_OUT_DATA, "events_by_time.rds", sep="/"))
demographics <-read_rds(paste(PATH_OUT_DATA, "demographics.rds", sep="/"))

knitr::opts_chunk$set(include = FALSE,
                      eval = TRUE,
                      echo = FALSE,
                      message = FALSE,
                      warning = FALSE,
                      fig.path = "figures/")

# 21 life events included

lifevents <- c('lefnw', 'lefni', 'lefrd', 'lejob', 'leprm', 'lertr', 'lemar',
               'leprg', 'lebth', 'ledsc', 'lesep', 'lemvd', 'leins', 'lepcm',
               'lejls', 'lejlf', 'ledfr', 'ledrl', 'leinf', 'lercl', 'levio')

# 10 time points included
timelevels = c('pre36', 'pre24', 'pre12', 'post03', 'post06', 'post09',
               'post12', 'post24', 'post36', 'post48')

# name of events
renamevents <- list(
    Widowed = "ledsc",
    Separated = "lesep",
    Money_lost = "lefnw",
    Jailed = "lejls",
    Attacked = "levio",
    Health_shock = "leins",
    Reconciled = "lercl",
    Fired = "lefrd",
    Family_harmed = "leinf",
    Robbed = "lepcm",
    Friend_died = "ledfr",
    Relative_died = "ledrl",
    Relative_jailed = "lejlf",
    Moved = "lemvd",
    Hired = "lejob",
    Promoted = "leprm",
    Retired = "lertr",
    Money_gained = "lefni",
    Pregnant = "leprg",
    Childbirth = "lebth",
    Married = "lemar"
    )

# good event names
good_events <- c(
  "Married", "Childbirth", "Money_gained",
  "Retired", "Pregnant", "Promoted",
  "Hired", "Moved", "Reconciled"
  )

# bad event names
bad_events <- c(
  "Widowed", "Separated", "Money_lost",
  "Health_shock", "Attacked", "Fired",
  "Family_harmed", "Friend_died", "Robbed"
  )

#Table 1. List of 22 life events and their description*

tribble(
  ~Event, ~Description,
  "Widowed", "death of a spouse or a child",
  "Separated", "separated or divorced from a spouse or long-term partner",
  "Money lost", "major worsening in financial situation (e.g. bankruptcy)",
  "Jailed", "detained in jail / correctional facility",
  "Attacked", "victim of physical violence (e.g. assault)",
  "Health shock", "serious personal injury or illness (e.g., disability)",
  "Reconciled", "reconciled with spouse/long-term partner after separation",
  "Fired", "fired or made redundant by an employer",
  "Family harmed", "serious injury or illness to a close family member",
  "Robbed", "victim of property crime (e.g. theft, house breaking)",
  "Friend died", "death of a close friend",
  "Relative died", "death of a close family member (e.g. parent or sibling)",
  "Relative jailed", "jail for a close friend or relative",
  "Moved", "changed residence",
  "Hired", "changed jobs (i.e. employer)",
  "Promoted", "promoted at work",
  "Retired", "retired from workforce",
  "Money gained", "major gain in finances (e.g., lottery win, inheritance)",
  "Pregnant", "you (or your partner) got pregnant",
  "Married", "got married",
  "Childbirth","birth (or adoption) of a child"
  ) %>%
  kable()

outcomes %>%
  filter(code == 'losatyh') %>%
  mutate(
    Y = case_when(
      val < 0 ~ NA_integer_,
      TRUE ~ as.integer(val)
    )
  ) %>%
  select(-code, -val) -> cognitive.df

outcomes %>%
  filter(code == 'gh9_sum') %>%
  mutate(
    Y = case_when(
      val < 0 ~ NA_integer_, # no negatives in gh9_sum
      TRUE ~ as.integer(val)
    )
  ) %>%
  select(-code, -val) -> affect.df

# outcomes %>%
#   filter(code == 'mcs') %>%
#   select(-code, Y = val) -> affect.df

# load the list of life event data (for preprocessing see Appendix)
#events_by_time <- read_rds('src/data/events_by_time.rds')

#### Add covariates ####
# Load the preprocessed demographic data (for preprocessing see Appendix)
#demographics <- read_rds('src/data/demographics.rds')

# socioeconomic status (hhda10)
demographics %>%
  filter(code == 'hhda10') %>%
  mutate(
    val = case_when(
      val < 0 ~ NA_integer_, # recode missing values as NA
      TRUE ~ as.integer(val)
    )
  ) %>%
  group_by(xwaveid) %>%
  arrange(xwaveid, wave) %>%
  fill(val, .direction = 'down') %>%
  fill(val, .direction = 'up') %>%
  select(xwaveid, wave, seifa = val) %>%
  replace_na(list(seifa = 0)) -> seifa.df

# level of highest education (edhigh1)
demographics %>%
  filter(code == 'edhigh1') %>%
  mutate(
    reval = case_when(
      val < 0 ~ NA_real_,   # recode missing values as NA
      val == 10 ~ NA_real_, # recode undetermined values as NA
      val == 1 ~  3,        # PhD
      val == 2 ~  2,        # Grad diploma
      val == 3 ~  2,        # Bachelors
      val == 4 ~  1,        # Diploma
      val == 5 ~  1,        # Certificate
      val == 8 ~  0,        # Year 12
      val == 9 ~ -1         # Year 10
    )
  ) %>%
  group_by(xwaveid) %>%
  arrange(xwaveid, wave) %>%
  fill(reval, .direction = 'down') %>%
  fill(reval, .direction = 'up') %>%
  select(xwaveid, wave, edu = reval) %>%
  replace_na(list(edu = 0)) -> edu.df

# age (decade of life)
demographics %>%
  filter(code == 'hgage') %>%
  mutate(age = floor(val/10)) %>%
  select(xwaveid, wave, age) -> age.df

demographics %>%
  filter(code == 'female') %>%
  mutate(sex = val) %>%
  select(xwaveid,sex) -> female.df

# Join the covariates together into a single data frame
# (they will be converted to change scores later)
edu.df %>%
  left_join(age.df, by = c("xwaveid", "wave")) %>%
  left_join(seifa.df, by = c("xwaveid", "wave")) %>%
  left_join(female.df, by = c("xwaveid"))-> covariates

write_rds(age.df,paste(PATH_OUT_DATA, "age.rds", sep="/")) # save for supplementary analysis
write_rds(female.df,paste(PATH_OUT_DATA, "sex.rds", sep="/")) # save for supplementary analysis

##delete the next line
write_rds(covariates,paste(PATH_OUT_DATA, "covariates.rds", sep="/")) # save for supplementary analysis
rm(edu.df,age.df,seifa.df,demographics,outcomes)

#write_rds(affect.df,paste(PATH_OUT_DATA, "affectdf.rds", sep="/")) # save for supplementary analysis
marker="female"
cognitive.results <- conditionalModels(cognitive.df, events_by_time, covariates, timelevels, lifevents,marker)
affective.results <- conditionalModels(affect.df, events_by_time, covariates, timelevels, lifevents,marker)

# Combine coeficient results
cognitive.coefs <- cognitive.results$coefs
affective.coefs <- affective.results$coefs
cognitive.coefs$outcome <- 'health'
affective.coefs$outcome <- 'emotional'
bind_rows(cognitive.coefs, affective.coefs) -> results

# Calculate confidence intervals on clustered errors
results$upper <- results$estimate - results$std.error*qt(p = 0.1, df = results$n-1)
results$lower <- results$estimate + results$std.error*qt(p = 0.1, df = results$n-1)

# Save results
write_csv(results,paste(PATH_OUT_DATA, "conditional_results_female.csv", sep="/"))

marker="male"
cognitive.results <- conditionalModels(cognitive.df, events_by_time, covariates, timelevels, lifevents,marker)
affective.results <- conditionalModels(affect.df, events_by_time, covariates, timelevels, lifevents,marker)

# Combine coeficient results
cognitive.coefs <- cognitive.results$coefs
affective.coefs <- affective.results$coefs
cognitive.coefs$outcome <- 'health'
affective.coefs$outcome <- 'emotional'
bind_rows(cognitive.coefs, affective.coefs) -> results

# Calculate confidence intervals on clustered errors
results$upper <- results$estimate - results$std.error*qt(p = 0.1, df = results$n-1)
results$lower <- results$estimate + results$std.error*qt(p = 0.1, df = results$n-1)

# Save results
write_csv(results,paste(PATH_OUT_DATA, "conditional_results_male.csv", sep="/"))

marker="seifa_top_half"
cognitive.results <- conditionalModels(cognitive.df, events_by_time, covariates, timelevels, lifevents,marker)
affective.results <- conditionalModels(affect.df, events_by_time, covariates, timelevels, lifevents,marker)

# Combine coeficient results
cognitive.coefs <- cognitive.results$coefs
affective.coefs <- affective.results$coefs
cognitive.coefs$outcome <- 'health'
affective.coefs$outcome <- 'emotional'
bind_rows(cognitive.coefs, affective.coefs) -> results

# Calculate confidence intervals on clustered errors
results$upper <- results$estimate - results$std.error*qt(p = 0.1, df = results$n-1)
results$lower <- results$estimate + results$std.error*qt(p = 0.1, df = results$n-1)

# Save results
write_csv(results,paste(PATH_OUT_DATA, "conditional_results_seifa_top_half.csv", sep="/"))

marker="seifa_bottom_half"
cognitive.results <- conditionalModels(cognitive.df, events_by_time, covariates, timelevels, lifevents,marker)
affective.results <- conditionalModels(affect.df, events_by_time, covariates, timelevels, lifevents,marker)

# Combine coeficient results
cognitive.coefs <- cognitive.results$coefs
affective.coefs <- affective.results$coefs
cognitive.coefs$outcome <- 'health'
affective.coefs$outcome <- 'emotional'
bind_rows(cognitive.coefs, affective.coefs) -> results

# Calculate confidence intervals on clustered errors
results$upper <- results$estimate - results$std.error*qt(p = 0.1, df = results$n-1)
results$lower <- results$estimate + results$std.error*qt(p = 0.1, df = results$n-1)

# Save results
write_csv(results,paste(PATH_OUT_DATA, "conditional_results_seifa_bottom_half.csv", sep="/"))
marker="all"
cognitive.results <- conditionalModels(cognitive.df, events_by_time, covariates, timelevels, lifevents,marker)
affective.results <- conditionalModels(affect.df, events_by_time, covariates, timelevels, lifevents,marker)

covar.results <- list(cognitive = cognitive.results$covar, affective = affective.results$covar)
write_rds(covar.results,paste(PATH_OUT_DATA, "conditional_covar.rds", sep="/"))

# Combine coeficient results
cognitive.coefs <- cognitive.results$coefs
affective.coefs <- affective.results$coefs
cognitive.coefs$outcome <- 'health'
affective.coefs$outcome <- 'emotional'
bind_rows(cognitive.coefs, affective.coefs) -> results

# Calculate confidence intervals on clustered errors
results$upper <- results$estimate - results$std.error*qt(p = 0.1, df = results$n-1)
results$lower <- results$estimate + results$std.error*qt(p = 0.1, df = results$n-1)

# Save results
write_csv(results,paste(PATH_OUT_DATA, "conditional_results.csv", sep="/"))

#### Comparing the total impact of life events
#In order to compare the total impact of life events, taking into account both magnitude and duration of effect,
#we calculated the area-under-the-curve (AUC) for each event in each model (as well as variance). The AUC was calculated by:

## Results
#### Subjective wellbeing

#### Effect of life events on subjective wellbeing
#Unconditional effect of life events*. Figures 1 & 2 below show the effect of each life event on cognitive and affective wellbeing,
#ignoring any concurrent life events (or any other covariates apart from year).

#We a priori defined 9 positively and 9 negatively valenced events and present them in separate figures to facilitate
#comparison between events of the same valence (although this was not born out for reconciliation which had an anticipatory negative effect
#and no positive effect). *Married*, *Childbirth* and a major financial gain  (*Money gained*)
 #produce the largest positive impact on wellbeing, while *Widowed*, *Separated* and major financial loss (*Money lost*) produced the largest negative impact on wellbeing.


myTestRule {
#Input parameters are:
#  Structure holding the query
#Output parameter is:
#  Structure holding the query result
#Output from running the example is:
#  List of the number of files and size of files in collection /tempZone/home/rods/large-coll
  *ContInxOld = 1;
  *Count = 0;
  *Size = 0;
  msiMakeGenQuery("DATA_ID, DATA_SIZE",*Condition,*GenQInp);
  msiExecGenQuery(*GenQInp, *GenQOut);
  msiGetContInxFromGenQueryOut(*GenQOut,*ContInxNew);
  while(*ContInxOld > 0) {
    foreach(*GenQOut) {
       msiGetValByKey(*GenQOut, "DATA_SIZE", *Fsize);
       *Size = *Size + double(*Fsize);
       *Count = *Count + 1;
    }
    *ContInxOld = *ContInxNew;
    if(*ContInxOld > 0) {msiGetMoreRows(*GenQInp,*GenQOut,*ContInxNew);}
  }
  writeLine("stdout","Number of files in *Coll is *Count and total size is *Size");
}
INPUT *Coll = "/tempZone/home/rods/large-coll", *Condition="COLL_NAME like '*Coll'"
OUTPUT ruleExecOut


List<BigInteger> a = new List<BigInteger>();

for (int b = 2; b < 400; b++) {
    BigInteger value = b;
    for (int e = 2; e < 50; e++) {
        value *= b;

        if (DigitSum(value) == b) {
            a.Add(value);
        }
        if (a.Count > 50) break;
    }
    if (a.Count > 50) break;
}


#研究iso异丙醇的各方面的数据，乙醇的电导率在三者中最小
#随着流量、极间距离、针头半径不断变化的弯月面的高度和角度
#设定工作区间
setwd("D:/data")
library(xlsx)

#读取数据
#与流量变化有关的数据
men_qh<-read.xlsx("iso.xls", sheetName="flowrate_h", header=TRUE)
men_qa<-read.xlsx("iso.xls", sheetName="flowrate_a", header=TRUE)

#读取与极间距离有关的数据
men_dh<-read.xlsx("iso.xls", sheetName = "distance_h", header = TRUE)
men_da<-read.xlsx("iso.xls", sheetName = "distance_a", header = TRUE)

#读取与针头直径相关的数据
men_rh<-read.xlsx("iso.xls", sheetName = "radius_h", header = TRUE)
men_ra<-read.xlsx("iso.xls", sheetName = "radius_a", header = TRUE)

#规划figure界面
par(mfrow=c(2,1), mar=c(4,4,2,2), oma=c(2,1,1,1))

#按照流量、极间距离、针头直径相关划分为3张figure，每张两图

#保存pdf
pdf("iso_diameter.pdf")

#########################研究ethanol与nozzle diameter 的关系#################

################################画图-高度曲线###########################
plot(men_rh$voltage, men_rh$X0.81, col=0, xaxs="i", xlim=c(1.3, 2.7), ylim=c(0.1, 1.3),
xlab="Diameter (mm)", cex.lab=1, ylab="Height of Meniscus (mm)", main="Height with Rn  of Ethanol")

lines(lowess(men_rh$voltage, men_rh$X0.81), col="#458B74", pch=21, lwd=2.5, type="b", lty=2)

lines(lowess(men_rh$voltage, men_rh$X0.71), col="#FF00FF", pch=22, lwd=2.5, type="b", lty=2)

lines(lowess(men_rh$voltage, men_rh$X0.55), col="#EE0000", pch=23, lwd=2.5, type="b", lty=2)

lines(lowess(men_rh$voltage, men_rh$X0.45), col="#EEAD0E", pch=24, lwd=2.5, type="b", lty=2)

lines(lowess(men_rh$voltage, men_rh$X0.35), col="#27408B", pch=25, lwd=2.5, type="b", lty=2)

legend("topright", c("0.81mm", "0.71mm", "0.55mm", "0.45mm", "0.35mm"), inset=.02, col=c("#458B74", "#FF00FF", "#EE0000", "#EEAD0E", "#27408B"), pch=c(21,22,23,24,25), lwd=2.5, lty=2, cex=1.3)

##############################画图--角度曲线############################
plot(men_ra$voltage, men_ra$X0.81, col=0, xaxs="i", xlim=c(1.3, 2.7), ylim=c(40, 155),
xlab="Diameter (mm)", cex.lab=1, ylab="Taylor Angle (°)", main="Angle with Rn of Ethanol")

lines(lowess(men_ra$voltage, men_ra$X0.81), col="#458B74", pch=21, lwd=2.5, type="b", lty=2)

lines(lowess(men_ra$voltage, men_ra$X0.71), col="#FF00FF", pch=22, lwd=2.5, type="b", lty=2)

lines(lowess(men_ra$voltage, men_ra$X0.55), col="#EE0000", pch=23, lwd=2.5, type="b", lty=2)

lines(lowess(men_ra$voltage, men_ra$X0.45), col="#EEAD0E", pch=24, lwd=2.5, type="b", lty=2)

lines(lowess(men_ra$voltage, men_ra$X0.35), col="#27408B", pch=25, lwd=2.5, type="b", lty=2)

legend("topleft", c("0.81mm", "0.71mm", "0.55mm", "0.45mm", "0.35mm"), inset=.02, col=c("#458B74", "#FF00FF", "#EE0000", "#EEAD0E", "#27408B"), pch=c(21,22,23,24,25), lwd=2.5, lty=2, cex=1.3)

mtext("Distance 2mm | Nozzle 24G | Flowrate 0.006nl/min", 1, line=1, col="black", cex=1.3, font=2, outer=TRUE)

###标注信息

dev.off()


library(rvest)
library(httr)
library(data.table)
library(tidyverse)
library(WDI)
library(countrycode)
library(lmtest)
library(tseries)
library(plm)
library(rvest)
library(httr)
library(quantmod)
library(fredr)
library(scales)
library(quantreg)
setwd('~\\Public_Policy\\Projects\\Taxes vs. Deficits\\data')

#### Load OECD revenue, expense, and deficit data ####
all_oecd_downloads =   c("oecd_net_lending.csv"   ,         "oecd_revenue.csv"   ,             "oecd_spending.csv" ) %>%
  map(read_csv) %>%
  bind_rows()

USA_revenue_expense_deficits = filter(all_oecd_downloads,
                                      LOCATION == 'USA',
                                      INDICATOR %in% c('GGEXP', 'GGREV', 'GGNLEND'),
                                      MEASURE == 'PC_GDP') %>%
data.table()

us_defense_only = filter(USA_revenue_expense_deficits, INDICATOR == 'GGEXP', SUBJECT == 'DEF')

ggplot(us_defense_only, aes(TIME, Value)) +
  geom_line()

# compute YOY differences, push wide
USA_revenue_expense_deficits_diffs = USA_revenue_expense_deficits[, {
  lag_value = dplyr::lag(Value, 1)
  diff_value = Value - lag_value
  pct_change = diff_value / lag_value
  list(
    value = Value,
    lag_value = lag_value,
    diff_value = diff_value,
    pct_change = pct_change,
    year = TIME
  )
}, by = list(INDICATOR, SUBJECT)] %>%
  mutate(
    series_name = paste(INDICATOR, SUBJECT, sep = '_')
  ) %>%
  pivot_wider(
    id_cols = c('year'),
    names_from = c('series_name'),
    values_from = c('value', 'diff_value')
  )

# load in existing wide US data
load('US_political_economic_data.rdata')

# combine OECD data and wide US data (keep only political variables and growth)
US_wide_selection =
  select(US_wide,
         year = Year,
         contains('pcap'),
         contains('president'),
         contains('recession')) %>%
  left_join(USA_revenue_expense_deficits_diffs) %>%
  filter(!is.na(value_NY.GDP.PCAP.KD.ZG)) %>%
  arrange(year)

iqr_growth = quantile(US_wide_selection$value_NY.GDP.PCAP.KD.ZG, probs = c(0.25, 0.75))

US_wide_selection = mutate(
  US_wide_selection,
  growth_desc = ifelse(dplyr::between(value_NY.GDP.PCAP.KD.ZG, iqr_growth[1], iqr_growth[2]),
                       'Middle 50%', ifelse(value_NY.GDP.PCAP.KD.ZG < iqr_growth[1],
                                            'Bottom 25%', 'Top 25%'))
)
group_by(US_wide_selection, growth_desc) %>%
  summarize(
    obs = n(),
    mean_growth = mean(value_NY.GDP.PCAP.KD.ZG)
  )

descriptions = c(
  'TOT' = 'Total Revenue',
  'EDU' = 'Education',
  'DEF' = 'Defense',
  'HEALTH' = 'Health',
  'SOCPROT' = 'Social Protection',
  'RECULTREL' = 'Recreation, Culture, and Religion',
  'GRALPUBSER' = 'General Public Services',
  "ENVPROT" = 'Environmental Protection',
  "PUBORD" = 'Public Order and Safety',
  'ECOAFF' = 'Economic Affairs',
  'HOUCOMM' = 'Housing and Community Amenities'
)
desc_df = tibble(
  desc = names(descriptions),
  full_description = descriptions
)
View(long_rev_expense_components)

# pull out only revenues and expense components
long_rev_expense_components =
  US_wide_selection %>%
  select(year, contains('diff_value_GGREV'), contains('diff_value_GGEXP'), -diff_value_GGEXP_TOT) %>%
  pivot_longer(
  -year
) %>%
  mutate(
    value = ifelse(str_detect(name, 'GGEXP'), value * -1, value),
    type = ifelse(str_detect(name, 'GGEXP'), 'Expense', 'Revenue'),
    desc = ifelse(type == 'Expense', str_remove(name, 'diff_value_GGEXP_'), str_remove(name, 'diff_value_GGREV_'))
  ) %>%
  left_join(desc_df) %>%
  mutate(
    collapsed_desc = recode(full_description,
                            `Education` = 'Other',
                            `Economic Affairs` = 'Other',
                            `Recreation, Culture, and Religion` = 'Other',
                            `General Public Services` = 'Other',
                            `Environmental Protection` = 'Other',
                            `Public Order and Safety` = 'Other'
                            ),
    defense_vs_non_defense = ifelse(desc == 'DEF', 'Defense Exp.', ifelse(type == 'Revenue', 'Revenue', 'Non-Defense Exp.'))
  ) %>%
  filter(
    !(type == 'Expense' & desc == 'TOT')
  )

# sum up expense components that have been collapsed
summarized_by_year = group_by(long_rev_expense_components, defense_vs_non_defense, year) %>%
  summarize(
    total_difference = sum(value, na.rm = T)
  )

# get president start/stop years
president_starts_stops = group_by(US_wide_selection, President, president_party) %>%
  summarize(
    start_year = min(year), end_year = max(year)
  ) %>%
  filter(start_year >= min(long_rev_expense_components$year)) %>%
  mutate(
    midpoint = (start_year + end_year)/2,
    pres_last_name = str_extract(President, '([ ]{1}[A-Za-z]+)$') %>% str_trim()
  )

ggplot(summarized_by_year, aes(year, total_difference, fill = defense_vs_non_defense)) +
  geom_bar(stat = 'identity')
filter(summarized_by_year, year == 2019)

# plot everything
ggplot(summarized_by_year, aes(year, total_difference)) +
  geom_rect(data = president_starts_stops, aes(xmin = start_year, xmax = end_year,
                                               x = NULL,  y = NULL, ymin = -6, ymax = 4,
                                               colour = president_party),
            fill = NA,
            show.legend = F,
            size = 0.75,
            stat = 'identity', alpha = 0.3) +
  theme_bw() +
  scale_fill_manual(
    name = '',
    values = c('Defense Exp.' = 'darkblue',
               'Non-Defense Exp.' = 'steelblue',
               'Revenue' = 'orange')
  ) +
  geom_bar(aes(fill= defense_vs_non_defense), stat = 'identity', colour = 'black') +
  # geom_point(data = reg_dat, aes(Year, diff_value_GGNLEND), size = 2.5, shape = 18) +
  labs(
    y = 'Change from Prior Year (% of GDP)\n',
    x = '',
    title = 'Contributions to Changes in Budget Deficits\nU.S. 1975-2018',
    caption = 'Chart: Taylor G. White\nData: OECD, FRED, WDI'
  ) +
  scale_colour_manual(guide = F, values = c('DEM'='#00aef3', 'REP' = '#d8171e')) +
  scale_x_continuous(breaks = seq(1977, max(summarized_by_year$year), by = 4)) +
  geom_text(data = president_starts_stops,
            aes(y = 4.5, x = midpoint, label = pres_last_name, colour = president_party), hjust = 0.5, size = 4.5) +
  # geom_segment(data = president_starts_stops, aes(y = 4, yend = 4, x = start_year, xend = end_year)) +

  theme(
    legend.position = 'top',
    axis.text.x = element_text(angle = 0),
    title = element_text(size = 20),
    axis.text = element_text(size = 16),
    axis.title = element_text(size = 18),
    legend.text = element_text(size = 14)
  ) +

  geom_segment(
    aes(x = 1974, xend = 1974, y = 1.5, yend = 3),
    lineend = 'butt', linejoin = 'mitre',
    size = 1, arrow = arrow(length = unit(0.1, "inches"))
  ) +
  geom_segment(
    aes(x = 1974, xend = 1974, y = -1.5, yend = -3),
    lineend = 'butt', linejoin = 'mitre',
    size = 1, arrow = arrow(length = unit(0.1, "inches"))
  ) +
  geom_text(
    aes(x = 1973, y = 2.5, label = 'Decreases Deficit'), angle = 90, hjust = 0.5, size = 4.5
  ) +
  geom_text(
    aes(x = 1973, y = -2.5, label = 'Increases Deficit'), angle = 90, hjust = 0.5, size = 4.5
  )
ggsave('output/contributions_to_deficits_upd.png', height = 8, width = 10, units = 'in', dpi = 600)

# create the same chart but colored by economic growth
ggplot(US_wide_selection, aes(year, diff_value_GGNLEND_TOT, fill = growth_desc)) +
  geom_rect(data = president_starts_stops, aes(xmin = start_year, xmax = end_year,
                                               x = NULL,  y = NULL, ymin = -6, ymax = 4
                                               ),
            fill = NA,
            colour = 'black', linetype = 'dotted',
            show.legend = F,
            size = 0.25,
            stat = 'identity', alpha = 0.3) +
  theme_bw() +
  geom_bar(stat = 'identity') +
  geom_segment(
    aes(x = 1974, xend = 1974, y = 1.5, yend = 3),
    lineend = 'butt', linejoin = 'mitre',
    size = 1, arrow = arrow(length = unit(0.1, "inches"))
  ) +
  geom_segment(
    aes(x = 1974, xend = 1974, y = -1.5, yend = -3),
    lineend = 'butt', linejoin = 'mitre',
    size = 1, arrow = arrow(length = unit(0.1, "inches"))
  ) +
  geom_text(data = president_starts_stops,
            aes(y = 4.5, x = midpoint, label = pres_last_name, colour = president_party, fill = NA), hjust = 0.5, size = 4.5) +
  geom_text(
    aes(x = 1973, y = 2.5, label = 'Decreased Deficit'), angle = 90, hjust = 0.5, size = 4.5
  ) +
  geom_text(
    aes(x = 1973, y = -2.5, label = 'Increased Deficit'), angle = 90, hjust = 0.5, size = 4.5
  ) +
  scale_fill_hue(
    name = 'Per-Capita Economic Growth'
  ) +
  theme(
    legend.position = 'top',
    axis.text.x = element_text(angle = 0),
    title = element_text(size = 20),
    axis.text = element_text(size = 16),
    axis.title = element_text(size = 18),
    legend.text = element_text(size = 14),
    legend.title = element_text(size = 15)
  ) +
  labs(
    y = 'Deficit Change from Prior Year (% of GDP)\n',
    x = '',
    title = 'Changes in Budget Deficits vs. Economic Growth\nU.S. 1975-2018',
    caption = 'Chart: Taylor G. White\nData: OECD, FRED, WDI'
  ) +
  scale_x_continuous(breaks = seq(1977, 2018, by = 4)) +
  scale_colour_manual(guide = F, values = c('DEM'='#00aef3', 'REP' = '#d8171e'))
ggsave('output/contributions_to_deficits_by_growth.png', height = 8, width = 10, units = 'in', dpi = 600)


# look at ITA to RCA vs SVG to RCA with veins to LCX

library(easypackages)
libraries(c("survival","rms","Hmisc","survminer","tidyverse",
	"tidylog", "Publish"))

# get the whole dataset here.

df <- read_csv("D:/lita_bita3/complete_dataset.csv")

# some small changes before tables...

df$diabetes[df$diabetes == 8]<- 0

df$left_main_disease[df$left_main_disease == 2]<- 0

df2 <- df %>% filter(distals_n != 1)

dim(df)

dim(df2)

# save this dataset as the actual final complete dataset.

write_csv(df2, "D:/lita_bita3/complete_dataset_final.csv")

glimpse(df2)

df2$surv_years = (1 + df2$survival_days)/365.24

df2$age10 = df2$age_at_surgery/10

df2$oldage <- with(df2, ifelse(age_at_surgery > 70, 1, 0))

df2 = data.frame(df2)

df2$bima = factor(df2$bima, levels = c(0,1), labels = c("sita","bita"))

df2$diabetes = factor(df2$diabetes, levels = c(0,1), labels = c("no_dm","dm"))

df2$gender = factor(df2$gender, levels = c(1,2), labels = c("male","female"))

df2$oldage = factor(df2$oldage, levels = c(0,1),
                    labels = c("young","old"))

m2 = coxph(Surv(surv_years, died) ~ bima + oldage + art_hypertension +
	smoker + copd + diabetes + pad + pre_dialysis + gender +
	left_main_disease + prior_pci + pre_stroke, data = df2)

summary(m2)

sub_cox = subgroupAnalysis(m2, df2, treatment = "bima",
	subgroups = c("diabetes","gender","oldage"))

res <- summary(sub_cox)

str(res)

rest <- tibble(res)

str(rest)

write_csv(rest, "D:/lita_bita3/rest.csv")

tb <- rest %>% filter(subgroups == 'oldage')

tb2 <- (tb[, c(1,2,9:13)])

tb2

write_csv(tb2, "D:/lita_bita3/age_interact.csv")

# now to compare groups:-

glimpse(df2)

## lima + svg to lcx = svg to rca vs lima + rima to rca + svg to lcx

lcx_vein = df2 %>% filter(lcx_graft == 1)

lcx_vein %>% group_by(bima) %>% count(rca_graft)

# some patients may not have an RCA graft at all.

lcx_vein2 = lcx_vein %>% filter(rca_graft != 0)

lcx_vein2 %>% group_by(bima) %>% count(rca_graft)

# now lcx_vein2 has vein to lcx and either svg to rima to rca.

bima_rca = coxph(Surv(surv_years, died) ~ bima + age10 + art_hypertension +
	smoker + copd + diabetes + pad + pre_dialysis + gender +
	left_main_disease + prior_pci + pre_stroke, data = lcx_vein2)

summary(bima_rca)

# lima + svg to rca + bima to lcx VS lima + svg to rca + svg to lcx

rca_vein = df2 %>% filter(rca_graft == 1)

rca_vein2 = rca_vein %>% filter(lcx_graft != 0)

rca_vein2 %>% group_by(bima) %>% count(lcx_graft)

rca_vein2$keep = with(rca_vein2, ifelse(bima == "sita" & lcx_graft == 1, 1,
	ifelse(bima == "bita" & lcx_graft %in% c(3,4), 1, 0)))

rca_vein2 %>% count(keep)

rca_vein3 =  rca_vein2 %>% filter(keep == 1)

rca_vein3 %>% count(bima)

bima_lcx = coxph(Surv(surv_years, died) ~ bima + age10 + art_hypertension +
	smoker + copd + diabetes + pad + pre_dialysis + gender +
	left_main_disease + prior_pci + pre_stroke, data = rca_vein3)

summary(bima_lcx)


id__19__84747__harmonic_mean_TEPS <- 1.680e+08

id__19__84747__total_gpus <- 16

vect__19 <- c(get(paste('id__19__84747__','harmonic_mean_TEPS',sep='')))

labels_x <- labels_x <- c('TEPS')

id__20__84746__harmonic_mean_TEPS <- 1.977e+08

id__20__84746__total_gpus <- 16

vect__20 <- c(get(paste('id__20__84746__','harmonic_mean_TEPS',sep='')))

id__21__84744__harmonic_mean_TEPS <- 2.160e+08

id__21__84744__total_gpus <- 16

vect__21 <- c(get(paste('id__21__84744__','harmonic_mean_TEPS',sep='')))

id__22__31694__harmonic_mean_TEPS <- 2.334e+08

id__22__31694__total_gpus <- 16

vect__22 <- c(get(paste('id__22__31694__','harmonic_mean_TEPS',sep='')))

id__23__31691__harmonic_mean_TEPS <- 2.516e+08

id__23__31691__total_gpus <- 16

vect__23 <- c(get(paste('id__23__31691__','harmonic_mean_TEPS',sep='')))

labels_y <- c("sf19","sf20","sf21","sf22","sf23")

mat <- matrix(c(vect__19,vect__20,vect__21,vect__22,vect__23), nrow = 5, ncol = length(labels_x), byrow = TRUE, dimnames = list(labels_y, labels_x))

par(xpd = TRUE)
    matplot(mat, axes = FALSE, xlab='scale factor (#)', ylab = 'edges per second (s)',
        main = 'Execution on Fermi. Scale factor comparison', col = topo.colors(length(rownames(mat)), alpha=1),
        type='o', lty=1, lwd=1, pch=3)
        axis(1, at = 1:length(colnames(t(mat))), labels= labels_y)
        axis(2)
        legend('top', fill = topo.colors(length(rownames(mat)), alpha=1),
        legend = labels_x)


library(pheatmap)
library(RColorBrewer)
library(readxl)
library(ggplot2)

cellchat<-read_excel('./CELLCHAT_GENE_hd_specific.xlsx')
deg_b<-read.csv('./differential_marker_b.csv')
deg_mono<-read.csv('./differential_marker_mono.csv')
features<-read.csv('./sle_feature_importance_bulk.csv')

####feature importance cellchat part
cell<-intersect(cellchat$`...1`,features$feature_importance)

####feature importance DEG part
deg_b<-intersect(deg_b$gene,features$feature_importance)
deg_mono<-intersect(deg_mono$gene,features$feature_importance)
deg<-unique(c(deg_b,deg_mono))
deg<-setdiff(deg,cell)

sle<-read.csv('../RNA_seq_for_autoimmune_disease/GSE164457_SLE_fpkm.csv',row.names=1)
hd1<-read.csv('../RNA_seq_for_autoimmune_disease/health_bulk/GSE169687_HC_fpkm.csv',sep=',',row.names=1)
hd2<-read.csv('../RNA_seq_for_autoimmune_disease/health_bulk/GSE169687_HC_24wk_fpkm.csv',sep=',',row.names=1)
colnames(hd1)<-paste('health',seq(1,14,1),sep='')
colnames(hd2)<-paste('health',seq(15,41,1),sep='')

sle<-sle[features$feature_importance,]
hd1<-hd1[features$feature_importance,]
hd2<-hd2[features$feature_importance,]

data<-cbind(sle,hd1,hd2)

options(repr.plot.height=13,repr.plot.width=30)
p <- pheatmap(log2(data+1),
         show_colnames = T,scale='row',show_rownames = T,cluster_col=F,
         col = rev(brewer.pal(n =5, name = "RdBu")))
p

options(repr.plot.height=5,repr.plot.width=30)
p1 <- pheatmap(log2(data+1)[cell,],
         show_colnames = T,scale='row',show_rownames = T,cluster_col=F,
         col = rev(brewer.pal(n =5, name = "RdBu")))
p1
#ggsave("../sle_picture/Fig8/cellchat_heatmap.pdf",p1,height=5,width=30)

options(repr.plot.height=10.68,repr.plot.width=30)
p2 <- pheatmap(log2(data+1)[deg,],
         show_colnames = T,scale='row',show_rownames = T,cluster_col=F,
         col = rev(brewer.pal(n =5, name = "RdBu")))
p2
#ggsave("../sle_picture/Fig8/DEG_heatmap.pdf",p2,height=10.68,width=30)


\name{hc_centered_text-HilbertCurve-method}
\alias{hc_centered_text,HilbertCurve-method}
\alias{hc_centered_text}
\title{
Add text to the center of the block
}
\description{
Add text to the center of the block
}
\usage{
\S4method{hc_centered_text}{HilbertCurve}(object, ir = NULL, labels, x1 = NULL, x2 = NULL, gp = gpar(), ...)
}
\arguments{

  \item{object}{A \code{\link{HilbertCurve-class}} object.}
  \item{ir}{an \code{\link[IRanges:IRanges-constructor]{IRanges}} object that contains positions which correspond to text. The middle points of the intervals will be the positions of the text.}
  \item{labels}{text corresponding to intervals in \code{ir}.}
  \item{x1}{if start positions are not integers, they can be set by \code{x1}.}
  \item{x2}{if end positions are not integers, they can be set by \code{x2}.}
  \item{gp}{graphic parameters for text. It should be specified by \code{\link[grid]{gpar}}.}
  \item{...}{pass to \code{\link[grid]{grid.text}}. E.g. you can set text justification by \code{just} here.}

}
\details{
If the interval is long enough that it represents as a block in the 2D space, the corresponding
label is put approximately at center (or at least inside) of the block.

Please use \code{\link{hc_text,HilbertCurve-method}} directly.
}
\value{
\code{NULL}
}
\seealso{
It is used in \code{\link{hc_map,GenomicHilbertCurve-method}} to put chromosome names in the center
of chromosomes.
}
\author{
Zuguang Gu <z.gu@dkfz.de>
}
\examples{
hc = HilbertCurve(1, 10)
hc_rect(hc, x1 = c(1, 3, 7), x2 = c(3, 7, 10), gp = gpar(fill = 2:5))
hc_centered_text(hc, x1 = 1, x2 = 3, labels = "A")
hc_centered_text(hc, x1 = 3, x2 = 7, labels = "B")
hc_centered_text(hc, x1 = 7, x2 = 10, labels = "C")
}