################################################################################
######################### INTERNATIONAL WOMEN'S DAY ############################
################################################################################

# =============================== #
#### 0. LOAD DATA AND SET PATH ####
# =============================== #

# Set the path
setwd("~/Desktop/Projects/Global-Preferences-Survey/")

# Source helper functions
source("functions/helper_functions/SourceFunctions.r")
SourceFunctions(path = "functions/")
SourceFunctions(path = "functions/helper_functions/")
SourceFunctions(path = "New_Analysis/functions")

# Load libraries
LoadRequiredLibraries()

# Load the data
data_all <- LoadData()
dataUIS  <- fread("tmp/UISdataset.csv")

# ========================= #
#### 1. PREPARE THE DATA ####
# ========================= #

data_all <- PrepareData(data_all)

# Use only the complete dataset
dataComplete <- data_all$data[complete.cases(data_all$data)]
dataComplete[data_all$world_area, area := i.region, on = "country"]

dataComplete[, logAvgGDPpc := log(avgGDPpc), by = "country"]
dataComplete[, avgGDPpc := NULL]

# Select only interesting indicator
dataUIS <- dataUIS %>%
  mutate(country = Country, isocode = LOCATION, year = TIME) %>%
  filter(INDICATOR == "FPERSP_TFTE") %>%
  select(country, isocode, year, Value)

dataUIS[country == "Czechia", country := "Czech Republic"]
dataUIS[country == "Republic of Moldova", country := "Moldova"]
dataUIS[country == "Iran (Islamic Republic of)", country := "Iran"]
dataUIS[country == "Bosnia and Herzegovina", country := "Bosnia Herzegovina"]
dataUIS[country == "United Republic of Tanzania", country := "Tanzania"]
dataUIS[country == "Viet Nam", country := "Vietnam"]

dataUIS[, avgFemalePerc := mean(Value), by = .(country)]

# ======================== #
#### 2. GENDER ANALYSIS ####
# ======================== #

getmode <- function(v) {
  uniqv <- unique(v)
  uniqv[which.max(tabulate(match(v, uniqv)))]
}

# Normalize data by gender
dataComplete[, totalGender := .N, by = .(country, gender)]
dataComplete[, fracN := .N / unique(totalGender) / 2,
             by = .(gender, subj_math_skills, country)]
dataComplete[, meanSMS := mean(subj_math_skills), by = .(country, gender)]
dataComplete[, meanPopulation := mean(subj_math_skills), by = "country"]

dataMeanMale   <- dataComplete[gender == 0, .(meanSMS = unique(meanSMS)), by = "country"]
dataMeanFemale <- dataComplete[gender == 1, .(meanSMS = unique(meanSMS)), by = "country"]

# Select only differences
dataMean <- dataMeanMale[dataMeanFemale, `:=` (diffMean = meanSMS - i.meanSMS),
                         on = "country"]
dataMean[dataComplete, meanPopulation := i.meanPopulation, on = "country"]
dataMean[dataComplete, area := i.area, on = "country"]

# Prepare heat map for subjective math skills base
nSample <-  dataComplete[, .N, by = c("country", "gender")]
nSample$total <- nSample$N
nSample$N <- NULL

# Create heat map
x <- unique(dataComplete$country)
y <- min(dataComplete$subj_math_skills):max(dataComplete$subj_math_skills)
g <- unique(dataComplete$gender)
dataHeatMap <- expand.grid(country = x, Y = y, gender = g)

dataHeatMap <- merge(dataHeatMap,
                     dataComplete[, .N, by = c("subj_math_skills", "country", "gender")],
                     by.x = c("Y", "country", "gender"),
                     by.y = c("subj_math_skills", "country", "gender"))
# Make it a data table for comfortable use
setDT(dataHeatMap)
# Merge with sample
dataHeatMap[nSample, total := i.total, on = c("country", "gender")]
dataHeatMap[, fracN := N / total / 2, by = c("country", "gender")]
# Set the variables to the correct format
dataHeatMap[, `:=` (Y       = as.factor(Y),
                    country = as.character(country),
                    fracN   = as.numeric(fracN),
                    gender  = as.numeric(gender))]
dataHeatMap[, `:=` (N = NULL, total = NULL)]
# Fill the missing data
for(C in unique(dataHeatMap$country)) {
  for (idx in unique(dataHeatMap$Y)) {
    for (G in unique(dataHeatMap$gender)) {
      if (nrow(dataHeatMap[country == C & Y == idx & gender == G]) == 0) {
        newRow <- data.table(Y = as.numeric(idx),
                             country = as.character(C),
                             fracN = as.numeric(0),
                             gender = as.numeric(G))
        dataHeatMap <- rbind(dataHeatMap, newRow)
      }
    }
  }
}

# Summarise the difference between men and women by country and by subjective
# math skills
differenceSMS <- dataHeatMap[gender == 1][dataHeatMap[gender == 0],
                                          .(diff = fracN - i.fracN,
                                            Y = i.Y,
                                            country = i.country),
                                          on = c("country", "Y")]
# Add the mean to be able to plot it later
differenceSMS[dataMean, diffSMS := i.diffMean, on = "country"]

dataMean[dataComplete, logGDP := i.logAvgGDPpc, on = "country"]
dataMean[dataComplete, isocode := i.isocode, on = "country"]

# TODO: needs to check the gender index
extra <- dataMean[dataUIS, avgFemalePerc := i.avgFemalePerc, on = "country"]
extra[data_all$UNindex, score := i.Value, on = "country"]
extra[data_all$timeWomenSuff, date := i.Date, on = "country"]
extra[data_all$WEF, rank := i.Score, on = "country"]
extra[data_all$ratioLabor, ratioLabor := i.avgRatioLabor, on = "country"]
extra$genderIndex <- GenderIndexPCA(extra[, c(8:12)])

extra <- extra[!is.na(avgFemalePerc)]

# ============= #
#### 3. PLOT ####
# ============= #

# Difference between mean of subjective math skills between men and women by
# country, ordered by difference
meanDiff <- ggplot(dataMean, aes(x = reorder(country, diffMean), y = diffMean)) +
  geom_point(size = 3) +
  geom_hline(yintercept = 0, col = "red") +
  theme_bw(base_size = 15) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5, size = 15),
        axis.text.y = element_text(size = 15)) +
  ylab("Mean difference of subjective math skills") + xlab("")# +
  labs(title = "Difference of the mean of subjective math skills between men and women by country")
ggsave(filename = "PublicPosts/plots/difference_mean_subjMathSkills.png")

# Difference between mean of subjective math skills between men and women by
# country, ordered by log GDP
modelGDP <- lm(diffMean ~ logGDP, data = extra)

labels <- data.table(correlation = paste0("Correlation = ", round(cor(extra$logGDP, extra$diffMean), 4)),
                     pvalue = paste0("P-value = ", round(summary(modelGDP)$coefficients[, "Pr(>|t|)"][2], 4)))

ggplot(extra, aes(x = logGDP, y = diffMean)) +
  geom_point(shape = 21, size = 3, fill = "white") +
  geom_text(aes(label = isocode), color = "gray20", size = 3,
            check_overlap = F, hjust = -0.5) +
  geom_smooth(aes(x = logGDP, y = diffMean), method = "lm", se = T, col = "red") +
  geom_text(x = min(extra$logGDP) + 0.5, y = max(extra$diffMean) - 0.01,
            data = labels, aes(label = correlation), hjust = 0) +
  geom_text(x = min(extra$logGDP) + 0.5, y = max(extra$diffMean) - 0.1,
            data = labels, aes(label = pvalue), hjust = 0) +
  ylab("Difference of the mean") + xlab("Country") +
  labs(title = "Difference of the mean of subjective math skills between men and women by country")

# Difference between mean of subjective math skills between men and women by
# country, ordered by GEI
modelGEI <- lm(diffMean ~ genderIndex, data = extra)

labels <- data.table(correlation = paste0("Correlation = ", round(cor(extra$genderIndex, extra$diffMean), 4)),
                     pvalue = paste0("P-value = ", round(summary(modelGEI)$coefficients[, "Pr(>|t|)"][2], 4)))

ggplot(extra, aes(x = genderIndex, y = diffMean)) +
  geom_point(shape = 21, size = 3, fill = "white") +
  geom_text(aes(label = isocode), color = "gray20", size = 3,
            check_overlap = F, hjust = -0.5) +
  geom_smooth(aes(x = genderIndex, y = diffMean), method = "lm", se = T, col = "red") +
  geom_text(x = min(extra$genderIndex) + 0.5, y = max(extra$diffMean) - 0.01,
            data = labels, aes(label = correlation), hjust = 0) +
  geom_text(x = min(extra$genderIndex) + 0.5, y = max(extra$diffMean) - 0.1,
            data = labels, aes(label = pvalue), hjust = 0) +
  ylab("Difference of the mean") + xlab("Country") +
  labs(title = "Difference of the mean of subjective math skills between men and women by country")

# Difference between mean of subjective math skills between men and women by
# country, ordered by log fraction of women in STEM
modelFratio <- lm(diffMean ~ avgFemalePerc, data = extra)

labels <- data.table(correlation = paste0("Correlation = ", round(cor(extra$avgFemalePerc, extra$diffMean), 4)),
                     pvalue = paste0("P-value = ", round(summary(modelFratio)$coefficients[, "Pr(>|t|)"][2], 4)))

ggplot(extra, aes(x = avgFemalePerc, y = diffMean)) +
  geom_point(shape = 21, size = 3, fill = "white") +
  geom_text(aes(label = isocode), color = "gray20", size = 3,
            check_overlap = F, hjust = -0.5) +
  geom_smooth(aes(x = avgFemalePerc, y = diffMean), method = "lm", se = T, col = "red") +
  geom_text(x = min(extra$avgFemalePerc) + 0.5, y = max(extra$diffMean) - 0.01,
            data = labels, aes(label = correlation), hjust = 0) +
  geom_text(x = min(extra$avgFemalePerc) + 0.5, y = max(extra$diffMean) - 0.1,
            data = labels, aes(label = pvalue), hjust = 0) +
  ylab("Difference of the mean") + xlab("Country") +
  labs(title = "Difference of the mean of subjective math skills between men and women by country")

# Single countries plot

# Max gender differences in favor of women
kazakhstan <-
  ggplot(dataComplete[country == "Russia"]) +
  geom_col(aes(x = factor(subj_math_skills), y = fracN, fill = factor(gender)), position = "dodge") +
  scale_fill_manual(values = c("#999999", "#E69F00"), name = "Gender",
                    labels = c("Male", "Female")) +
  geom_vline(xintercept = dataComplete[gender == 0 & country == "Russia", meanSMS],
             col = "grey40", lty = "dashed", size = 1.5, show.legend = T) +
  geom_vline(xintercept = dataComplete[gender == 1 & country == "Russia", meanSMS],
             col = "darkgoldenrod1", size = 1.5, show.legend = T) +
  xlab("Subjective Math Skills") + ylab("Percentage over the whole country") +
  labs(title = "Russia") + ylim(c(0, 0.125)) +
  theme_bw()

# Max gender differences in favor of men
afghanistan <-
  ggplot(dataComplete[country == "United States"]) +
  geom_col(aes(x = factor(subj_math_skills), y = fracN, fill = factor(gender)), position = "dodge") +
  scale_fill_manual(values = c("#999999", "#E69F00"), name = "Gender",
                    labels = c("Male", "Female")) +
  geom_vline(xintercept = dataComplete[gender == 0 & country == "United States", meanSMS],
             col = "grey40", lty = "dashed", size = 1.5, show.legend = T) +
  geom_vline(xintercept = dataComplete[gender == 1 & country == "United States", meanSMS],
             col = "darkgoldenrod1", size = 1.5, show.legend = T) +
  xlab("Subjective Math Skills") + ylab("") +
  labs(title = "United States") + ylim(c(0, 0.125)) +
  theme_bw()

ggpubr::ggarrange(kazakhstan, afghanistan, common.legend = TRUE, align = "v")

# Similar mean, very different distribution
germany <-
  ggplot(dataComplete[country == "Germany"]) +
  geom_col(aes(x = factor(subj_math_skills), y = fracN, fill = factor(gender)), position = "dodge") +
  scale_fill_manual(values = c("#999999", "#E69F00"), name = "Gender",
                    labels = c("Male", "Female")) +
  geom_vline(xintercept = dataComplete[gender == 0 & country == "Germany", meanSMS],
             col = "grey40", lty = "dashed", size = 1.5, show.legend = T) +
  geom_vline(xintercept = dataComplete[gender == 1 & country == "Germany", meanSMS],
             col = "darkgoldenrod1", size = 1.5, show.legend = T) +
  xlab("Subjective Math Skills") + ylab("") +
  labs(title = "Germany") + ylim(c(0, 0.13)) +
  theme_bw(base_size = 15)

italy <-
  ggplot(dataComplete[country == "Italy"]) +
  geom_col(aes(x = factor(subj_math_skills), y = fracN, fill = factor(gender)), position = "dodge") +
  scale_fill_manual(values = c("#999999", "#E69F00"), name = "Gender",
                    labels = c("Male", "Female")) +
  geom_vline(xintercept = dataComplete[gender == 0 & country == "Italy", meanSMS],
             col = "grey40", lty = "dashed", size = 1.5, show.legend = T) +
  geom_vline(xintercept = dataComplete[gender == 1 & country == "Italy", meanSMS],
             col = "darkgoldenrod1", size = 1.5, show.legend = T) +
  xlab("Subjective Math Skills") + ylab("Percentage over the whole country") +
  labs(title = "Italy") + ylim(c(0, 0.13)) +
  theme_bw(base_size = 15)

together <- ggpubr::ggarrange(italy, germany, common.legend = TRUE, align = "v")

ggsave(filename = "PublicPosts/plots/together_histograms.png", together)

# Plot the heat map of the gender differences distributions ordered by difference
heatmap_diff <- ggplot(differenceSMS) +
  geom_tile(aes(x = reorder(country, diffSMS), y = Y, fill = diff)) +
  scale_fill_gradient2(low = "blue", high = "red",
                       limits = c(-0.065, 0.065)) +
  labs(fill = "Difference") +
  xlab("Country") + ylab("Subjective Math Skills") +
  theme_bw(base_size = 15) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5, size = 15),
        axis.text.y = element_text(size = 15))
ggsave(filename = "PublicPosts/plots/heatmap_countries.png", heatmap_diff)


REBOL []

;*** TOUCHDOWN CLIENT ***

touchdown-client: make object!
[

  key-cache: copy []
  deferred-keys: copy []
  http-deferred-keys: copy []

  decrypt: func
  [
    {Generic decryption function}
    msg [binary!]
    k [binary!]
    /local res dec-port crypt-str
  ]
  [
    crypt-str: 8 * length? k
    dec-port: open make port!
    [
      scheme: 'crypt
      algorithm: 'rijndael
      direction: 'decrypt
      strength: crypt-str
      key: k
      padding: true
    ]
    insert dec-port msg
    update dec-port
    res: copy dec-port
    close dec-port
    return to-string res
  ]

  encrypt: func
  [
    msg [binary! string!]
    k [binary!]
    /local res enc-port crypt-str
  ]
  [
    crypt-str: 8 * length? k
    enc-port: open make port!
    [
      scheme: 'crypt
      algorithm: 'rijndael
      direction: 'encrypt
      strength: crypt-str
      key: k
      padding: true
    ]
    insert enc-port msg
    update enc-port
    res: copy enc-port
    close enc-port
    return res
  ]

  negotiate: func
  [
    {Negotiates a session strengh and public rsa keyi with a touchdown
     server.}
    dest [url!]
    /local serv-strength
  ]
  [
    if not found? find key-cache mold dest
    [
      serv-strength: rexec/with [negotiate] dest

      if not none? serv-strength
      [
        append key-cache mold dest
        append/only key-cache serv-strength
      ]
      return serv-strength
    ]
    return select key-cache mold dest
  ]

  generate-session-key: func
  [
    {Idem.}
    crypt-str [integer!]
  ]
  [
    return copy/part checksum/secure mold now 16
  ]

  secure-result-available?: func
  [
    {Is a deferred http result available}
    index [integer!]
  ]
  [
    result-available? index
  ]

  get-secure-result: func
  [
    {Returns a deferred and secured http request}
    index [integer!]
    /local s-key res ret
  ]
  [
    s-key: select http-deferred-keys index
    if none? s-key
    [
      make error! join {Rugby error: No session key to match}
        { the deferred http request}
    ]
    res: get-http-result index

    if object? res [ return remake-error res ]

    ;Cleanup or key list
    remove remove find http-deferred-keys index
    set/any 'ret pick get-return-message res s-key 1

    either object? get/any 'ret
    [
      return rugby-client/remake-error ret
    ]
    [
      return get/any 'ret
    ]
  ]

  wait-for-secure-result: func
  [
    {Waits for a secured result}
    index [integer!]
  ]
  [
    until [secure-http-result-available? index ]
    get-secure-http-result index
  ]

  generate-message: func
  [
    stm [block!]
    s-key [binary!]
    r-key [object!]
    /local blk-stm p-blk
  ]
  [
    blk-stm: copy [ sexec-srv ]
    p-blk: copy []

    append p-blk rsa-encrypt r-key s-key
    append p-blk encrypt mold stm s-key
    append/only blk-stm p-blk
    return blk-stm
  ]

  get-return-message: func
  [
    stm
    s-key [binary!]
    /local ret
  ]
  [
    set/any 'ret do  decrypt stm s-key
    return get/any 'ret
  ]

  sexec: func
  [
    {A secure exec facility a la rexec for /Pro and /COmmand users}
    stm [any-block!]
    /with
      dest [url!]
    /deferred
    /local port sst crypt-str s-key ps-key r-key g-stm def-index
  ]
  [
    port: either with [ dest] [http://localhost:8002]

    sst: negotiate port

    if none? sst [print "no sst" return none]

    either (crypt-strength? = 'full)
    [
      either (first sst) = 'full
      [
        crypt-str: 128
      ]
      [
        crypt-str: 56
      ]
      ]
    [
      crypt-str: 56
    ]

    ;generate our session-key
    s-key: generate-session-key crypt-str

    ;get and initialize an rsa-key from the server's public key (second sst)
    ps-key: second sst
    r-key: rsa-make-key
    r-key/n: ps-key
    r-key/e: 3

    ;generate our sexec message
    g-stm: generate-message stm s-key r-key

    either not deferred
    [
      ;A heavy one: get the first element of the decrypted return message
      ;of you request over http
      do get-return-message rexec/with g-stm port s-key
    ]
    [
      ;What's our http-index
      def-index: rexec/with/deferred g-stm port s-key 1
      repend http-deferred-keys [def-index s-key]
      return def-index
    ]
  ];sexec

];touchdown-client

set 'sexec get in touchdown-client 'sexec
set 'secure-result-available? get in touchdown-client 'secure-result-available?
set 'wait-for-secure-result get in touchdown-client 'wait-for-secure-result
set 'get-secure-result get in touchdown-client 'get-secure-result


p = bio.snowcrab::snowcrab_carstm( DS="parameters",
                                   assessment.years=1999:2019 )

bio = carstm_summary(p=p, operation="load_spacetime_biomass",carstm_model_label=p$carstm_model_label  )
num = carstm_summary(p=p, operation="load_spacetime_number", carstm_model_label=p$carstm_model_label  )

u = which.max( bio[,"2019"] )
dimnames(bio)
# givem the AUID and years
dimnames(bio)$AUID[ u]

M = snowcrab_carstm( p=p, DS="carstm_inputs" )  # will redo if not found M[M$AUID==dimnames(bio)$AUID[ u] & M$year==2019 ,]

# to plot:

sppoly = areal_units( p=p )  # to reload

vn = "pred"
sppoly@data[,vn] = bio[,"2019"] # adds 2019 data to polygons

brks = interval_break(X= sppoly[[vn]], n=length(p$mypalette),
                      style="quantile")
spplot( sppoly, vn, col.regions=p$mypalette, main=vn, at=brks, sp.layout=p$coastLayout, col="transparent" )

sppoly@data[u,vn] = 10000  # force to go out of range

spplot( sppoly, vn, col.regions=p$mypalette, main=vn, at=brks, sp.layout=p$coastLayout, col="transparent" )

#determine which station ID's from survey are associated with which AU's for the model run?

#see line 215 of snowcrab_carstm.R

crs_lonlat = sp::CRS(projection_proj4string("lonlat_wgs84"))
sppoly = areal_units( p=p )  # will redo if not found

M$AUID = over( SpatialPoints( M[, c("lon", "lat")], crs_lonlat ), spTransform(sppoly, crs_lonlat ) )$AUID # match each datum to an area

#--------------------------------------------------------------------------------

N = snowcrab.db( p=p, DS="biological_data" )

 N$density = N$totno /  N$data_offset

hist( N$density  )

#compare to:

hist( N$density[ which(N$yr==2019)] )
> > > > > >
  > > >
  > > >


#Tarini 10032020
#Figure 1A
library(tidyverse)
library(vegan)

#Getting SG Labels and Median Diversity for the three stages
SG_Species <- read.table("../Data/Suppl1_SG.txt",sep="\t",row.names=1,header=TRUE)
SG_Sample_Details <- data.frame(t(rbind(as.data.frame(strsplit(rownames(SG_Species),"_"))[1,],as.data.frame(strsplit(rownames(SG_Species),"_"))[4,])),row.names=rownames(SG_Species))
colnames(SG_Sample_Details) <- c("SampleID","Stage")
SG_Sample_Details$Stage_Individual <- paste0(SG_Sample_Details$SampleID,"_",SG_Sample_Details$Stage)
SG_MedianDiversity_Stages <- as.data.frame(aggregate(as.data.frame(diversity(SG_Species,index="simpson")),by=list(SG_Sample_Details$Stage_Individual),FUN=median)[,-1])
rownames(SG_MedianDiversity_Stages) <- aggregate(as.data.frame(diversity(SG_Species)),by=list(SG_Sample_Details$Stage_Individual),FUN=median)[,1]
colnames(SG_MedianDiversity_Stages) <- "MedianDiversity"
Labels <- read.table("../Data/TariniLabels_edit.txt",sep="\t",row.names=1,header=TRUE)
SG_Labels <- Labels[Labels$Country == "SG",]
temp_sample_tags <- cbind(SG_Sample_Details[rownames(SG_Labels),],SG_Labels$Status)[,c(2:4)] %>% distinct
rownames(temp_sample_tags) <- temp_sample_tags[,2]
SG_MedianDiversity_Stages <- as.data.frame((cbind(temp_sample_tags,SG_MedianDiversity_Stages[rownames(temp_sample_tags),])))
colnames(SG_MedianDiversity_Stages) <- c("Stage","Stage_Individuals","Status","MedianDiversity")
SG_MedianDiversity_Stages$Stage <- ifelse(SG_MedianDiversity_Stages$Stage == "INITIAL","PRE",ifelse(SG_MedianDiversity_Stages$Stage == "CLOSING","DURING","POST"))

#Getting CA Labels and Median Diversity for the three stages
CA_Species <- read.table("../Data/Suppl1_CA_Final.txt",sep="\t",row.names=1,header=TRUE)
colnames(CA_Species) <- sub("s__","",colnames(CA_Species))
CA_Labels <- Labels[Labels$Country == "CA",]
CA_MedianDiversity_Stages <- as.data.frame(cbind(ifelse(rownames(CA_Labels) %in% grep("E0",rownames(CA_Labels),value=TRUE),"PRE",ifelse(rownames(CA_Labels) %in% grep("E7",rownames(CA_Labels),value=TRUE),"DURING","POST")),rownames(CA_Labels),as.character(CA_Labels$Status),as.numeric(diversity(CA_Species[rownames(CA_Labels),],index="simpson"))))
colnames(CA_MedianDiversity_Stages) <- c("Stage","Stage_Individuals","Status","MedianDiversity")
CA_MedianDiversity_Stages <- CA_MedianDiversity_Stages[CA_MedianDiversity_Stages$Status != "C",]
CA_MedianDiversity_Stages$MedianDiversity <- as.numeric(as.vector(CA_MedianDiversity_Stages$MedianDiversity))

#Rank Median Diversities within Cohorts
#Median Simpson Diversities were range normalized within Cohorts to remove Cohort-specific variations in Simpson Diversities
range_scale <- function(x)
{
        y <- (x-min(x))/(max(x)-min(x));
        return(y);
}
CA_MedianDiversity_Stages$MedianDiversity <- range_scale(CA_MedianDiversity_Stages$MedianDiversity)
SG_MedianDiversity_Stages$MedianDiversity <- range_scale(SG_MedianDiversity_Stages$MedianDiversity)

#Getting Names
SG_MedianDiversity_Stages$Stage_Individuals <- t(as.data.frame(strsplit(as.character(SG_MedianDiversity_Stages$Stage_Individuals),"_"))[1,])[,1]
CA_MedianDiversity_Stages$Stage_Individuals <- t(as.data.frame(strsplit(as.character(CA_MedianDiversity_Stages$Stage_Individuals),"E"))[1,])[,1]

#Combine and retain only Individuals with all the time_points
R_MedianDiversity_Stages <- as.data.frame(rbind(CA_MedianDiversity_Stages[CA_MedianDiversity_Stages$Status=="R",],SG_MedianDiversity_Stages[SG_MedianDiversity_Stages$Status=="R",]))
R_1 <- R_MedianDiversity_Stages
R_remove_rows <- c("218RZ_INITIAL","218RZ_POST","808ZJ_POST","808ZJ_INITIAL")
R_MedianDiversity_Stages <- R_MedianDiversity_Stages[setdiff(rownames(R_MedianDiversity_Stages),R_remove_rows),]
R_MedianDiversity_Stages$Stage <- factor(R_MedianDiversity_Stages$Stage,levels=c("PRE","DURING","POST"))

NR_MedianDiversity_Stages <- as.data.frame(rbind(CA_MedianDiversity_Stages[CA_MedianDiversity_Stages$Status=="NR",],SG_MedianDiversity_Stages[SG_MedianDiversity_Stages$Status=="NR",]))
NR_remove_rows <- c("412AD_INITIAL","412AD_POST","664SB_POST","664SB_CLOSING","987AB_INITIAL","987AB_POST")
NR_1 <- NR_MedianDiversity_Stages
NR_MedianDiversity_Stages <- NR_MedianDiversity_Stages[setdiff(rownames(NR_MedianDiversity_Stages),NR_remove_rows),]
NR_MedianDiversity_Stages$Stage <- factor(NR_MedianDiversity_Stages$Stage,levels=c("PRE","DURING","POST"))

R_summary <- data.frame(Stage=unique(factor(R_MedianDiversity_Stages$Stage,levels=c("PRE","POST","DURING"))), n=tapply(R_MedianDiversity_Stages$MedianDiversity, factor(R_MedianDiversity_Stages$Stage,levels=c("PRE","DURING","POST")), length), mean=tapply(R_MedianDiversity_Stages$MedianDiversity, factor(R_MedianDiversity_Stages$Stage,levels=c("PRE","DURING","POST")), median))
R_summary$sd <- tapply(R_MedianDiversity_Stages$MedianDiversity, factor(R_MedianDiversity_Stages$Stage,levels=c("PRE","DURING","POST")), sd)
R_summary$sem <- R_summary$sd/sqrt(R_summary$n-1)
R_summary$lower_25 <- R_summary$mean + qt((1-0.25)/2, df=R_summary$n-1)*R_summary$sem
R_summary$higher_25 <- R_summary$mean + qt((1+0.25)/2, df=R_summary$n-1)*R_summary$sem
R_summary$lower_50 <- R_summary$mean + qt((1-0.50)/2, df=R_summary$n-1)*R_summary$sem
R_summary$higher_50 <- R_summary$mean + qt((1+0.50)/2, df=R_summary$n-1)*R_summary$sem
R_summary$lower_75 <- R_summary$mean + qt((1-0.75)/2, df=R_summary$n-1)*R_summary$sem
R_summary$higher_75 <- R_summary$mean + qt((1+0.75)/2, df=R_summary$n-1)*R_summary$sem
R_summary$lower_80 <- R_summary$mean + qt((1-0.80)/2, df=R_summary$n-1)*R_summary$sem
R_summary$higher_80 <- R_summary$mean + qt((1+0.80)/2, df=R_summary$n-1)*R_summary$sem
rownames(R_summary) <- c("PRE","DURING","POST")
R_summary$Stage <- c(1,2,3)

NR_summary <- data.frame(Stage=unique(factor(NR_MedianDiversity_Stages$Stage,levels=c("PRE","POST","DURING"))), n=tapply(NR_MedianDiversity_Stages$MedianDiversity, factor(NR_MedianDiversity_Stages$Stage,levels=c("PRE","DURING","POST")), length), mean=tapply(NR_MedianDiversity_Stages$MedianDiversity, factor(NR_MedianDiversity_Stages$Stage,levels=c("PRE","DURING","POST")), median))
NR_summary$sd <- tapply(NR_MedianDiversity_Stages$MedianDiversity, factor(NR_MedianDiversity_Stages$Stage,levels=c("PRE","DURING","POST")), sd)
NR_summary$sem <- NR_summary$sd/sqrt(NR_summary$n-1)
NR_summary$lower_25 <- NR_summary$mean + qt((1-0.25)/2, df=NR_summary$n-1)*NR_summary$sem
NR_summary$higher_25 <- NR_summary$mean + qt((1+0.25)/2, df=NR_summary$n-1)*NR_summary$sem
NR_summary$lower_50 <- NR_summary$mean + qt((1-0.50)/2, df=NR_summary$n-1)*NR_summary$sem
NR_summary$higher_50 <- NR_summary$mean + qt((1+0.50)/2, df=NR_summary$n-1)*NR_summary$sem
NR_summary$lower_75 <- NR_summary$mean + qt((1-0.75)/2, df=NR_summary$n-1)*NR_summary$sem
NR_summary$higher_75 <- NR_summary$mean + qt((1+0.75)/2, df=NR_summary$n-1)*NR_summary$sem
NR_summary$lower_80 <- NR_summary$mean + qt((1-0.80)/2, df=NR_summary$n-1)*NR_summary$sem
NR_summary$higher_80 <- NR_summary$mean + qt((1+0.80)/2, df=NR_summary$n-1)*NR_summary$sem
rownames(NR_summary) <- c("PRE","DURING","POST")
NR_summary$Stage <- c(1,2,3)

#Plot Ribbon R
g1 <- ggplot(R_summary) + geom_line(aes(x=Stage,y=mean),stat="smooth",method="auto",color="blue4",size=2) + geom_line(aes(x=Stage,y=higher_25),stat="smooth",method="auto") + geom_line(aes(x=Stage,y=lower_25),stat="smooth",method="auto")+ geom_line(aes(x=Stage,y=higher_50),stat="smooth",method="auto") + geom_line(aes(x=Stage,y=lower_50),stat="smooth",method="auto")+ geom_line(aes(x=Stage,y=higher_75),stat="smooth",method="auto") + geom_line(aes(x=Stage,y=lower_75),stat="smooth",method="auto")
gg1 <- ggplot_build(g1)
g1_ribbon <- data.frame(x = gg1$data[[1]]$x, ymax_25 = gg1$data[[2]]$y, ymin_25 = gg1$data[[3]]$y, ymax_50 = gg1$data[[4]]$y, ymin_50 = gg1$data[[5]]$y, ymax_75 = gg1$data[[6]]$y, ymin_75 = gg1$data[[7]]$y)
g1 +  geom_ribbon(data = g1_ribbon, aes(x = x, ymin = ymin_75, ymax = ymax_75), fill = "yellow", alpha = 0.4) +  geom_ribbon(data = g1_ribbon, aes(x = x, ymin = ymin_75, ymax = ymax_75), fill = "darkgoldenrod1", alpha = 0.4) + geom_ribbon(data = g1_ribbon, aes(x = x, ymin = ymin_50, ymax = ymax_50), fill = "orange", alpha = 0.4) + geom_ribbon(data = g1_ribbon, aes(x = x, ymin = ymin_25, ymax = ymax_25), fill = "firebrick4", alpha = 0.4) + theme_bw() + theme(axis.text=element_text(size=20)) +ylim(0.6,1)

g2 <- ggplot(NR_summary) + geom_line(aes(x=Stage,y=mean),stat="smooth",method="auto",color="blue4",size=2) + geom_line(aes(x=Stage,y=higher_25),stat="smooth",method="auto") + geom_line(aes(x=Stage,y=lower_25),stat="smooth",method="auto")+ geom_line(aes(x=Stage,y=higher_50),stat="smooth",method="auto") + geom_line(aes(x=Stage,y=lower_50),stat="smooth",method="auto")+ geom_line(aes(x=Stage,y=higher_75),stat="smooth",method="auto") + geom_line(aes(x=Stage,y=lower_75),stat="smooth",method="auto")
gg2 <- ggplot_build(g2)
g2_ribbon <- data.frame(x = gg2$data[[1]]$x, ymax_25 = gg2$data[[2]]$y, ymin_25 = gg2$data[[3]]$y, ymax_50 = gg2$data[[4]]$y, ymin_50 = gg2$data[[5]]$y, ymax_75 = gg2$data[[6]]$y, ymin_75 = gg2$data[[7]]$y)
g2 +  geom_ribbon(data = g2_ribbon, aes(x = x, ymin = ymin_75, ymax = ymax_75), fill = "yellow", alpha = 0.4) +  geom_ribbon(data = g2_ribbon, aes(x = x, ymin = ymin_75, ymax = ymax_75), fill = "darkgoldenrod1", alpha = 0.4) + geom_ribbon(data = g2_ribbon, aes(x = x, ymin = ymin_50, ymax = ymax_50), fill = "orange", alpha = 0.4) + geom_ribbon(data = g2_ribbon, aes(x = x, ymin = ymin_25, ymax = ymax_25), fill = "firebrick4", alpha = 0.4) + theme_bw() + theme(axis.text=element_text(size=20)) + ylim(0.4,0.9)


#' Polar coordinates
#'
#' The polar coordinate system is most commonly used for pie charts, which
#' are a stacked bar chart in polar coordinates.
#'
#' @param theta variable to map angle to (`x` or `y`)
#' @param start Offset of starting point from 12 o'clock in radians. Offset
#'   is applied clockwise or anticlockwise depending on value of `direction`.
#' @param direction 1, clockwise; -1, anticlockwise
#' @param clip Should drawing be clipped to the extent of the plot panel? A
#'   setting of `"on"` (the default) means yes, and a setting of `"off"`
#'   means no. For details, please see [`coord_cartesian()`].
#' @export
#' @examples
#' # NOTE: Use these plots with caution - polar coordinates has
#' # major perceptual problems.  The main point of these examples is
#' # to demonstrate how these common plots can be described in the
#' # grammar.  Use with EXTREME caution.
#'
#' #' # A pie chart = stacked bar chart + polar coordinates
#' pie <- ggplot(mtcars, aes(x = factor(1), fill = factor(cyl))) +
#'  geom_bar(width = 1)
#' pie + coord_polar(theta = "y")
#'
#' \donttest{
#'
#' # A coxcomb plot = bar chart + polar coordinates
#' cxc <- ggplot(mtcars, aes(x = factor(cyl))) +
#'   geom_bar(width = 1, colour = "black")
#' cxc + coord_polar()
#' # A new type of plot?
#' cxc + coord_polar(theta = "y")
#'
#' # The bullseye chart
#' pie + coord_polar()
#'
#' # Hadley's favourite pie chart
#' df <- data.frame(
#'   variable = c("does not resemble", "resembles"),
#'   value = c(20, 80)
#' )
#' ggplot(df, aes(x = "", y = value, fill = variable)) +
#'   geom_col(width = 1) +
#'   scale_fill_manual(values = c("red", "yellow")) +
#'   coord_polar("y", start = pi / 3) +
#'   labs(title = "Pac man")
#'
#' # Windrose + doughnut plot
#' if (require("ggplot2movies")) {
#' movies$rrating <- cut_interval(movies$rating, length = 1)
#' movies$budgetq <- cut_number(movies$budget, 4)
#'
#' doh <- ggplot(movies, aes(x = rrating, fill = budgetq))
#'
#' # Wind rose
#' doh + geom_bar(width = 1) + coord_polar()
#' # Race track plot
#' doh + geom_bar(width = 0.9, position = "fill") + coord_polar(theta = "y")
#' }
#' }
coord_polar <- function(theta = "x", start = 0, direction = 1, clip = "on") {
  theta <- match.arg(theta, c("x", "y"))
  r <- if (theta == "x") "y" else "x"

  ggproto(NULL, CoordPolar,
    theta = theta,
    r = r,
    start = start,
    direction = sign(direction),
    clip = clip
  )
}

#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
CoordPolar <- ggproto("CoordPolar", Coord,

  aspect = function(details) 1,

  distance = function(self, x, y, details) {
    if (self$theta == "x") {
      r <- rescale(y, from = details$r.range)
      theta <- theta_rescale_no_clip(self, x, details)
    } else {
      r <- rescale(x, from = details$r.range)
      theta <- theta_rescale_no_clip(self, y, details)
    }

    dist_polar(r, theta)
  },

  backtransform_range = function(self, panel_params) {
    self$range(panel_params)
  },

  range = function(self, panel_params) {
    # summarise_layout() expects that the x and y ranges here
    # match the setting from self$theta and self$r
    setNames(
      list(panel_params$theta.range, panel_params$r.range),
      c(self$theta, self$r)
    )
  },

  setup_panel_params = function(self, scale_x, scale_y, params = list()) {

    ret <- list(x = list(), y = list())
    for (n in c("x", "y")) {

      scale <- get(paste0("scale_", n))
      limits <- self$limits[[n]]

      if (self$theta == n) {
        expansion <- default_expansion(scale, c(0, 0.5), c(0, 0))
      } else {
        expansion <- default_expansion(scale, c(0, 0),   c(0, 0))
      }
      range <- expand_limits_scale(scale, expansion, coord_limits = limits)

      out <- scale$break_info(range)
      ret[[n]]$range <- out$range
      ret[[n]]$major <- out$major_source
      ret[[n]]$minor <- out$minor_source
      ret[[n]]$labels <- out$labels
      ret[[n]]$sec.range <- out$sec.range
      ret[[n]]$sec.major <- out$sec.major_source_user
      ret[[n]]$sec.minor <- out$sec.minor_source_user
      ret[[n]]$sec.labels <- out$sec.labels
    }

    details = list(
      x.range = ret$x$range, y.range = ret$y$range,
      x.major = ret$x$major, y.major = ret$y$major,
      x.minor = ret$x$minor, y.minor = ret$y$minor,
      x.labels = ret$x$labels, y.labels = ret$y$labels,
      x.sec.range = ret$x$sec.range, y.sec.range = ret$y$sec.range,
      x.sec.major = ret$x$sec.major, y.sec.major = ret$y$sec.major,
      x.sec.minor = ret$x$sec.minor, y.sec.minor = ret$y$sec.minor,
      x.sec.labels = ret$x$sec.labels, y.sec.labels = ret$y$sec.labels
    )

    if (self$theta == "y") {
      names(details) <- gsub("x\\.", "r.", names(details))
      names(details) <- gsub("y\\.", "theta.", names(details))
      details$r.arrange <- scale_x$axis_order()
    } else {
      names(details) <- gsub("x\\.", "theta.", names(details))
      names(details) <- gsub("y\\.", "r.", names(details))
      details$r.arrange <- scale_y$axis_order()
    }

    details
  },

  transform = function(self, data, panel_params) {
    data <- rename_data(self, data)

    data$r  <- r_rescale(self, data$r, panel_params$r.range)
    data$theta <- theta_rescale(self, data$theta, panel_params)
    data$x <- data$r * sin(data$theta) + 0.5
    data$y <- data$r * cos(data$theta) + 0.5

    data
  },

  render_axis_v = function(self, panel_params, theme) {
    arrange <- panel_params$r.arrange %||% c("primary", "secondary")

    x <- r_rescale(self, panel_params$r.major, panel_params$r.range) + 0.5
    panel_params$r.major <- x
    if (!is.null(panel_params$r.sec.major)) {
      panel_params$r.sec.major <- r_rescale(
        self,
        panel_params$r.sec.major,
        panel_params$r.sec.range
      ) + 0.5
    }

    list(
      left = render_axis(panel_params, arrange[1], "r", "left", theme),
      right = render_axis(panel_params, arrange[2], "r", "right", theme)
    )
  },

  render_axis_h = function(panel_params, theme) {
    list(
      top = zeroGrob(),
      bottom = draw_axis(NA, "", "bottom", theme)
    )
  },

  render_bg = function(self, panel_params, theme) {
    panel_params <- rename_data(self, panel_params)

    theta <- if (length(panel_params$theta.major) > 0)
      theta_rescale(self, panel_params$theta.major, panel_params)
    thetamin <- if (length(panel_params$theta.minor) > 0)
      theta_rescale(self, panel_params$theta.minor, panel_params)
    thetafine <- seq(0, 2 * pi, length.out = 100)

    rfine <- c(r_rescale(self, panel_params$r.major, panel_params$r.range), 0.45)

    # This gets the proper theme element for theta and r grid lines:
    #   panel.grid.major.x or .y
    majortheta <- paste("panel.grid.major.", self$theta, sep = "")
    minortheta <- paste("panel.grid.minor.", self$theta, sep = "")
    majorr     <- paste("panel.grid.major.", self$r,     sep = "")

    ggname("grill", grobTree(
      element_render(theme, "panel.background"),
      if (length(theta) > 0) element_render(
        theme, majortheta, name = "angle",
        x = c(rbind(0, 0.45 * sin(theta))) + 0.5,
        y = c(rbind(0, 0.45 * cos(theta))) + 0.5,
        id.lengths = rep(2, length(theta)),
        default.units = "native"
      ),
      if (length(thetamin) > 0) element_render(
        theme, minortheta, name = "angle",
        x = c(rbind(0, 0.45 * sin(thetamin))) + 0.5,
        y = c(rbind(0, 0.45 * cos(thetamin))) + 0.5,
        id.lengths = rep(2, length(thetamin)),
        default.units = "native"
      ),

      element_render(
        theme, majorr, name = "radius",
        x = rep(rfine, each = length(thetafine)) * sin(thetafine) + 0.5,
        y = rep(rfine, each = length(thetafine)) * cos(thetafine) + 0.5,
        id.lengths = rep(length(thetafine), length(rfine)),
        default.units = "native"
      )
    ))
  },

  render_fg = function(self, panel_params, theme) {
    if (is.null(panel_params$theta.major)) {
      return(element_render(theme, "panel.border"))
    }

    theta <- theta_rescale(self, panel_params$theta.major, panel_params)
    labels <- panel_params$theta.labels

    # Combine the two ends of the scale if they are close
    theta <- theta[!is.na(theta)]
    ends_apart <- (theta[length(theta)] - theta[1]) %% (2 * pi)
    if (length(theta) > 0 && ends_apart < 0.05) {
      n <- length(labels)
      if (is.expression(labels)) {
        combined <- substitute(paste(a, "/", b),
          list(a = labels[[1]], b = labels[[n]]))
      } else {
        combined <- paste(labels[1], labels[n], sep = "/")
      }
      labels[[n]] <- combined
      labels <- labels[-1]
      theta <- theta[-1]
    }

    grobTree(
      if (length(labels) > 0) element_render(
        theme, "axis.text.x",
        labels, 0.45 * sin(theta) + 0.5, 0.45 * cos(theta) + 0.5,
        hjust = 0.5, vjust = 0.5,
        default.units = "native"
      ),
      element_render(theme, "panel.border")
    )
  },

  render_fg = function(self, panel_params, theme) {
    if (is.null(panel_params$theta.major)) {
      return(element_render(theme, "panel.border"))
    }

    theta <- theta_rescale(self, panel_params$theta.major, panel_params)
    labels <- panel_params$theta.labels

    # Combine the two ends of the scale if they are close
    theta <- theta[!is.na(theta)]
    ends_apart <- (theta[length(theta)] - theta[1]) %% (2*pi)
    if (length(theta) > 0 && ends_apart < 0.05 && !is.null(labels)) {
      n <- length(labels)
      if (is.expression(labels)) {
        combined <- substitute(paste(a, "/", b),
          list(a = labels[[1]], b = labels[[n]]))
      } else {
        combined <- paste(labels[1], labels[n], sep = "/")
      }
      labels[[n]] <- combined
      labels <- labels[-1]
      theta <- theta[-1]
    }

    grobTree(
      if (length(labels) > 0) element_render(
        theme, "axis.text.x",
        labels,
        unit(0.45 * sin(theta) + 0.5, "native"),
        unit(0.45 * cos(theta) + 0.5, "native"),
        hjust = 0.5, vjust = 0.5
      ),
      element_render(theme, "panel.border")
    )
  },

  labels = function(self, labels, panel_params) {
    if (self$theta == "y") {
      list(x = labels$y, y = labels$x)
    } else {
      labels
    }
  },

  modify_scales = function(self, scales_x, scales_y) {
    if (self$theta != "y")
      return()

    lapply(scales_x, scale_flip_position)
    lapply(scales_y, scale_flip_position)
  }
)

rename_data <- function(coord, data) {
  if (coord$theta == "y") {
    rename(data, c("y" = "theta", "x" = "r"))
  } else {
    rename(data, c("y" = "r", "x" = "theta"))
  }
}

theta_rescale_no_clip <- function(coord, x, panel_params) {
  rotate <- function(x) (x + coord$start) * coord$direction
  rotate(rescale(x, c(0, 2 * pi), panel_params$theta.range))
}

theta_rescale <- function(coord, x, panel_params) {
  x <- squish_infinite(x, panel_params$theta.range)
  rotate <- function(x) (x + coord$start) %% (2 * pi) * coord$direction
  rotate(rescale(x, c(0, 2 * pi), panel_params$theta.range))
}

r_rescale <- function(coord, x, range) {
  x <- squish_infinite(x, range)
  rescale(x, c(0, 0.4), range)
}


drawTargetHeatMapCurve	<- function( seuratObj,  targetCurve, heatMapHeight, heatMapWidth){

# This snippet makes a heatmap of gene expression of cells along the target curve
# Curve gives smoothed expression values, use drawTargetHeatMapCells for original gene expression values for cells
#
# written by Seva Makeev, 2017 - 2021

require( ComplexHeatmap)
require( circlize)
require( viridis)
require( proxy)
library( dendsort)

source("R/setClusterColors.r")

heatMapGenes 	<- c( 	"tfap2e"	, "tfap2a"	, "her9"	, "sox9b"	, "foxg1b" 	,
			"snai1b"	, "alx4b"	, "hmx1"	, "otx2b"	, "sox10"	,
			"impdh1b"	, "foxo1b"	, "tyr"		, "pax7b"	, "mc1r"	,
			"id2a"		, "hmx4"	, "foxd3"	, "ednrba"	, "kita"	,
			"mbpa"		, "phox2bb"	, "tfec"	, "mitfa"	, "foxp4" 	,
			"foxo1a"	, "hbp1"	, "ltk"		, "mycla"	, "pax7a"	,
			"tyrp1b"	, "slc24a5"	, "oca2"	, "mlphb"	, "pmela"	,
			"myo5aa"	, "pnp4a"	, "ets1"	, "fgfr3"	, "pax3a"	,
			"dpf3"		, "smad9")

dataMatrix 		<- seuratObj@data

row_dend 		<- dendsort(hclust( dist(dataMatrix, method = "cosine", pairwise = TRUE)))

nCol			<- 1024
colPanelFun	 	<- colorRamp2( quantile( dataMatrix, seq(0, 1, by = 1/(nCol - 1))), viridis( nCol))

lineageCells		<- rownames(targetCurve$curve)
lineageType		<- targetCurve$target

clusterColors		<- setClusterColors( seuratObj)
names(clusterColors)	<- levels( seuratObj@ident)

curveClust 		<- seuratObj@ident[ lineageCells]

annotbar		<- HeatmapAnnotation( 	Cluster = seuratObj@ident[lineageCells],
				    		col 	= list( Cluster = clusterColors),
				    		height = unit(30, "points")
				    #annotation_legend_param = list( nrow = 10)
					)

hMap <- Heatmap( 	t(targetCurve$curve),
			name = "gene log expression",
			width 	= unit( heatMapWidth,  "inches"),
			height 	= unit( heatMapHeight, "inches"),
			heatmap_legend_param = list(
				title = "gene exp",
				legend_height = unit( 2, "inches"),
				grid_width = unit( 0.5, "inches"),
				title_gp = gpar( fontsize = 16, fontface = "bold")
						),
			col	=  colPanelFun,
			cluster_columns = FALSE,
			cluster_rows = row_dend,
			row_dend_reorder = TRUE,
			show_column_names = FALSE,
			row_names_gp = gpar(fontsize = 12),
#			column_names_gp = gpar(fontsize = 10),
			bottom_annotation = annotbar,
			column_title = paste0("Expression of ", lineageType, " lineage"),
			clustering_distance_rows = function(x) dist( x, method = "cosine", pairwise = TRUE) ,
			use_raster = TRUE, raster_device = "png",
			)

return( hMap)
}


library(tidyverse)
library(haven)
library(poLCA)

select <- dplyr::select

dat <- read_sas('data/yrbs2017.sas7bdat','data/formats.sas7bcat')

names(dat) <- tolower(names(dat))

subst <- list(
    smoke = select(dat,q31:q33),
    vape = select(dat,q34:q36),
    drink = select(dat,q40:q45),
    pot = select(dat,q46:q48)
)

for(nm in names(subst)){
    names(subst[[nm]]) <- paste0(nm,seq(ncol(subst[[nm]])))
    subst[[nm]] <- as_factor(subst[[nm]])
    subst[[nm]][subst[[nm]]=='Missing'] <- NA
    subst[[nm]] <- droplevels(subst[[nm]])
}

### look at alcohol
drink <- subst$drink
## drink1: During your life, on how many days have you had at least one drink of alcohol?
## drink2: How old were you when you had your first drink of alcohol other than a few sips?
## drink3: During the past 30 days, on how many days did you have at least one drink of alcohol?
## drink4: During the past 30 days, how did you usually get the alcohol you drank?
## drink5: During the past 30 days, on how many days did you have 4 or more drinks of alcohol in a row (if you are female) or 5 or more drinks of alcohol in a row (if you are male)?
## drink6: During the past 30 days, what is the largest number of alcoholic drinks you had in a row?

## checking depencencies:
## distribution of other variables when drink1=="0 days" (i.e. never drank)
drink%>%filter(drink1=='0 days')%>%map(table,useNA='ifany') ## checks out
## distribution of other variables when drink2=="Never drank alcohol"
drink%>%filter(drink2=='Never drank alcohol')%>%map(table,useNA='ifany') ## some answers for drink 1 (I guess that means a couple sips?)
## dist of drink4:6 if drink3=="0 days"
drink%>%filter(drink3=='0 days')%>%select(drink4:drink6)%>%map(table,useNA='ifany') ## checks out
## dist of drink3:drink6 if drink4 or drink6=="Did not drink in past 30 days"
drink%>%filter(drink4=='Did not drink in past30 days'|drink6=='Did not drink in past 30 days')%>%
    select(drink3:drink6)%>%map(table,useNA='ifany') ## checks out

drinkBin <- drink%>%
    mutate(sex=as.numeric(as.character(dat$q2)))%>%
    transmute(
        everDrink=ifelse(
            is.na(drink1),
                  ifelse(drink2=='Never drank alcohol',1,2),
                  ifelse(drink1=='0 days',1,2)
          ), ## 1= never drank 2= drank some
        preteen=ifelse(is.na(drink2),ifelse(everDrink==1,1,NA),
                ifelse(drink2%in%c('8 years old or younger','9 or 10 years old','11 or 12 years old'),2,1)), ## 2=drank pre-teen
        drink30days=ifelse(is.na(drink3),
                    ifelse(everDrink==1,1,NA),
                    ifelse(drink3=='0 days',1,2)), ## 1=no drinks past 30 days, 2=drank past 30 days
        bought=ifelse(startsWith(as.character(drink4),'Bought'),2,1), ## 2= bought alc in past 30 days
        drinkHeavy=ifelse(
            is.na(drink5),ifelse(drink30days==1,1,NA),
                   ifelse(drink5=='0 days',1,2)), ## 2=drank heavily in past 30 days
        drinkVheavy=ifelse(is.na(drink6),ifelse(drinkHeavy==1,1,NA),
                    ifelse(drink6%in%c('6 or 7 drinks','8 or 9 drinks','10 or more drinks'),2,1)),
### fill in some more NAs
        drinkHeavy=ifelse(is.na(drinkHeavy),
                   ifelse(is.na(drink6),as.numeric(NA),
                   ifelse(drink6=='4 drinks'&is.na(sex),as.numeric(NA),
                   ifelse(drinkVheavy==2|drink6=='5 drinks',2,
                   ifelse(drink6=='4 drinks',ifelse(sex==2,1,2),1)))),
                   drinkHeavy),
        drink30days=ifelse(is.na(drink30days),
                    ifelse(!is.na(drinkHeavy)&drinkHeavy==2,2,
                    ifelse(!is.na(drink4),
                    ifelse(drink4=='Did not drink in past 30 days',1,2),
                    ifelse(!is.na(drink6),
                    ifelse(drink6=='Did not drink in past 30 days',1,2),NA))),
                    drink30days),
        bought=ifelse(is.na(bought),
               ifelse((!is.na(drink30days)&drink30days==1)|(!is.na(everDrink)&everDrink==1),1,NA),
               bought),
        everDrink=ifelse(
            is.na(everDrink),
                  ifelse(drink30days==2|drinkHeavy==2|drinkVheavy==2,2,NA),
            everDrink)
    )

for(i in 1:(ncol(drinkBin)-1))
    for(j in (i+1):ncol(drinkBin)){
        print(paste(names(drinkBin)[i],names(drinkBin)[j]))
        print(table(drinkBin[[i]],drinkBin[[j]],useNA='always'))
    }

#### for conditioning model: set NAs
drinkBin2 <- drinkBin
drinkBin2[!is.na(drinkBin$everDrink)&drinkBin$everDrink==1,c('preteen','drink30days','bought','drinkHeavy','drinkVheavy')] <- NA
drinkBin2[!is.na(drinkBin$drink30days)&drinkBin$drink30days==1,c('bought','drinkHeavy','drinkVheavy')] <- NA
drinkBin2[!is.na(drinkBin$drinkHeavy)&drinkBin$drinkHeavy==1,'drinkVheavy'] <- NA

## look at pot
## pot 1: During your life, how many times have you used marijuana?
## pot 2: How old were you when you tried marijuana for the first time?
## pot 3: During the past 30 days, how many times did you use marijuana?

pot <- subst$pot
### complex structural 0s between pot1 and pot3

table(pot[[2]][pot[[1]]=='0 times'],useNA='always') ## checks out
table(pot[[3]][pot[[1]]=='0 times'],useNA='always') ## checks out
table(pot[[3]][pot[[2]]=='Never tried marijuana'],useNA='always') ## checks out

potBin <- pot%>%
    transmute(
        everPot=ifelse(
            is.na(pot1),
                  ifelse(pot2=='Never tried marijuana',1,2),
                  ifelse(pot1=='0 times',1,2)
          ), ## 1= never pot 2= smoked some
        preteenPot=ifelse(is.na(pot2),NA,
                   ifelse(pot2%in%c('8 years old or younger','9 or 10 years old','11 or 12 years old'),2,1)), ## 2=pot pre-teen
        pot30days=ifelse(pot3=='0 times',1,2), ## 1=no pot past 30 days, 2=pot past 30 days
        pot20plus=ifelse(is.na(pot3),NA,ifelse(pot3%in%c('20 to 39 times', '40 or more times'),2,1))
    )

for(i in 1:3) for(j in (i+1):4){
                  print(paste(names(potBin)[i],names(potBin)[j]))
                  print(table(potBin[[i]],potBin[[j]],useNA='always'))
                  }

potBin2 <- potBin
potBin2[potBin$evePot

pot2 <- pot%>%
    transmute(
        ever=factor(ifelse(pot1=='0 times','never smoked','smoked'),
                    levels=('never smoked','smoked')),
        ageFirst=pot2,
        timesEarlier=factor(
            ifelse(ever=='never smoked','0',
                   ifelse(pot1

for(nm in grep('q[1-9]',names(dat),value=TRUE)){
    x <- dat[[nm]]
    x[x==''] <- NA
    dat[[nm]] <- as.numeric

newVarb <- function(oldVarb,cats){
    new <- rep(NA,length(oldVarb))
    for(i in 1:length(cats))
        new[oldVarb%in%cats[[i]]] <- i
    new
}

tx17Days <- list(1,2:3,4:5,6:7)
tx17Times <- list(1,2,3:4,5:6)

sub17 <- with(dat17,data.frame(
  school.id=as.character(psu),
  year=rep(17,nrow(dat17)),
  type='Trad',
  smoke=newVarb(q32,tx17Days),
  chew=newVarb(q37,tx17Days),
  cigar=newVarb(q38,tx17Days),
  vape=newVarb(q35,tx17Days),
  drink=newVarb(q42,tx17Days),
  pot=newVarb(q48,tx17Times),
  perscription=newVarb(q56,tx17Times),
  coke=newVarb(q49,tx17Times),
  glue=newVarb(q50,tx17Times),
  heroin=newVarb(q51,tx17Times),
  meth=newVarb(q52,tx17Times),
  ecstasy=newVarb(q53,tx17Times),
  syPot=newVarb(q54,tx17Times)))

sub17full <- with(dat17,data.frame(
  year=rep(17,nrow(dat17)),
  type='Trad',
  smoke=q32,
  chew=q37,
  cigar=q38,
  vape=q35,
  drink=q42,
  pot=q48,
  perscription=q56,
  coke=q49,
  glue=q50,
  heroin=q51,
  meth=q52,
  ecstasy=q53,
  syPot=q54))
sub17full[sub17full>10] <- NA

### fill in some NAs
sub17 <- within(sub17,{
    smoke[is.na(smoke)] <-
        with(dat17[is.na(smoke),],
             ifelse(q31==1|q33==1|q39==1,1,NA))
    vape[is.na(vape)] <-
        with(dat17[is.na(vape),],
             ifelse(q34==1|q36==1|q39==1,1,NA))
    chew[is.na(chew)] <- ifelse(dat17$q39[is.na(chew)]==1,1,NA)
    cigar[is.na(cigar)] <- ifelse(dat17$q39[is.na(cigar)]==1,1,NA)
    drink[is.na(drink)] <-
        with(dat17[is.na(drink),],
             ifelse(q40==1|q41==1|q43==1|q45==1,1,NA))
    pot[is.na(pot)] <-
        with(dat17[is.na(pot),],
             ifelse(q46==1|q47==1,1,NA))
})

sub17full <- within(sub17full,{
    smoke[is.na(smoke)] <-
        with(dat17[is.na(smoke),],
             ifelse(q31==1|q33==1|q39==1,1,NA))
    vape[is.na(vape)] <-
        with(dat17[is.na(vape),],
             ifelse(q34==1|q36==1|q39==1,1,NA))
    chew[is.na(chew)] <- ifelse(dat17$q39[is.na(chew)]==1,1,NA)
    cigar[is.na(cigar)] <- ifelse(dat17$q39[is.na(cigar)]==1,1,NA)
    drink[is.na(drink)] <-
        with(dat17[is.na(drink),],
             ifelse(q40==1|q41==1|q43==1|q45==1,1,NA))
    pot[is.na(pot)] <-
        with(dat17[is.na(pot),],
             ifelse(q46==1|q47==1,1,NA))
})


# This script prepares files, which can be read from Seurat
# It also runs the procedure that performes imputation
# Preparing clean  data for WT and WT+sox10 mutants, which it places into different folders, so seuratNorm.r can read the correct source files
# This script is the next in the pipeline after the qualityControl.r
#
# written by Vsevolod J. Makeev 2017 - 2021

source("R/imputeDropouts.r")

resDir		<- file.path( getwd(), "Res")
scTablesDir	<- file.path( resDir, "scTables")
dir.create( scTablesDir, showWarnings = FALSE)

dirQCres <- file.path( resDir, "QualityControl", "ResQC")

genesQC	<- read.table( file = file.path( dirQCres, "New_NormalizedExTable.csv"), sep = "\t", stringsAsFactors = FALSE, check.names=FALSE )
cellsQC	<- read.table( file = file.path( dirQCres, "New_cellDescripitonsDedupQC.csv"), sep = "\t", stringsAsFactors = FALSE, check.names=FALSE )

exps		<- genesQC
allGenes	<- rownames(genesQC)

allCellsDir 	<- file.path( scTablesDir, "allCells")
dir.create( allCellsDir , showWarnings = FALSE)

#remove values, that are too close to zero
noiseTol	<- 30
exps		<- apply( exps, c(1,2), function(x) if(x>noiseTol) x else 0)

#remove cells with all zero values
exps 		<- exps[, which( apply( exps, 2, sum) >0)]
logExps 	<- log10(1+exps)

#impute for dropouts
randSeedAll 	<- as.integer(Sys.time())
logExpsImp	<- imputeDropouts(logExps, randSeedAll)

logNoiseTol	<- log10( noiseTol)

#remove imputed values, that are too close to zero
logExpsImp	<- apply( logExpsImp, c(1,2), function(x) if(x>logNoiseTol) x else 0)

#remove cells with all zero values
logExpsImp	<- logExpsImp[, which( apply( logExpsImp, 2, sum) >0)]
cellsQCImp	<- cellsQC[, colnames(logExpsImp)]
genesQCImp	<- 10^logExpsImp - 1

cat( file = file.path( allCellsDir, "ImputeSeedAll.txt"), randSeedAll)
write.table( logExps, file = file.path( allCellsDir, "logExpTableDedupQC.csv"), sep = "\t")
write.table( logExpsImp, file = file.path( allCellsDir, "logExpTableDedupQCimp.csv"), sep = "\t")
write.table( cellsQCImp, file = file.path( allCellsDir, "cellDescriptionsDedupQC.csv"), sep = "\t")
write.table( genesQCImp, file = file.path( allCellsDir, "geneExpTableDedupQCimp.csv"), sep = "\t")

WTDir		<- file.path( scTablesDir, "WT")
dir.create(WTDir, showWarnings = FALSE)

randSeedWT 	<- as.integer(Sys.time())
logExpsWT	<- logExps[, setdiff( seq_along(colnames(logExps)), grep("(sox10|mitfa)", colnames(logExps)))]
logExpsWTImp	<- imputeDropouts(logExpsWT, randSeedWT)

logExpsWTImp	<- apply( logExpsWTImp, c(1,2), function(x) if(x>logNoiseTol) x else 0)
logExpsWTImp	<- logExpsWTImp[, which( apply( logExpsWTImp, 2, sum) >0)]
cellsQCWTImp	<- cellsQC[, colnames(logExpsWTImp)]
genesQCWTImp	<- 10^logExpsWTImp - 1

cat( file = file.path( WTDir, "ImputeSeedWT.txt"), randSeedWT)
write.table( logExpsWT, file = file.path( WTDir, "logExpTableDedupQC.csv"), sep = "\t")
write.table( logExpsWTImp, file = file.path( WTDir, "logExpTableDedupQCimp.csv"), sep = "\t")
write.table( cellsQCWTImp, file = file.path( WTDir, "cellDescriptionsDedupQC.csv"), sep = "\t")
write.table( genesQCWTImp, file = file.path( WTDir, "geneExpTableDedupQCimp.csv"), sep = "\t")

cat( "End of imputation\n")


#' @title makeMapBasic
#' @description generate map using PBSmapping plotting functions
#' @family abysmally documented
#' @author  Mike McMahon, \email{Mike.McMahon@@dfo-mpo.gc.ca}
#' @export
#----------------------------------------------------
#
# derived from Ben Zisserson's original work (June 14, 2013 08:15:00 PM)
# couple of mods by Adam June 14, 2013 01:21:02 PM
# Simplified and generalized by Mike M, Mar 12, 2015
#  - area extents added as a separate function (getExtent.R)
#  - numerous more extents added for use by that function
#----------------------------------------------------
makeMapBasic= function(x,xlim=c(-67,-57), ylim=c(42,47.5), title="", area="default", main=""){
  #shapefiles=c(),
  require(PBSmapping)
  require("raster")
	require("geosphere")

  bioLibrary("bio.polygons")

  #("sp_23_2014-12-01_tow_83UTM20N.shp")
#   these.shapefiles<-list()
#   for (i in 1:length(shapefiles)){
#     #need to get working data directory - not hard code
#     these.shapefiles[i] <-importShapefile(file.path(project.datadirectory('observers'),shapefiles[i]))
#   }

# read in shapefiles
#--------------------------------------
  basemap= importShapefile(find.bio.gis("map_base_region"))
  dm200= importShapefile(find.bio.gis("dm200_region"))
  dm100= importShapefile(find.bio.gis("dm100_region"))
  land= importShapefile(find.bio.gis("landmass_region"))
  coast=importShapefile(find.bio.gis("coastline_polyline"))

# Provide projection information
#---------------------------------
  proj.abbr=attr(basemap, "projection") # abbreviated projection info
  proj.full=attr(basemap, "prj") # full projection info

  #use getExtent.R to find the bound of the various areas
  #(snowcrab, NAFO, Strata and more)
  #if multiple areas specified, get bounds that contain them all
  #if extent not found, alert user

  if (!area =="default"){
  allExtents<-data.frame()
  for (i in 1:length(area)){
    if (!is.null(ncol(getExtent(area[i])))){
      allExtents<-rbind(allExtents, data.frame(getExtent(area[i])))
    }else{
      print(paste0("Excluded the extent of area '",area[i],"' - could not find it"))
    }
  }
  minX<-min(allExtents[,2])
  maxX<-max(allExtents[,3])
  minY<-min(allExtents[,4])
  maxY<-max(allExtents[,5])
  xlim<-c(minX,maxX)
  ylim<-c(minY,maxY)
  }

  plotPolys(basemap, projection="LL", col="royalblue2", border="black",
  font.lab=1,  xlab="Longitude", ylab="Latitude", axes=T, tck=-.01,
  tckLab=TRUE, ylim=ylim, xlim=xlim,main=main)

  title(main=title, line=1, cex.main = .7)
  addPolys(dm200, col="steelblue2", border="steelblue2")
  addPolys(dm100, col="lightblue1", border="lightblue1")

#Try adding a csv data layer
#  ports <- as.EventData(read.csv(find.bio.gis("ports.csv")))
#  addPoints(ports,col="red")
#  addLabels(ports)

  #Overlay land and coastline such that any bad data (on land) is hidden
  addPolys(land, col="moccasin", border="moccasin")
  addLines(coast, col="black")
  box()
}


library(shiny)

get_time_string = function(t)
{
  cf = timer:::seconds_to_clockface(t)
  timer:::get_clockface(cf, "")
}

shinyServer(function(input, output, session){
  state = reactiveValues(t_first=0, beeps=1)

  observeEvent(input$button_reset, {
    state$t_first = 0
    state$beeps = 1

    state$h = 0
    state$m = 0
    state$s = 0
  })

  observeEvent(input$button_start, {
    state$t_first = timer:::clock_seconds()
    state$beeps = 1

    state$h = as.numeric(input$hbox)
    state$m = as.numeric(input$mbox)
    state$s = as.numeric(input$sbox)
  })

  observeEvent(input$button_22, {
    state$t_first = timer:::clock_seconds()
    state$beeps = 1

    state$h = state$s = 0
    state$m = 22
  })

  observeEvent(input$button_90, {
    state$t_first = timer:::clock_seconds()
    state$beeps = 1

    state$h = state$s = 0
    state$m = 90
  })

  output$countdown = renderUI({
    total_seconds = 60*60*state$h + 60*state$m + state$s
    if (total_seconds == 0 || state$t_first == 0)
      HTML("")
    else
    {
      t_top = state$t_first + total_seconds
      t = t_top - timer:::clock_seconds()

      invalidateLater(1000, session)

      if (t <= 0)
      {
        if (state$beeps > 0)
        {
          state$beeps = state$beeps - 1L
          timer:::audio_ping()
        }

        t = 1 - t

        cf = get_time_string(t)
        cf_tot = get_time_string(t+total_seconds)

        HTML(paste(
          "Over Time
",
          "
", cf, "

",
          "Total
",
          "
", cf_tot, "
"
        ))
      }
      else
      {
        cf = get_time_string(t)
        HTML(paste(
          "Remaining
",
          "
", cf, "
"
        ))
      }
    }
  })
})


  figure.timeseries.bycatch = function(p, outdir, species,  plotyears, type='mass', all.areas=T, graphic='pdf' ) {
 #browser()
    outdir=file.path(p$annual.results, "timeseries", "survey")

    if (all.areas) {
      areas = c("cfa4x", "cfasouth", "cfanorth" )
      regions = c("4X", "S-ENS", "N-ENS")
    } else {
      areas = c("cfasouth", "cfanorth" )
      regions = c("S-ENS", "N-ENS")
    }

    n.regions = length(regions)
    n.areas = length(areas)

    spcd = groundfish.db( DS="spcodes")
    tdb = snowcrab.timeseries.db( DS="biologicals", p=p )
    if(missing(species)){
      cat = snowcrab.db( DS="cat.initial" )
      species = unique(cat$spec)
    }
    v = paste("ms",type,species,sep='.')
    spcd = subset(spcd,code%in%species)
    if(missing(plotyears))plotyears = unique(tdb$year)

    for(i in 1:length(v)){

      td = tdb[ which( tdb$variable == v[i] & tdb$year%in%plotyears) ,]
      td = td[ order(td$region, td$year) , ]
      td$region = factor(td$region, levels=areas, labels =regions)
      #   td[ which(td$region=="4X" & td$year < 2004), c("mean", "se", "ub", "lb", "n")] = NA

      common = spcd$comm[which(spcd$code==species[i])]

      ylim='NULL'
      ylim[2]=max(td$ub,na.rm=T)*1.05
      ylim[1]=0
      xlim=range(td$year); xlim[1]=xlim[1]; xlim[2]=xlim[2]

      xlabels = seq(min(xlim), max(xlim), 1)
      ylabels = pretty(ylim,8)

      dir.create( outdir, recursive=T, showWarnings=F )
      fn = file.path( outdir, paste( v[i], graphic,  sep="." ) )
      cex.main = 1.4
      cex.lab = 1
      cex.axis = 0.2

   if(graphic=='png') Cairo( file=fn, type="png", bg="white",  units="in", width=5, height=6, dpi=350 )
   if(graphic=='pdf') pdf(file=fn, width=5, height=6, bg='white')
   if(graphic=='R') plot.new()
      setup.lattice.options()
      pl = xyplot( mean~year|region, data=td, ub=td$ub, lb=td$lb,
            layout=c(1,n.regions),
            par.strip.text=list(
              plot.symbol=list(col='black', fill='darkgrey', cex=0.75, pch=21),
              axis.text=list(cex=0.7),
              par.main.text=list(cex=1),
              layout.heights=list(strip=1, panel=1, main=0.5),
              strip.background=list(col='lightgrey')),
              #xlim=xlim,
              ylim=(c(as.numeric(ylim[1]), as.numeric(ylim[2]))),
              scales=list(y=list(at=ylabels, labels=ylabels, cex=0.65), x=list(at=xlabels, labels=xlabels, rot=50, cex=0.65)),
                main=paste(capwords(common,T,F),"Biomass"), xlab=list("Year", cex=1), ylab=list("Geometric mean kg / km^2", cex=1),
                #cex.lab=cex.lab,
                cex.axis=cex.axis,
                cex.main = cex.main,
                panel = function(x, y, subscripts, ub, lb, ...) {
               larrows(x, lb[subscripts], x, ub[subscripts], angle = 90, code = 3, length=0.05)
               panel.xyplot(x, y, type="b", lty=1, lwd=1.5, pch=21, fill='darkgrey', col="black", ...)
               panel.abline(h=median(y), col="gray", ...)
          }
        )

      print(pl)
      if(graphic!='R') dev.off()
      print(fn)
    }
   #cmd( "convert   -trim -quality 9  -geometry 200% -frame 2% -mattecolor white -antialias ", paste(fn, "pdf", sep="."),  paste(fn, "png", sep=".") )

    return("Done")
    }


# Process ASTER DEM (replacement for GLSDEM since that is no longer available)
# The ASTER files have been downloaded from NASA Earthdata Search
# Input: zip files at 30 m resolution
# Output: ASTER DEM resampled to Proba-V grid
# Run the bash file to get global mosaic in the Proba-V grid of elevation, slope, aspect, roughness, TPI

library(gdalUtils)
library(raster)
library(foreach)
library(doSNOW)

source("pixel-based/utils/ProbaVTileID.r")

InputDir = "/data/mep_cg1/ancillary/DEM/aster/geotiff/dem/"
OutputDir = "/userdata2/master-classification/dem/aster-covars/"
ProjectionReference = "../work/globalmosaic.vrt"
SampleDir = "/data/MTDA/TIFFDERIVED/PROBAV_L3_S5_TOC_100M/2019/20190101/PROBAV_S5_TOC_20190101_100M_V101/"

# Get a projection sample: a mosaic of Proba-V imagery
if (!file.exists(ProjectionReference))
{
    SampleFiles = list.files(SampleDir, pattern=glob2rx("*NDVI.tif"), full.names = TRUE)
    gdalbuildvrt(SampleFiles, ProjectionReference)
}
ReferenceRaster = raster(ProjectionReference)

if (!dir.exists(OutputDir))
    dir.create(OutputDir)

AsterTifs = list.files(InputDir, glob2rx("*.tif"), full.names = TRUE)

cl <- makeCluster(2, outfile="")
registerDoSNOW(cl)
pb = txtProgressBar(max = length(AsterTifs), style = 3)

# Iterate over all zip files
foreach (AsterTif=AsterTifs, .packages=c("raster"),
         .options.snow = list(progress = function(n) setTxtProgressBar(pb, n))) %dopar%
{
    #AsterTif = sub(".zip", "_dem.tif", AsterZip)
    OutFile = file.path(OutputDir, basename(AsterTif))
    if (file.exists(OutFile))
    {
        print(paste(OutFile, "exists, not processing"))
        return(NULL)
    }

    # Unzip just the file we need
    #unzip(AsterZip, files = basename(AsterTif), exdir=dirname(AsterZip))
    #if (!file.exists(AsterTif))
    #    stop(paste("Could not extract file from", AsterZip))
    #print(paste("Reading from", AsterTif))
    AsterDem = raster(AsterTif)
    AsterDem = readAll(AsterDem)
    # Resample to 100 m
    # The result is always the size of the reference, so crop refrence first
    ReferenceRegion = tryCatch(
        crop(ReferenceRaster, AsterDem, snap="out"),
        error=function(e){
                if (e$message == "Failure during raster IO\n")
                {
                    ADE = extent(AsterDem)
                    TID = ProbaVTileID(data.frame(x=mean(ADE@xmin, ADE@xmax),y=mean(ADE@ymin, ADE@ymax)))
                    RefTile = raster(list.files(SampleDir, pattern=glob2rx(paste0("*", TID, "*NDVI.tif")), full.names = TRUE))
                    crop(RefTile, AsterDem, snap="out")
                } else stop(e)
            }
        )
    #print(paste("Writing to", OutFile))
    raster::resample(AsterDem, ReferenceRegion, datatype="INT2S", filename=OutFile,
                     options=c("COMPRESS=DEFLATE", "ZLEVEL=9"))
    rm(ReferenceRegion)
    # Delete original
    #file.remove(AsterTif) #, AsterZip - no permission
}

close(pb)
stopCluster(cl)


# Compares stem and crown ages for dating analyses using two methods:
# - penalized likelihood as implemented in treePL
# - bayesian relaxed clock models as implementes in BEAST
# - SA = Constrained Calibration (CC)
# - SB = Relaxed Calibration (RC)
# - SD = Unconstrained Calibration (UC)
# - phylo = conservative set
# - complete = complete set.
# Uses additional files.
# NOTE TO SELF: this can easily be automated! Currently needs to be edited with the names for each of the three dating analyses with different calibration strategies.
# NOTE TO SELF: probably also need to homogenize strategies' codes.

rich<-read.table("SPP.RICHNESS.csv",heade=T,sep=",") # file in data folder
tree = "~/Documents/NATURE/RESULTADOS_V4/TREES/SDstrict_treePL_dated.tre" # file in data folder (the six trees available in a ZIP file).

tre <- read.tree(tree)
##### CORRECT SOME TIP NAMES, ALTHOUGH NOT NECESSARY AT THIS POINT
tre$tip.label[which(tre$tip.label=="Celastrales_Celastraceae_Euonymus_spp_Celastraceae")]<-"Celastrales_Celastraceae_Euonymus_spp_Celastraceae.sstr"
tre$tip.label[which(tre$tip.label=="Laurales_Lauraceae_Hypodaphniszenkeri_Hypodaphnideae")]<-"Laurales_Lauraceae_Hypodaphnis_zenkeri_Hypodaphnideae"
tre$tip.label[which(tre$tip.label=="Brassicales_Batidaceae_Batis_maritima")]<-"Brassicales_Bataceae_Batis_maritima"
tre$tip.label[which(tre$tip.label=="Caryophyllales_Didieraceae_Alluaudia_spp")]<-"Caryophyllales_Didiereaceae_Alluaudia_spp"
tre$tip.label[which(tre$tip.label=="Caryophyllales_Didieraceae_Portulacaria_afra")]<-"Caryophyllales_Didiereaceae_Portulacaria_afra"
tre$tip.label[which(tre$tip.label=="Huerteales_Gerrardiniaceae_Gerrardina_foliosa")]<-"Huerteales_Gerrardinaceae_Gerrardina_foliosa"
tre$tip.label[which(tre$tip.label=="Huerteales_Petenaceae_Petenaea_cordata")]<-"Huerteales_Petenaeaceae_Petenaea_cordata"
tre$tip.label[which(tre$tip.label=="Liliales_Petermaniaceae_Petermannia_cirrosa")]<-"Liliales_Petermanniaceae_Petermannia_cirrosa"
tre$tip.label[which(tre$tip.label=="Liliales_Rhipogonaceae_Rhipogonum_elseyanum")]<-"Liliales_Ripogonaceae_Ripogonum_elseyanum"
tre$tip.label[which(tre$tip.label=="Liliales_Rhipogonaceae_Ripogonum_scandens")]<-"Liliales_Ripogonaceae_Ripogonum_scandens"
tre$tip.label[which(tre$tip.label=="Liliales_Rhipogonaceae_Rhipogonum_elseyanum")]<-"Liliales_Ripogonaceae_Ripogonum_elseyanum"
tre$tip.label[which(tre$tip.label=="Zingiberales_Strelitiziaceae_Ravenala_madagascariensis")]<-"Zingiberales_Strelitziaceae_Ravenala_madagascariensis"
tre$tip.label[which(tre$tip.label=="Zingiberales_Strelitiziaceae_Strelitizia_spp")]<-"Zingiberales_Strelitziaceae_Strelitzia_spp"
tre$tip.label[which(tre$tip.label=="Asterales_Stylidaceae_Donatia_spp")]<-"Asterales_Stylidiaceae_Donatia_spp"
tre$tip.label[which(tre$tip.label=="Asterales_Stylidaceae_Stylidium_spp")]<-"Asterales_Stylidiaceae_Stylidium_spp"
tre <- ladderize(tre,TRUE)
list<-tre$tip.label
list_ords <- foreach(i=1:length(list),.combine=c) %do% {strsplit(list,"_")[[i]][1]}
list_fams <- foreach(i=1:length(list),.combine=c) %do% {strsplit(list,"_")[[i]][2]}
list_subfams <- foreach(i=1:length(list),.combine=c) %do% {strsplit(list,"_")[[i]][5]}
list_ords_un<-sort(unique(list_ords));length(list_ords_un)
list_fams_un<-sort(unique(list_fams));length(list_fams_un)
list_subfams_un<-sort(unique(list_subfams));length(list_subfams_un)
list_un <- (c(list_ords_un,list_fams_un,list_subfams_un))
list_table<-cbind(list_ords,list_fams,list_subfams);list_table<-list_table[!duplicated(list_table),]
res<-matrix(nrow=length(list_fams_un)+length(list_ords_un)+length(list_subfams_un),ncol=6)
rownames(res)<-list_un; colnames(res)<-c("CG_age_Acal","SG_age_Acal","No_tips","Order","Family","Subfamily")
for(i in 1:length(list_un)){
  iden<-grep(list_un[i],x = tre$tip.label)
  res[i,3]<-length(iden)
  cat(i,"----",list_un[i],"\n")
  if(length(iden) == 1) {
    res[i,1]<-NA
    ssNODE <-tre$edge[which(tre$edge[,2]==iden),1]
    subtrea<-extract.clade(tre,ssNODE)
    res[i,2]<-max(branching.times(subtrea))
  }
  else{
    subtre<-extract.clade(tre,getMRCA(tre,tre$tip.label[iden]))
    if(length(subtre$tip.label)-length(iden)!=0) {cat("-----------","non-monophyletic","\n"); next}
    res[i,3]<-length(iden)
    res[i,1]<-max(branching.times(subtre))
    NODE <- getMRCA(tre,tre$tip.label[iden])
    subtre<-extract.clade(tre,tre$edge[which(tre$edge[,2]==NODE),1])
    res[i,2]<-max(branching.times(subtre))
  }}
for (i in 1:length(list_un)){
  if(i <= 68){res[i,4] <- as.character(list_un[i])}
  if(i > 68 & i<= 510) {res[i,4]<-as.character(list_table[match(rownames(res),list_table[,2])[i],1]); res[i,5]<-as.character(list_table[match(rownames(res),list_table[,2])[i],2])}
  if(i > 510) {res[i,4]<-as.character(list_table[match(rownames(res),list_table[,3])[i],1]); res[i,5]<-as.character(list_table[match(rownames(res),list_table[,3])[i],2]); res[i,6]<-as.character(list_table[match(rownames(res),list_table[,3])[i],3])
  }
}
res<-as.data.frame(res)
write.table(res,file=paste(ruta_write,2.1.Ages_complete_treePL.csv,sep=""),sep=",",row.names=T,col.names=T,quote = F)

file_beast = "RES_SDcomplete_v2/2.Ages_complete.csv" # generated in previous scripts.
file_treepl = "RES_SDcomplete_v2/2.1.Ages_complete_treePL.csv"

resBEAST<-read.table(file_beast,sep=",",header=T)
resTREEPL<-read.table(file_treepl,sep=",",header=T)
rich_ord<-rich[which(rich$Family==""),]; dim(rich_ord)
resBEAST$Order_richness<-rich_ord[match(resBEAST$Order,rich_ord$Order),"Spp_richness"]
rich_fams<-rich[which(rich$Subfamily==""),]; dim(rich_fams)
rich_fams<-rich_fams[which(rich_fams$Family!=""),]; dim(rich_fams)
resBEAST$Family_richness<-rich_fams[match(resBEAST$Family,rich_fams$Family),"Spp_richness"]
rich_subfams<-rich[which(rich$Subfamily!=""),]; dim(rich_subfams)
resBEAST$Subfamily_richness<-rich_subfams[match(resBEAST$Subfamily,rich_subfams$Subfamily),"Spp_richness"]
non<-which(rownames(resBEAST) %in% c("Aphloiaceae", "Daphniphyllaceae",
                                      "Brunelliaceae", "Cynomoriaceae", "Mayacaceae",
                                      "Mitrastemonaceae", "Oncothecaceae"))
resBEAST[non,"CG_age_Acal"]<-NA
resBEAST$Total_Richness <- rep(NA,dim(resBEAST)[1])
for (i in 1:dim(resBEAST)[1]){
  if(!is.na(resBEAST$Subfamily_richness[i])){resBEAST$Total_Richness[i] <- resBEAST$Subfamily_richness[i];next}
  if(!is.na(resBEAST$Family_richness[i])){resBEAST$Total_Richness[i] <- resBEAST$Family_richness[i];next}
  resBEAST$Total_Richness[i] <- resBEAST$Order_richness[i]}
out.group<-which(resBEAST$Order%in%c("Pinales","Gnetales","Ginkgoales","Cycadales"))
resBEAST<-resBEAST[-out.group,]
resTREEPL$Order_richness<-rich_ord[match(resTREEPL$Order,rich_ord$Order),"Spp_richness"]
rich_fams<-rich[which(rich$Subfamily==""),]; dim(rich_fams)
rich_fams<-rich_fams[which(rich_fams$Family!=""),]; dim(rich_fams)
resTREEPL$Family_richness<-rich_fams[match(resTREEPL$Family,rich_fams$Family),"Spp_richness"]
rich_subfams<-rich[which(rich$Subfamily!=""),]; dim(rich_subfams)
resTREEPL$Subfamily_richness<-rich_subfams[match(resTREEPL$Subfamily,rich_subfams$Subfamily),"Spp_richness"]
non<-which(rownames(resTREEPL) %in% c("Aphloiaceae", "Daphniphyllaceae",
                                   "Brunelliaceae", "Cynomoriaceae", "Mayacaceae",
                                   "Mitrastemonaceae", "Oncothecaceae"))
resTREEPL[non,"CG_age_Acal"]<-NA
resTREEPL$Total_Richness <- rep(NA,dim(resTREEPL)[1])
for (i in 1:dim(resTREEPL)[1]){
  if(!is.na(resTREEPL$Subfamily_richness[i])){resTREEPL$Total_Richness[i] <- resTREEPL$Subfamily_richness[i];next}
  if(!is.na(resTREEPL$Family_richness[i])){resTREEPL$Total_Richness[i] <- resTREEPL$Family_richness[i];next}
  resTREEPL$Total_Richness[i] <- resTREEPL$Order_richness[i]}
out.group<-which(resTREEPL$Order %in% c("Pinales","Gnetales","Ginkgoales","Cycadales"))
resTREEPL<-resTREEPL[-out.group,]

orders<-1:64
fams<-65:500
subfams<-501:dim(resTREEPL)[1]
print(unique(rownames(resTREEPL)==rownames(resBEAST)))
resTREEPL<-resTREEPL[fams,]
resBEAST<-resBEAST[fams,]

pdf("1.ComparisonMethods_UC.pdf")
plot(resTREEPL$SG_age_Acal,resBEAST$SG_age_Acal,type="n",ylim=c(0,200),xlim=c(0,200),
     xlab="Stem ages (treePL)",ylab="Stem ages (BEAST)");abline(a=0,b=1)
title("Stem age estimates (families)")
points(resBEAST$SG_age_Acal,resTREEPL$SG_age_Acal,pch=21,cex=1,bg=rgb(1,0,0,0.8))
plot(resBEAST$CG_age_Acal,resTREEPL$CG_age_Acal,type="n",ylim=c(0,200),xlim=c(0,200),
     xlab="Crown ages (complete set)",ylab="Crown ages (phylo-only set)");abline(a=0,b=1)
title("Crown age estimates (families)")
points(resBEAST$CG_age_Acal,resTREEPL$CG_age_Acal,pch=21,cex=1,bg=rgb(1,0,0,0.8))
dev.off()


F.summary.table= function(x){

  y = res$mcmc
  sb= res$p$fishery_model$standata

  ntacs = sb$nProj
  yrs0 = as.numeric( as.character( rownames(sb$IOA) ) )
  yrs = c( yrs0, (max(yrs0)+c(1:sb$M) ) )

  SI =  apply( y$q, 2, median, na.rm=T  )

  tab=as.data.frame(yrs)
  for (i in 1:3) {
    meanval = apply( y$F[,,i], 2, mean, na.rm=T  )
    meanval = as.data.frame(meanval)
    if (i==1) {names(meanval)="nens"}
    if (i==2) {names(meanval)="sens"}
    if (i==3) {names(meanval)="4x"}
    tab=cbind(tab, meanval)
  }
  tab=tab[which(tab$yrs %in% yrs0),]
  print("The following table is the mean modelled biomass estimates by area by year:")
  print("Area names hard-coded, confirm they are logical")
    print(tab)
  print("4X is closing year of fishing season / assessment year")
    }


library(Biostrings)
# QCs ----
setwd("~/cfo155/whole_genome_lrTAPS")
dat1 <- read.table("sta/bc1001.uniflag.sta", header=TRUE)
dat2 <- read.table("sta/bc1002.uniflag.sta", header=TRUE)
dat3 <- read.table("sta/bc1003.uniflag.sta", header=TRUE)
dat <- rbind(dat1,dat2)
rownames(dat) <- c("bc1001","bc1002")
dat$id <- c("bc1001","bc1002")
dat$conversion <- (gsub(".*;\\(|/.*","",dat$kb4_meth_c) %>% as.character() %>% as.numeric() +
                  gsub(".*;\\(|/.*","",dat$kb4_meth_g) %>% as.character() %>% as.numeric()) /
                  (gsub(".*/|\\)","",dat$kb4_meth_c) %>% as.character() %>% as.numeric() +
                  gsub(".*/|\\)","",dat$kb4_meth_g) %>% as.character() %>% as.numeric())

dat$fp <- (gsub(".*;\\(|/.*","",dat$kb4_unmeth_c) %>% as.character() %>% as.numeric() +
             gsub(".*;\\(|/.*","",dat$kb4_unmeth_g) %>% as.character() %>% as.numeric()) /
  (gsub(".*/|\\)","",dat$kb4_unmeth_c) %>% as.character() %>% as.numeric() +
     gsub(".*/|\\)","",dat$kb4_unmeth_g) %>% as.character() %>% as.numeric())

p <- ggplot(dat, aes(x = id, y = conversion*100)) + geom_bar(stat = "identity", fill = "orangered3", col = "orangered3") +
  geom_text(aes(label=round(conversion*100, 2)), vjust=-0.4) +
  theme_light() + xlab("") + ylab("mCG conversion on 4kb (%)") + theme(axis.text = element_text(color = "black")) + ylim(0,100)
ggsave("plots/mC_conversion.pdf",p,width=2,height = 4)
p <- ggplot(dat, aes(x = id, y = fp*100)) + geom_bar(stat = "identity", fill = "steelblue", col = "steelblue") +
  geom_text(aes(label=round(fp*100, 2)), vjust=-0.4) +
  theme_light() + xlab("") + ylab("false positive on unmodified cg(4kb) (%)") + theme(axis.text = element_text(color = "black"))  + ylim(0,0.5)
ggsave("plots/mC_fp.pdf",p,width=2,height = 4)

dat$genome_meth <- (gsub(".*;\\(|/.*","",dat$genome_meth_c) %>% as.character() %>% as.numeric() +
                     gsub(".*;\\(|/.*","",dat$genome_meth_g) %>% as.character() %>% as.numeric()) /
  (gsub(".*/|\\)","",dat$genome_meth_c) %>% as.character() %>% as.numeric() +
     gsub(".*/|\\)","",dat$genome_meth_g) %>% as.character() %>% as.numeric())
p <- ggplot(dat, aes(x = id, y = genome_meth*100, fill=id)) + geom_bar(stat = "identity") +
  geom_text(aes(label=round(genome_meth*100, 2)), vjust=-0.4) +
  theme_light() + xlab("") + ylab("genome methylation (%)") + theme(axis.text = element_text(color = "black"), legend.position = "none") +
  scale_fill_manual(values=brewer.pal(2,"Dark2"))
ggsave("plots/genome_meth.pdf",p,width=2,height = 4)

dat$pmap <- (dat$nfwd_bam + dat$nrev_bam)/dat$nraw
p <- ggplot(dat, aes(x = id, y = pmap*100)) + geom_bar(stat = "identity", fill = "steelblue", col = "steelblue") +
  geom_text(aes(label=round(pmap*100, 2)), vjust=-0.4) +
  scale_y_continuous(limits = c(0, 100), breaks = seq(0, 100, by = 10)) +
  theme_light() + xlab("") + ylab(" Q20 mapping rate (%)") + theme(axis.text = element_text(color = "black"))

ggsave("plots/map_rate.pdf",p,width=2,height = 4)

# Methylation on chrHMM ----
dat1 <- read.table("meth/bc1001.uniflag_CpG.chrHMM.sta", header=FALSE)
dat2 <- read.table("meth/bc1002.uniflag_CpG.chrHMM.sta", header=FALSE)
dat3 <- read.table("resource/mESC_cStates_HMM.taps.shortread.sta",header=FALSE)
dat <- merge(dat1,dat2,by=c("V1")) %>% merge(dat3,by=c("V1"))
colnames(dat) <- c("chrHMM","bc1001_meth","bc1001_mC","bc_1001_aC","bc1002_meth","bc1002_mC","bc_1002_aC","taps_meth","taps_mC","taps_aC")
p <- ggplot(dat[,c(1,grep("meth",colnames(dat)))] %>% melt(id.vars=c("chrHMM")),aes(x=chrHMM,y=value*100,fill=variable)) +
  geom_bar(stat="identity", position=position_dodge()) +
  theme_light() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), legend.position = "bottom") +
  xlab("chrHMM state") +
  ylab("methylation (%)") +
  scale_fill_manual(values=brewer.pal(3,"Dark2"))

ggsave("plots/mESC_chrHMM.meth.pdf",p,width = 6, height = 4)

# Depth vs. CpG density ----
bc1001_tg_cov <- read.table("align/bc1001.tg.cov.bedGraph", header=FALSE)[-c(1:2),1:5]
bc1001_ca_cov <- read.table("align/bc1001.ca.cov.bedGraph", header=FALSE)[-c(1:2),1:5]
bc1002_tg_cov <- read.table("align/bc1002.tg.cov.bedGraph", header=FALSE)[-c(1:2),1:5]
bc1002_ca_cov <- read.table("align/bc1002.ca.cov.bedGraph", header=FALSE)[-c(1:2),1:5]

cov <- merge(bc1001_tg_cov, bc1001_ca_cov,by=c("V1","V2","V3")) %>%
  merge(bc1002_tg_cov,by=c("V1","V2","V3")) %>%
  merge(bc1002_ca_cov,by=c("V1","V2","V3"))
colnames(cov) <- c("chr","start","end","bc1001_tg_depth","bc1001_tg_cov","bc1001_ca_depth","bc1001_ca_cov","bc1002_tg_depth","bc1002_tg_cov","bc1002_ca_depth","bc1002_ca_cov")
cov$bc1001_tg_depth <- cov$bc1001_tg_depth/7.45
cov$bc1001_ca_depth <- cov$bc1001_ca_depth/7.45
cov$bc1002_tg_depth <- cov$bc1002_tg_depth/8.08
cov$bc1002_ca_depth <- cov$bc1002_ca_depth/8.08

taps <- read_delim("/gpfs2/well/ludwig/users/cfo155/ncbi/public/sra/taps_pub.average.methratio.txt",delim="\t",col_names=TRUE)
taps$taps <- (taps$taps_meth>0.1 & (taps$mC + taps$uC >3)) %>% as.numeric()
taps$idx <- floor(taps$start/50000)*50000
taps_dens <- aggregate(taps ~ chr+idx, taps, sum)
cov_dens <- merge(cov,taps_dens, by.x=c("chr","start"), by.y=c("chr","idx"),all.x=TRUE)
cov_dens$taps_lvl <- cut(cov_dens$taps, breaks=quantile(cov_dens$taps,na.rm=TRUE, probs=seq(0,1,1/10)), include.lowest = TRUE, labels = seq(1,10))

p <- ggplot(na.omit(cov_dens[,c(1:3,grep("depth|lvl",colnames(cov_dens)))]) %>% melt(id.vars=c("chr","start","end","taps_lvl")),aes(x=taps_lvl,y=value)) +
  geom_boxplot(outlier.shape = NA) +
  ylim(0,4)+
  facet_wrap(factor(variable) ~ ., scales="free", nrow=2) +
  xlab("mCG density") +
  ylab("depth in 50k bin")

ggsave("plots/cpg_dens.pdf",p,width = 6, height = 5)

# Read Length ----
setwd("~/cfo155/whole_genome_lrTAPS")
dat1 <- read.table("fastq/bc1001.read_len.txt", header=TRUE)
dat2 <- read.table("fastq/bc1002.read_len.txt", header=TRUE)
dat1[,2] <- dat1[,2]/7.45
dat2[,2] <- dat2[,2]/8.08

dat <- merge(dat1,dat2,by=c("len"), all.x = TRUE, all.y=TRUE) %>% melt(id.vars="len")
dat$variable <- gsub("fastq.|.read_len.txt","",dat$variable )
p <- ggplot(dat, aes(x=len,y=value,fill=variable)) +
  geom_bar(stat="identity", position=position_dodge(), alpha=0.7) +
  ylab("normalized reads number") +
  xlab("read length") +
  theme_light() + xlim(0,10000) +
  theme(legend.position = "bottom")

ggsave("plots/read_lens.pdf",p,width = 6, height = 4)
ggsave("plots/read_lens.png",p,width = 6, height = 4)
# Aligned Length ----
dat1 <- read.table("align/bc1001.ca.sta.txt", header=TRUE)
dat2 <- read.table("align/bc1001.tg.sta.txt", header=TRUE)
dat3 <- read.table("align/bc1002.ca.sta.txt", header=TRUE)
dat4 <- read.table("align/bc1002.tg.sta.txt", header=TRUE)
dat1[,2] <- dat1[,2]/7.45; dat2[,2] <- dat2[,2]/7.45
dat3[,2] <- dat3[,2]/8.08; dat4[,2] <- dat4[,2]/7.45

dat <- merge(dat1,dat2,by=c("len"), all.x = TRUE, all.y=TRUE) %>%
  merge(dat3,by=c("len"), all.x = TRUE, all.y=TRUE )%>%
  merge(dat4, by=c("len"), all.x = TRUE, all.y=TRUE)  %>% melt(id.vars="len")

dat$variable <- gsub("align.|.len.txt","",dat$variable )
p <- ggplot(dat, aes(x=len,y=value,fill=variable)) +
  geom_bar(stat="identity", position=position_dodge(), alpha=0.7) +
  ylab("normalized reads number") +
  xlab("align length") +
  theme_light() + xlim(0,8000) +
  theme(legend.position = "bottom")

ggsave("plots/align_lens.pdf",p,width = 6, height = 4)
ggsave("plots/align_lens.png",p,width = 6, height = 4)

dat1 <- read.table("align/bc1001.ca.len.txt", header=FALSE)
dat2 <- read.table("align/bc1001.tg.len.txt", header=FALSE)
N50(c(dat1$V1,dat2$V1))
dat3 <- read.table("align/bc1002.ca.len.txt", header=FALSE)
dat4 <- read.table("align/bc1002.tg.len.txt", header=FALSE)
N50(c(dat3$V1,dat4$V1))

# Coverage on chrHMM ----
bc1001_tg_cov <- read.table("align/bc1001.tg.chrHMM.cov.sta", header=FALSE)
bc1001_ca_cov <- read.table("align/bc1001.ca.chrHMM.cov.sta", header=FALSE)
bc1002_tg_cov <- read.table("align/bc1002.tg.chrHMM.cov.sta", header=FALSE)
bc1002_ca_cov <- read.table("align/bc1002.ca.chrHMM.cov.sta", header=FALSE)
bc1003_tg_cov <- read.table("align/bc1003.tg.chrHMM.cov.sta", header=FALSE)
bc1003_ca_cov <- read.table("align/bc1003.ca.chrHMM.cov.sta", header=FALSE)
len <- read.table("resource/mESC_cStates_HMM.len.sta",header=FALSE)

dat <- merge(bc1001_tg_cov,bc1001_ca_cov,by=c("V1")) %>% merge(bc1002_tg_cov,by=c("V1")) %>% merge(bc1002_ca_cov,by=c("V1")) %>% merge(bc1003_tg_cov,by=c("V1")) %>% merge(bc1003_ca_cov,by=c("V1")) %>% merge(len,by=c("V1"))
colnames(dat) <- c("chrHMM","bc1001_tg_depth","bc1001_tg_pcov","bc1001_tg_cov", "bc1001_ca_depth","bc1001_ca_pcov","bc1001_ca_cov","bc1002_tg_depth","bc1002_tg_pcov","bc1002_tg_cov", "bc1002_ca_depth","bc1002_ca_pcov","bc1002_ca_cov", "subbc1002_tg_depth","subbc1002_tg_pcov","subbc1002_tg_cov", "subbc1002_ca_depth","subbc1002_ca_pcov","subbc1002_ca_cov","len")
dat$bc1001_tg_p <- dat$bc1001_tg_cov/dat$len
dat$bc1001_ca_p <- dat$bc1001_ca_cov/dat$len
dat$bc1002_tg_p <- dat$bc1002_tg_cov/dat$len
dat$bc1002_ca_p <- dat$bc1002_ca_cov/dat$len
dat$subbc1002_tg_p <- dat$subbc1002_tg_cov/dat$len
dat$subbc1002_ca_p <- dat$subbc1002_ca_cov/dat$len

p1 <- ggplot(dat[,c(1,grep("depth",colnames(dat)))] %>% melt(id.vars=c("chrHMM")),aes(x=chrHMM,y=value*100,fill=variable))+
  geom_bar(stat="identity", position=position_dodge(), alpha=0.7) +
  ylab("# total read") +
  xlab("chr HMM") +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), legend.position = "bottom")

p2 <- ggplot(dat[,c(1,grep("p$",colnames(dat)))] %>% melt(id.vars=c("chrHMM")),aes(x=chrHMM,y=value*100,fill=variable))+
  geom_bar(stat="identity", position=position_dodge(), alpha=0.7) +
  ylab("% cov") +
  xlab("chr HMM") +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), legend.position = "bottom")
p <- plot_grid(p1, p2)
ggsave("plots/mESC_chrHMM.coverage.pdf",p,width = 15, height = 6)
ggsave("plots/mESC_chrHMM.coverage.png",p,width = 15, height = 6)

## combine
bc1001_cov <- read.table("align/bc1001.chrHMM.cov.sta", header=FALSE)
bc1002_cov <- read.table("align/bc1002.chrHMM.cov.sta", header=FALSE)
bc1003_cov <- read.table("align/bc1003.chrHMM.cov.sta", header=FALSE)
short_cov <- read.table("shortread_taps/merged_bam.md.cov.sta",header=FALSE)
len <- read.table("resource/mESC_cStates_HMM.len.sta",header=FALSE)

dat <- merge(bc1001_cov,bc1002_cov,by=c("V1")) %>% merge(bc1003_cov,by=c("V1"))  %>% merge(short_cov,by=c("V1")) %>% merge(len,by=c("V1"))
colnames(dat) <- c("chrHMM","bc1001_depth","bc1001_pcov","bc1001_cov","bc1002_depth","bc1002_pcov","bc1002_cov","subbc1002_depth","subbc1002_pcov","subbc1002_cov","short_depth","short_pcov","short_cov","len")
dat$bc1001_p <- dat$bc1001_cov/dat$len
dat$bc1002_p <- dat$bc1002_cov/dat$len
dat$subbc1002_p <- dat$subbc1002_cov/dat$len
dat$short_p <- dat$short_cov/dat$len

p1 <- ggplot(dat[,c(1,grep("depth",colnames(dat)))] %>% melt(id.vars=c("chrHMM")),aes(x=chrHMM,y=value*100,fill=variable))+
  geom_bar(stat="identity", position=position_dodge(), alpha=0.7) +
  ylab("# total read") +
  xlab("chr HMM") +
  facet_grid(rows = vars(variable), scales="free_y") +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), legend.position = "bottom")

p2 <- ggplot(dat[,c(1,grep("p$",colnames(dat)))] %>% melt(id.vars=c("chrHMM")),aes(x=chrHMM,y=value*100,fill=variable))+
  geom_bar(stat="identity", position=position_dodge(), alpha=0.7) +
  ylab("% cov") +
  xlab("chr HMM") +
  facet_grid(rows = vars(variable)) +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), legend.position = "bottom")
p <- plot_grid(p1, p2)
ggsave("plots/mESC_chrHMM.coverage.cmb.pdf",p,width = 12, height = 6)
ggsave("plots/mESC_chrHMM.coverage.cmb.png",p,width = 12, height = 6)
# CGI cov ----
bc1001_cov <- read.table("align/bc1001.cgi.cov.sta", header=FALSE)
bc1002_cov <- read.table("align/bc1002.cgi.cov.sta", header=FALSE)
bc1003_cov <- read.table("align/bc1003.cgi.cov.sta", header=FALSE)
len <- read.table("resource/cpgIslandExt.txt",header=FALSE)

dat <- cbind(bc1001_cov,bc1002_cov) %>% cbind(bc1003_cov)  %>% cbind(sum(len$V4-len$V3))
colnames(dat) <- c("bc1001_depth","bc1001_pcov","bc1001_cov","bc1002_depth","bc1002_pcov","bc1002_cov","subbc1002_depth","subbc1002_pcov","subbc1002_cov","len")
dat$bc1001_p <- dat$bc1001_cov/dat$len
dat$bc1002_p <- dat$bc1002_cov/dat$len
dat$subbc1002_p <- dat$subbc1002_cov/dat$len
dat$feature <- "cgi"

p1 <- ggplot(dat[,c(grep("depth|feature",colnames(dat)))] %>% melt(id.vars=c("feature")),aes(x=feature,y=value*100,fill=variable))+
  geom_bar(stat="identity", position=position_dodge(), alpha=0.7) +
  ylab("# total read") +
  xlab("feature") +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), legend.position = "bottom")

p2 <- ggplot(dat[,c(grep("p$|feature",colnames(dat)))] %>% melt(id.vars=c("feature")),aes(x=feature,y=value*100,fill=variable))+
  geom_bar(stat="identity", position=position_dodge(), alpha=0.7) +
  ylab("% cov") +
  xlab("feature") +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), legend.position = "bottom")
p <- plot_grid(p1, p2)
ggsave("plots/mESC_cgi.coverage.cmb.pdf",p,width = 4, height = 6)
ggsave("plots/mESC_cgi.coverage.cmb.png",p,width = 4, height = 6)

# covered sites ---
grid.newpage()
pdf("plots/covered_sites.pdf",width = 4,height = 4)
bc1001 <- 1425646958
bc1002 <- 1484131961
shortr <- 2542284168
bc1001_bc1002 <- 910008142
bc1001_shortr <- 1423644222
bc1002_shortr <- 1481521517
bc1001_bc1002_shortr <-  908875523
draw.triple.venn(
  area1     = bc1001,
  area2     = bc1002,
  area3     = shortr,
  n12       = bc1001_bc1002,
  n23       = bc1002_shortr,
  n13       = bc1001_shortr,
  n123      = bc1001_bc1002_shortr,
  category  = c('bc1001', 'bc1002', 'short_read'),
  fill      = c("#446db4","#23b177","#fac133"),
  cat.col   = c("#446db4","#23b177","#fac133"),
  euler.d = TRUE,
  scaled    = TRUE
)
dev.off()

dat <- read.table("align/bc1002.chrHMM.len.txt")
p <- ggplot(dat,aes(x=V8,y=V4)) +  geom_violin() + geom_boxplot(outlier.shape = NA, width=0.1) +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), legend.position = "bottom")
ggsave("plots/frag_len.chrhmm.bc1002.pdf",p,width = 6, height = 4)
dat <- read.table("align/bc1001.chrHMM.len.txt")
p <- ggplot(dat,aes(x=V8,y=V4)) +  geom_violin() + geom_boxplot(outlier.shape = NA, width=0.1) +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), legend.position = "bottom")
ggsave("plots/frag_len.chrhmm.bc1001.pdf",p,width = 6, height = 4)

# covered sites ----
bc1001_cov <- read.table("align/bc1001.lc_extrap.txt", header=TRUE)
bc1002_cov <- read.table("align/bc1002.lc_extrap.txt", header=TRUE)
bc1003_cov <- read.table("align/bc1003.lc_extrap.txt", header=TRUE)

dat <- merge(bc1001_cov,bc1002_cov,by="TOTAL_READS") %>% merge(bc1003_cov,by="TOTAL_READS")
colnames(dat) <- c("total","bc1001_distinct","bc1001_lower_ci","bc1001_upper_ci","bc1002_distinct","bc1002_lower_ci","bc1002_upper_ci","subbc1002_distinct","subbc1002_lower_ci","subbc1002_higher_ci")
dat$bc1001_p <- dat$bc1001_distinct/dat$total
dat$bc1002_p <- dat$bc1002_distinct/dat$total
dat$subbc1002_p <- dat$subbc1002_distinct/dat$total

p1 <- ggplot(dat[dat$total<10000000 & dat$total>0,c(grep("_p|total",colnames(dat)))] %>% melt(id.vars=c("total")),aes(x=total,y=value*100,fill=variable))+
  geom_bar(stat="identity", position=position_dodge(), alpha=0.7) +
  ylab("distinct reads%") +
  xlab("reads sequenced") +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), legend.position = "bottom")
p1
ggsave("plots/lc_extrap.pdf",p1,width = 6, height = 4)

# PCR duplicates ----
bc1001_dup <- read.table("align/bc1001.rm.sta", header=FALSE)
bc1002_dup <- read.table("align/bc1002.rm.sta", header=FALSE)

dat <- rbind(bc1001_dup, bc1002_dup)
dat$smp <- c("bc1001","bc1002")

p1 <- ggplot(dat,aes(x=smp,y=(1-V3)*100))+
  geom_bar(stat="identity")+
  geom_text(aes(label=round((1-V3)*100, 2)), vjust=-0.4) +
  ylab("PCR duplicates%") +
  xlab("smp") +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), legend.position = "bottom")
p1
ggsave("plots/pcr_rm.pdf",p1,width = 2, height = 4)

# Meth context ----
bc1001_meth <- read.table("meth/bc1001.uniflag_CpG.context.sta", header=FALSE)
bc1002_meth <- read.table("meth/bc1002.uniflag_CpG.context.sta", header=FALSE)

dat <- merge(bc1001_meth[,c(1,4)], bc1002_meth[,c(1,4)],by=c("V1"))
colnames(dat) <- c("context","bc1001","bc1002")

p1 <- ggplot(melt(dat),aes(x=context,y=value,fill=variable))+
  geom_bar(stat="identity", position = "dodge")+
  ylab("Methylation%") +
  xlab("smp") +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), legend.position = "bottom")
p1
ggsave("plots/meth_context.pdf",p1,width = 6, height = 4)