#' ---
#' title: "Script 3 of pipeline: read in workspace from script1, run beta diversity analysis"
#' author: "Francesco Vitali"
#' output: html_document
#' ---

#' ```{r setup library load, include=FALSE}

library(phyloseq)
library(tidyverse)
library(data.table)
library(ggsci)
library(ggpubr)
library(microbiome)
library(patchwork)
library(metagenomeSeq)
library(vegan)
library(reshape2)
library(psych)
library(corrplot)
library(rstatix)
library(pairwiseAdonis)

# red in workspace from script 1

load ("./WP3WP4_workspace")

palette_custom <- c("#1F78B4", "#E31A1C", "#FF7F00", "#33A02C")

#' knitr::opts_chunk$set(fig.width=unit(15,"cm"), fig.height=unit(11,"cm"))

#' ```

#' ```

#' *BACTERIA*

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

#' **WP3 BACTERIA**

#############
#' ```{r betadiv bact WP3, include=TRUE, echo = FALSE}

# how to transform data for beta diversity analysis?

# calculate the variation in read obtained per sample
sdt = data.table(as(sample_data(WP3_initial_bact), "data.frame"),
                 TotalReads = sample_sums(WP3_initial_bact), keep.rownames = TRUE)
summary(sdt$TotalReads)
max(sdt$TotalReads)/min(sdt$TotalReads)
# variation in read depth is 7X

# plot reads to find outliers

sdt %>%
  filter(AnimalID != "E149-40") %>%
  ggboxplot(.,y = "TotalReads")

sdt %>%
  filter(AnimalID != "E149-40") %>%
  summary()

# NORMALIZATION: open problematic of which to choose

# see https://microbiomejournal.biomedcentral.com/articles/10.1186/s40168-017-0237-y
# see https://journals.plos.org/ploscompbiol/article?id=10.1371/journal.pcbi.1003531
# see https://www.nature.com/articles/s41522-020-00160-w

# new kid on the block! : avgdist() supported by Schloss
# (see https://www.youtube.com/watch?v=xyufizOpc5I) also (https://www.youtube.com/watch?v=ht3AX5uZTTQ) also (https://www.youtube.com/watch?v=t5qXPIS-ECU)
# So, the whole thing is about rarefaction or not. He support rarefaction as is the only method that is removing some relation between BC distance and
# depth of sampling (n reads). To note, however, is that he is not doing the "classical" rarefaction (i.e. as in script2.r for alpha-div) using subsampling
# and replacement, as it is not that good, as it really all depends on the seed and on which sequences get subsampled.
# Instead, in the videos above, he use a nice combination of rarefaction and vegdist: he use rarefaction analysis followed by BC calculation multiple time,
# so that the final distance matrix is an average od the distance matrices obtained over the different replicates and the relation with n° seqs disappear, but
# without the risk of normal (single) rarefaction of loosing OTUs only by chance of the random procedure.
# So, he is using un-rarefied and un-transformed counts, but rather performs this normalization step at the level of distance calculation.
# From the video, and also conceptually, seems very convincing.

# CSS remain one of the most interesting and supported, but rarefaction is still an option.
# Evaluate both Bray and Jaccard eventually, in one case to evaluate changes in abundance, in the other
# changes as presence/absence

# Data driven evaluation: transform with rarefaction and with CSS, calculate bray and jaccard, compare with Mantel

# generate a 10% prevalece filter dataset (see https://www.nature.com/articles/s41467-022-28034-z)

# calculate prevalence for each ASV
WP3.bact.ASVprev <- prevalence(subset_samples(WP3_initial_bact, AnimalID != "E149-40"), detection=0, sort=TRUE, count=F)
summary(names(WP3.bact.ASVprev[WP3.bact.ASVprev > 0.1]))
summary(names(WP3.bact.ASVprev[WP3.bact.ASVprev < 0.1]))
# create an object with only the ASV in more than 10% of samples
WP3_initial_bact_prevalence <- prune_taxa(names(WP3.bact.ASVprev[WP3.bact.ASVprev > 0.1]), subset_samples(WP3_initial_bact, AnimalID != "E149-40"))
#check
min(prevalence(WP3_initial_bact_prevalence, detection=0, sort=TRUE, count=F))

# rarefaction on the full dataset
WP3_raref_bact<- rarefy_even_depth(subset_samples(WP3_initial_bact, AnimalID != "E149-40"),
                                   rngseed=1234,
                                   sample.size=round(0.99*min(sample_sums(subset_samples(WP3_initial_bact, AnimalID != "E149-40")))),
                                   replace=F)

# rarefaction on the prevalence dataset
WP3_raref_bact.prevalence<- rarefy_even_depth(subset_samples(WP3_initial_bact_prevalence, AnimalID != "E149-40"),
                                   rngseed=1234,
                                   sample.size=round(0.99*min(sample_sums(subset_samples(WP3_initial_bact_prevalence, AnimalID != "E149-40")))),
                                   replace=F)

# CSS scaling (not removing singletons) on the full dataset
data.metagenomeSeq = phyloseq_to_metagenomeSeq(subset_samples(WP3_initial_bact, AnimalID != "E149-40"))
p = cumNormStat(data.metagenomeSeq) #default is 0.5
data.cumnorm = cumNorm(data.metagenomeSeq, p=p)
#data.cumnorm
data.CSS = MRcounts(data.cumnorm, norm=TRUE, log=TRUE)
WP3_CSS_bact <- subset_samples(WP3_initial_bact, AnimalID != "E149-40")
otu_table(WP3_CSS_bact) <- otu_table(data.CSS, taxa_are_rows = T)

# CSS scaling (not removing singletons) on the prevalence dataset
data.metagenomeSeq = phyloseq_to_metagenomeSeq(subset_samples(WP3_initial_bact_prevalence, AnimalID != "E149-40"))
p = cumNormStat(data.metagenomeSeq) #default is 0.5
data.cumnorm = cumNorm(data.metagenomeSeq, p=p)
#data.cumnorm
data.CSS = MRcounts(data.cumnorm, norm=TRUE, log=TRUE)
WP3_CSS_bact.prevalence <- subset_samples(WP3_initial_bact_prevalence, AnimalID != "E149-40")
otu_table(WP3_CSS_bact.prevalence) <- otu_table(data.CSS, taxa_are_rows = T)

# calculate distance matrices
bray_WP3_raref <- phyloseq::distance(WP3_raref_bact, "bray")
bray_WP3_CSS <- phyloseq::distance(WP3_CSS_bact, "bray")

bray_WP3_raref.prevalence <- phyloseq::distance(WP3_raref_bact.prevalence, "bray")
bray_WP3_CSS.prevalence <- phyloseq::distance(WP3_CSS_bact.prevalence, "bray")

# check if order of the matrix is the same
summary(melt(as.matrix(bray_WP3_raref))[1] == melt(as.matrix(bray_WP3_CSS))[1])

# perform mantel test
set.seed(35264)
mantel(xdis = bray_WP3_CSS, ydis = bray_WP3_raref, permutations = 999, method = "pearson")

set.seed(35264)
mantel(xdis = bray_WP3_CSS, ydis = bray_WP3_CSS.prevalence, permutations = 999, method = "pearson")

set.seed(35264)
mantel(xdis = bray_WP3_raref, ydis = bray_WP3_raref.prevalence, permutations = 999, method = "pearson")

mds.css <- monoMDS(bray_WP3_CSS)
mds.raref <- monoMDS(bray_WP3_raref)
WP3.bact.proc <- procrustes(mds.raref, mds.css)
summary(WP3.bact.proc)
plot(WP3.bact.proc)

# see if biological interpretation is the same or not
df <- as(sample_data(WP3_CSS_bact), "data.frame")
perm <- how(nperm = 999)
setBlocks(perm) <- with(df, AnimalID)

set.seed(12387)
adonis2(bray_WP3_CSS ~ Time * Diet * Sacrif_dfference, data = df, permutations = perm)
set.seed(12387)
adonis2(bray_WP3_CSS.prevalence ~ Time * Diet * Sacrif_dfference, data = df, permutations = perm)

set.seed(12387)
adonis2(bray_WP3_raref ~ Time * Diet * Sacrif_dfference, data = df, permutations = perm)
set.seed(12387)
adonis2(bray_WP3_raref.prevalence ~ Time * Diet * Sacrif_dfference, data = df, permutations = perm)

# significance and R2 only show minor changes, but the Mantel correl between the two dist matrices is not high
# overall, higher R2 in all factors (time diet and sacrifice difference) with CSS.prevalence dataset

# This set the basis of choosing the CSS transformation on the prevalence (10%) filtered dataset as this seems
# to show higher power to discriminate over the exp factors

# Perform ordination now

# NMDS
set.seed(34624)
WP3_bact_ord <- ordinate(WP3_CSS_bact.prevalence, "NMDS", distance = "bray")
p.WP3_bact_ord <- plot_ordination(physeq = WP3_CSS_bact.prevalence, WP3_bact_ord, axes = c(1,2))
p.WP3_bact_ord <- p.WP3_bact_ord + geom_point(size = 5, stroke = 0.8, aes(fill = Diet, shape = Time)) #+ geom_text(mapping = aes(label = Gender), size = 3, nudge_x = 0.015, nudge_y = -0.015)
p.WP3_bact_ord <- p.WP3_bact_ord + theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  scale_shape_manual(values = c(21,22,23,24))+
  xlab("Dim1") + ylab("Dim2") + labs( fill = "Diet") + theme(legend.position="right")

p.WP3_bact_ord

df <- as(sample_data(WP3_CSS_bact.prevalence), "data.frame")
perm <- how(nperm = 999)
setBlocks(perm) <- with(df, AnimalID)

bray_WP3_CSS.prevalence <- phyloseq::distance(WP3_CSS_bact.prevalence, "bray")

set.seed(12387)
adonis2(bray_WP3_CSS.prevalence ~ Time + Diet + Sacrif_dfference, data = df, permutations = perm)

# NMDS with Schloss approach

# starting data is the untransformed DF, will still remove the lower outlier and remove low prevalence OTUs
phylo_schloss <- subset_samples(WP3_initial_bact_prevalence, AnimalID != "E149-40")
otu_table_schloss <- otu_table(phylo_schloss)@.Data

otu_table_schloss %>%
  t() %>%
  as.data.frame() -> otu_table_schloss

# adding some metadata
row.names(otu_table_schloss) == row.names(sample_data(phylo_schloss))
otu_table_schloss <- cbind(sample_data(phylo_schloss)[,3:4], otu_table_schloss)

# calculate depth
nSeqs <- min(sample_sums(phylo_schloss))

# calculate rarefaction of BC distance and plot MDS
set.seed(43655826)
raref_BC <- avgdist(x = otu_table_schloss[,-c(1,2)], sample = nSeqs, dmethod = "bray", iterations = 100)
set.seed(62853)
schloss_MDS <- metaMDS(raref_BC)

scores(schloss_MDS) %>%
  as_tibble(rownames = "Group") %>%
  ggplot(aes(x = NMDS1, y = NMDS2)) +
  geom_point(size = 5, stroke = 0.8, aes(fill = otu_table_schloss$Diet, shape = otu_table_schloss$Time))+
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  scale_shape_manual(values = c(21,22,23,24))+
  xlab("Dim1") + ylab("Dim2") + labs( fill = "Diet") + theme(legend.position="right")

# PCOA

WP3_CSS_bact.prevalenceT3 <- subset_samples(WP3_CSS_bact.prevalence, Time == "T3")

WP3_bact_ord <- ordinate(WP3_CSS_bact.prevalenceT3, "PCoA", distance = "bray")
p.WP3_bact_ord <- plot_ordination(physeq = WP3_CSS_bact.prevalenceT3, WP3_bact_ord, axes = c(1,2))
p.WP3_bact_ord <- p.WP3_bact_ord +
  geom_point(size = 3, stroke = 0.8, aes(fill = Diet), shape = 22)
p.WP3_bact_ord <- p.WP3_bact_ord +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  xlab("PCoA1 (17.4%)") +
  ylab("PCoA2 (11.6%)") +
  labs(fill = "Diet", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23))) -> p.WP3_bact_ord_1

p.WP3_bact_ord -> p.WP3_bact_ord_final

# pairwise adonis
df <- as(sample_data(WP3_CSS_bact.prevalenceT3), "data.frame")
d.bacteria = phyloseq::distance(WP3_CSS_bact.prevalenceT3, "bray")
set.seed(12387)
pw_ad_bactT3 <- pairwise.adonis(d.bacteria, factors = df$Diet, p.adjust.m = "BH", perm = 999)

pw_ad_bactT3$R2

# PCoA using the Schloss avgdist method
WP3_bact_ord <- ordinate(phylo_schloss, "PCoA",distance = raref_BC)
p.WP3_bact_ord <- plot_ordination(physeq = phylo_schloss, WP3_bact_ord, axes = c(1,2))
p.WP3_bact_ord <- p.WP3_bact_ord + geom_point(size = 5, stroke = 0.8, aes(fill = Diet, shape = Time))
p.WP3_bact_ord <- p.WP3_bact_ord +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  scale_shape_manual(values = c(21,22,23,24))+
  xlab("PCoA1 (21.2%)") +
  ylab("PCoA2 (8.6%)") +
  labs(fill = "Diet", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23))) -> p.WP3_bact_ord_1

# plot on distance from sacrifice
p.WP3_bact_ord <- plot_ordination(physeq = WP3_CSS_bact.prevalence, WP3_bact_ord, axes = c(1,2))
p.WP3_bact_ord <- p.WP3_bact_ord + geom_point(size = 5, stroke = 0.8, aes(fill = Sacrif_dfference, shape = Time))
p.WP3_bact_ord <- p.WP3_bact_ord +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_viridis_c(option = "C") +
  scale_shape_manual(values = c(21,22,23,24))+
  xlab("PCoA1 (17.3%)") +
  ylab("PCoA2 (11.5%)") +
  labs(fill = "Days from \nfirst sacrif.", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23))) -> p.WP3_bact_ord_2

p.WP3_bact_ord_1 / p.WP3_bact_ord_2 -> p_suppl_ordi

ggsave('./Supplementary figure 2.png', p_suppl_ordi)

# Which component capture best experimental factors?

plot_scree(WP3_bact_ord, title = NULL)

# extract coordinates on the first 20 axis, mount a df with exp factors
df <- as(sample_data(WP3_CSS_bact.prevalence), "data.frame")
ordi.coordinates <- as.data.frame(WP3_bact_ord$vectors[,1:10])
row.names(df) == row.names(ordi.coordinates) # row name is in same order
ordi.coordinates <- cbind(ordi.coordinates, df[,c(3,4,9:14)]) # attach some variables

# BEST AXIS FOR TIME
ordi.coordinates %>%
  wilcox_effsize(Axis.1 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.2 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.3 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.4 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.5 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.6 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.7 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.8 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.9 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.10 ~ Time)

ordi.coordinates %>%
  wilcox_test(Axis.1 ~ Time)
ordi.coordinates %>%
  wilcox_test(Axis.2 ~ Time)

# BEST AXIS FOR Diet
ordi.coordinates %>%
  wilcox_effsize(Axis.1 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.2 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.3 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.4 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.5 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.6 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.7 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.8 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.9 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.10 ~ Diet)

## Other numeric variables with correlation

ordi.coordinates %>%
  select(-c(Diet, start_body_weight, Time)) %>%
  corr.test(scale(.),method = "spearman", adjust = "none") ->  cor_test_mat  # Apply corr.test function

corrplot(as.matrix(cor_test_mat$r),  order="original", method = "number",tl.cex = 0.8,number.cex = 1, type = "lower",
         p.mat = as.matrix(cor_test_mat$p), sig.level = 0.05)

# Maybe it has more sense to see beta diversity at T3, where the diet should have had an effect

WP3_CSS_bact.prevalence.T3 <- subset_samples(WP3_CSS_bact.prevalence, Time == "T3") %>% prune_taxa(taxa_sums(.) > 0, .)

# PCOA
WP3_bact_ord <- ordinate(WP3_CSS_bact.prevalence.T3, "PCoA", distance = "bray")
p.WP3_bact_ord <- plot_ordination(physeq = WP3_CSS_bact.prevalence.T3, WP3_bact_ord, axes = c(1,2))
p.WP3_bact_ord <- p.WP3_bact_ord + geom_point(size = 5, stroke = 0.8, shape = 21, aes(fill = Diet))
p.WP3_bact_ord <- p.WP3_bact_ord +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  xlab("PCoA1 (17.4%)") +
  ylab("PCoA2 (11.6%)") +
  labs(fill = "Diet", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23)))  -> p.WP3_bact_ord.T3

p.WP3_bact_ord

## With Schloss
# starting data is the untransformed DF, will still remove the lower outlier and remove low prevalence OTUs
phylo_schloss <- subset_samples(subset_samples(WP3_initial_bact_prevalence, Time == "T3"), AnimalID != "E149-40")
otu_table_schloss <- otu_table(phylo_schloss)@.Data

otu_table_schloss %>%
  t() %>%
  as.data.frame() -> otu_table_schloss

# adding some metadata
row.names(otu_table_schloss) == row.names(sample_data(phylo_schloss))
otu_table_schloss <- cbind(sample_data(phylo_schloss)[,3:4], otu_table_schloss)

# calculate depth
nSeqs <- min(sample_sums(phylo_schloss))

# calculate rarefaction of BC distance and plot MDS
set.seed(43655826)
raref_BC <- avgdist(x = otu_table_schloss[,-c(1,2)], sample = nSeqs, dmethod = "bray", iterations = 100)

# PCoA using the Schloss avgdist method
WP3_bact_ord <- ordinate(phylo_schloss, "PCoA",distance = raref_BC)
  p.WP3_bact_ord <- plot_ordination(physeq = phylo_schloss, WP3_bact_ord, axes = c(1,2))
p.WP3_bact_ord <- p.WP3_bact_ord + geom_point(size = 5, stroke = 0.8, aes(fill = Diet, shape = Time))
p.WP3_bact_ord <- p.WP3_bact_ord +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  scale_shape_manual(values = c(21,22,23,24))+
  xlab("PCoA1 (24.1%)") +
  ylab("PCoA2 (12.3%)") +
  labs(fill = "Diet", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23))) -> p.WP3_bact_ord_1

# see if biological interpretation is the same or not
bray_WP3_CSS.prevalence.T3 <- phyloseq::distance(WP3_CSS_bact.prevalence.T3, "bray")
df <- as(sample_data(WP3_CSS_bact.prevalence.T3), "data.frame")
set.seed(12387)
adonis2(bray_WP3_CSS.prevalence.T3 ~ Diet + Sacrif_dfference + end_body_weight, data = df, permutations = 999)

# plot on distance from sacrifice
p.WP3_bact_ord <- plot_ordination(physeq = WP3_CSS_bact.prevalence.T3, WP3_bact_ord, axes = c(1,2))
p.WP3_bact_ord <- p.WP3_bact_ord + geom_point(size = 5, stroke = 0.8,shape = 21, aes(fill = Sacrif_dfference))
p.WP3_bact_ord <- p.WP3_bact_ord +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_viridis_c(option = "C") +
  xlab("PCoA1 (17.3%)") +
  ylab("PCoA2 (11.5%)") +
  labs(fill = "Days from \nfirst sacrif.", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23))) -> p.WP3_bact_ord.T3

# Which component capture best experimental factors?

plot_scree(WP3_bact_ord, title = NULL)

# extract coordinates on the first 20 axis, mount a df with exp factors
df <- as(sample_data(WP3_CSS_bact.prevalence.T3), "data.frame")
ordi.coordinates <- as.data.frame(WP3_bact_ord$vectors[,1:10])
row.names(df) == row.names(ordi.coordinates) # row name is in same order
ordi.coordinates <- cbind(ordi.coordinates, df[,c(4,9:14)]) # attach some variables

# for sacrifice difference and other numeric var, I could do a scatterplot matrix

ordi.coordinates %>%
  select(-c(Diet, start_body_weight)) %>%
  corr.test(scale(.),method = "spearman", adjust = "none") ->  cor_test_mat  # Apply corr.test function

corrplot(as.matrix(cor_test_mat$r),  order="original", method = "number",tl.cex = 0.8,number.cex = 1,
         p.mat = as.matrix(cor_test_mat$p), sig.level = 0.05)

# sacrifice difference strongly correlate with axis.2

# BEST AXIS FOR Diet

ordi.coordinates %>%
  wilcox_test(Axis.1 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.2 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.3 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.4 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.5 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.6 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.7 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.8 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.9 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.10 ~ Diet)

# axis 1:5 have a significant anova respect to diet, should calculate which has the higher effect size

ordi.coordinates %>%
  wilcox_effsize(Axis.1 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.2 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.3 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.4 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.5 ~ Diet)

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

#' **WP4 BACTERIA**

###########

#' ```{r betadiv bact WP4, include=TRUE, echo = FALSE}

# Optimization of transformation and of methods was performed only for WP3, here take the same

# calculate the variation in read obtained per sample
sdt = data.table(as(sample_data(WP4_initial_bact), "data.frame"),
                 TotalReads = sample_sums(WP4_initial_bact), keep.rownames = TRUE)
summary(sdt$TotalReads)
max(sdt$TotalReads)/min(sdt$TotalReads)

# plot reads to find outliers

sdt %>%
  filter(AnimalID != "WP4-928") %>%
  ggboxplot(.,y = "TotalReads")

sdt %>%
  filter(AnimalID != "WP4-928") %>%
  summary()

# generate a 10% prevalece filter dataset (see https://www.nature.com/articles/s41467-022-28034-z)

# calculate prevalence for each ASV
WP4.bact.ASVprev <- prevalence(subset_samples(WP4_initial_bact, AnimalID != "WP4-928"), detection=0, sort=TRUE, count=F)
summary(names(WP4.bact.ASVprev[WP4.bact.ASVprev > 0.1]))
summary(names(WP4.bact.ASVprev[WP4.bact.ASVprev < 0.1]))
# create an object with only the ASV in more than 10% of samples
WP4_initial_bact_prevalence <- prune_taxa(names(WP4.bact.ASVprev[WP4.bact.ASVprev > 0.1]), subset_samples(WP4_initial_bact, AnimalID != "WP4-928"))
#check
min(prevalence(WP4_initial_bact_prevalence, detection=0, sort=TRUE, count=F))

# CSS scaling (not removing singletons) on the prevalence dataset
data.metagenomeSeq = phyloseq_to_metagenomeSeq(subset_samples(WP4_initial_bact_prevalence, AnimalID != "WP4-928"))
p = cumNormStat(data.metagenomeSeq) #default is 0.5
data.cumnorm = cumNorm(data.metagenomeSeq, p=p)
#data.cumnorm
data.CSS = MRcounts(data.cumnorm, norm=TRUE, log=TRUE)
WP4_CSS_bact.prevalence <- subset_samples(WP4_initial_bact_prevalence, AnimalID != "WP4-928")
otu_table(WP4_CSS_bact.prevalence) <- otu_table(data.CSS, taxa_are_rows = T)

# Perform ordination now
# PCOA

WP4_bact_ord <- ordinate(WP4_CSS_bact.prevalence, "PCoA", distance = "bray")
p.WP4_bact_ord <- plot_ordination(physeq = WP4_CSS_bact.prevalence, WP4_bact_ord, axes = c(1,2))
p.WP4_bact_ord <- p.WP4_bact_ord + geom_point(size = 3, stroke = 0.8, aes(fill = Inoculum_diet, shape = Time))
p.WP4_bact_ord <- p.WP4_bact_ord +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  scale_shape_manual(values = c(24,21,22,23))+
  xlab("PCoA1 (24%)") +
  ylab("PCoA2 (14.5%)") +
  labs(fill = "Diet", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23))) -> p.WP4_bact_ord_1

## Plot with WP3
figure2 <- p.WP3_bact_ord_final / p.WP4_bact_ord + plot_layout(guides = "collect") & theme(legend.position = 'left')

#ggsave('./Figure 2.png', figure2)

# pairwise adonis
df <- as(sample_data(subset_samples(WP4_CSS_bact.prevalence, Time == "T3" & Type != "Inoculum")), "data.frame")
d.bacteria = phyloseq::distance(subset_samples(WP4_CSS_bact.prevalence, Time == "T3"  & Type != "Inoculum"), "bray")
set.seed(12387)
pw_ad_bactWP4 <- pairwise.adonis(d.bacteria, factors = df$Diets, p.adjust.m = "BH", perm = 999)

mat1 <- data.frame(matrix(nrow=4,ncol=4,byrow=TRUE))

mat1[1,1] <- 0
mat1[1,2] <- pw_ad_bactT3$R2[1]
mat1[1,3] <-pw_ad_bactT3$R2[2]
mat1[1,4] <-pw_ad_bactT3$R2[4]
mat1[2,1] <- pw_ad_bactT3$R2[1]
mat1[2,2] <- 0
mat1[2,3] <-pw_ad_bactT3$R2[4]
mat1[2,4] <-pw_ad_bactT3$R2[5]
mat1[3,1] <-pw_ad_bactT3$R2[2]
mat1[3,2] <- pw_ad_bactT3$R2[4]
mat1[3,3] <- 0
mat1[3,4] <-pw_ad_bactT3$R2[6]
mat1[4,1] <- pw_ad_bactT3$R2[3]
mat1[4,2] <- pw_ad_bactT3$R2[5]
mat1[4,3] <-pw_ad_bactT3$R2[6]
mat1[4,4] <- 0

colnames(mat1) <- c("MBDT", "PVD", "MBD", "CTR")
row.names(mat1) <- c("MBDT", "PVD", "MBD", "CTR")

corrplot(as.matrix(mat1), type = "lower", diag = F, method = 'number', col = "black")

###########

#' **WP3 WP4 BACTERIA**

###########

# here analysis of WP3 at T3 and WP4 all timepoint, to highlight the "passage" in the FTM
# optionally, one could select only the ID that actually were used for the pool

WP3WP4_initial_bact <- subset_samples(phyloseq_obj_initial_bact,
                                      AnimalID != "E149-40" &  AnimalID != "WP4-928") %>% prune_taxa(taxa_sums(.) > 0, .)

# select sample subset of interest (i.e. only T3 of WP3)

WP3WP4_initial_bact <- subset_samples(WP3WP4_initial_bact, WP != "WP3" | Time != "T0")

# obtain rarefied object for alpha diversity

WP3WP4_raref_bact<- rarefy_even_depth(WP3WP4_initial_bact,
                                   rngseed=1234,
                                   sample.size=round(0.99*min(sample_sums(WP3WP4_initial_bact))),
                                   replace=F)

# calculate the variation in read obtained per sample
sdt = data.table(as(sample_data(WP3WP4_initial_bact), "data.frame"),
                 TotalReads = sample_sums(WP3WP4_initial_bact), keep.rownames = TRUE)
summary(sdt$TotalReads)
max(sdt$TotalReads)/min(sdt$TotalReads)

# plot reads to find outliers

sdt %>%
  ggboxplot(.,y = "TotalReads")

sdt %>%
  summary()

# generate a 10% prevalece filter dataset (see https://www.nature.com/articles/s41467-022-28034-z)

# calculate prevalence for each ASV
WP34.bact.ASVprev <- prevalence(WP3WP4_initial_bact, detection=0, sort=TRUE, count=F)
summary(names(WP34.bact.ASVprev[WP34.bact.ASVprev > 0.1]))
summary(names(WP34.bact.ASVprev[WP34.bact.ASVprev < 0.1]))
# create an object with only the ASV in more than 10% of samples
WP34_initial_bact_prevalence <- prune_taxa(names(WP34.bact.ASVprev[WP34.bact.ASVprev > 0.1]), WP3WP4_initial_bact)
#check
min(prevalence(WP34_initial_bact_prevalence, detection=0, sort=TRUE, count=F))

# CSS scaling (not removing singletons) on the prevalence dataset
data.metagenomeSeq = phyloseq_to_metagenomeSeq(WP34_initial_bact_prevalence)
p = cumNormStat(data.metagenomeSeq) #default is 0.5
data.cumnorm = cumNorm(data.metagenomeSeq, p=p)
#data.cumnorm
data.CSS = MRcounts(data.cumnorm, norm=TRUE, log=TRUE)
WP34_CSS_bact.prevalence <- WP34_initial_bact_prevalence
otu_table(WP34_CSS_bact.prevalence) <- otu_table(data.CSS, taxa_are_rows = T)

sample_data(WP34_CSS_bact.prevalence)$Time

WP34_bact_ord <- ordinate(WP34_CSS_bact.prevalence, "PCoA", distance = "bray")
p.WP34_bact_ord <- plot_ordination(physeq = WP34_CSS_bact.prevalence, WP34_bact_ord, axes = c(1,2))
p.WP34_bact_ord <- p.WP34_bact_ord +
  geom_point(size = 3, stroke = 0.8, aes(fill = Diets, shape = Time))+
  #geom_line(aes(group = AnimalID)) +
  geom_vline(xintercept= 0, linetype="dotted") +
  geom_hline(yintercept= 0, linetype="dotted") +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  scale_shape_manual(values = c(24,21,22,25))+
  xlab("PCoA1 (24.1%)") +
  ylab("PCoA2 (11.9%)") +
  labs(fill = "Diet", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23))) +
  theme(legend.position="none")

p.WP34_bact_ord

# Calculate alpha-div
# richness
alphadiv_WP34_bact <- microbiome::richness(WP3WP4_raref_bact)
df <- as(sample_data(WP3WP4_raref_bact), "data.frame")
df <- cbind(df, alphadiv_WP34_bact)

row.names(alphadiv_WP34_bact$vectors) == row.names(df)

df <- cbind(df, WP34_bact_ord$vectors[,1:2])

ggscatter(data = df, x = "Axis.1", y = "observed", add = "reg.line", add.params = list(linetype = "dotted")) +
  stat_cor(method = "pearson") +
  xlab("PCoA1") +
  ylab("Richness (n° of observed ASVs)")

ggscatter(data = df, x = "Axis.2", y = "observed", add = "reg.line", add.params = list(linetype = "dotted")) +
  stat_cor(method = "pearson") +
  xlab("PCoA2") +
  ylab("Richness (n° of observed ASVs)")

ggboxplot(data = df, x = "WP", y = "observed", add = "jitter",
          fill = "WP", palette ="grey", rotate = F, dot.size = 4) + theme_bw() +
  stat_compare_means(label.y = 100) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  xlab("") +
  ylab("Richness (n° of observed ASVs)") +
  coord_flip() +
  theme(legend.position="none") -> sottoplot_b_ord

# evenness
alphadiv_WP34_bact <- microbiome::evenness(WP3WP4_raref_bact)
df <- as(sample_data(WP3WP4_raref_bact), "data.frame")
df <- cbind(df, alphadiv_WP34_bact)

row.names(alphadiv_WP34_bact$vectors) == row.names(df)

df <- cbind(df, WP34_bact_ord$vectors[,1:2])

ggscatter(data = df, x = "Axis.1", y = "pielou", add = "reg.line", add.params = list(linetype = "dotted")) +
  stat_cor(method = "pearson") +
  xlab("PCoA1") +
  ylab("Richness (n° of observed ASVs)")

ggscatter(data = df, x = "Axis.2", y = "pielou", add = "reg.line", add.params = list(linetype = "dotted")) +
  stat_cor(method = "pearson") +
  xlab("PCoA2") +
  ylab("Richness (n° of observed ASVs)")

ggboxplot(data = df, x = "WP", y = "pielou", add = "jitter",
          fill = "WP", palette ="grey", rotate = F, dot.size = 4) + theme_bw() +
  stat_compare_means(label.y = .3, label.x = 2) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  xlab("") +
  ylab("Pielou's Evenness") +
  coord_flip() +
  theme(legend.position="none") -> sottoplot_b_ord_eve

## Plot with other single

figure2 <- p.WP34_bact_ord + p.WP3_bact_ord_final/p.WP4_bact_ord + plot_layout(guides = "collect") & theme(legend.position = 'bottom')

#ggsave('./Figure 2.png', figure2)

layout <- "
A
A
A
B
C
"

p.WP34_bact_ord / sottoplot_b_ord / sottoplot_b_ord_eve+
  plot_layout(design = layout) -> panel_ord_bact

#####

#' *FUNGI*

#' **WP3 FUNGI**

#' ```{r betadiv fungi WP3, include=TRUE, echo = FALSE}

#' **WP4 FUNGI**

#' ```{r betadiv fungi WP4, include=TRUE, echo = FALSE}

# how to transform data for alpha diversity analysis?

#########################
#' **WP3 WP4 FUNGI**
######################

# here analysis of WP3 at T3 and WP4 all timepoint, to highlight the "passage" in the FTM
# optionally, one could select only the ID that actually were used for the pool

WP3WP4_initial_fung <- subset_samples(phyloseq_obj_initial_fungi,
                                      AnimalID != "E149-40" &  AnimalID != "WP4-928") %>% prune_taxa(taxa_sums(.) > 0, .)

# select sample subset of interest (i.e. only T3 of WP3)

WP3WP4_initial_fung <- subset_samples(WP3WP4_initial_fung, WP != "WP3" | Time != "T0")

# obtain rarefied object for alpha diversity

WP3WP4_raref_fung<- rarefy_even_depth(WP3WP4_initial_fung,
                                      rngseed=1234,
                                      sample.size=round(0.99*min(sample_sums(WP3WP4_initial_fung))),
                                      replace=F)

# calculate the variation in read obtained per sample
sdt = data.table(as(sample_data(WP3WP4_initial_fung), "data.frame"),
                 TotalReads = sample_sums(WP3WP4_initial_fung), keep.rownames = TRUE)
summary(sdt$TotalReads)
max(sdt$TotalReads)/min(sdt$TotalReads)

# plot reads to find outliers

sdt %>%
  ggboxplot(.,y = "TotalReads")

sdt %>%
  summary()

# generate a 10% prevalece filter dataset (see https://www.nature.com/articles/s41467-022-28034-z)

# calculate prevalence for each ASV
WP34.fung.ASVprev <- prevalence(WP3WP4_initial_fung, detection=0, sort=TRUE, count=F)
summary(names(WP34.fung.ASVprev[WP34.fung.ASVprev > 0.01]))
summary(names(WP34.fung.ASVprev[WP34.fung.ASVprev < 0.01]))
# create an object with only the ASV in more than 10% of samples
WP34_initial_fung_prevalence <- prune_taxa(names(WP34.fung.ASVprev[WP34.fung.ASVprev > 0.1]), WP3WP4_initial_fung)
#check
min(prevalence(WP34_initial_fung_prevalence, detection=0, sort=TRUE, count=F))

# CSS scaling (not removing singletons) on the prevalence dataset
data.metagenomeSeq = phyloseq_to_metagenomeSeq(WP34_initial_fung_prevalence)
p = cumNormStat(data.metagenomeSeq) #default is 0.5
data.cumnorm = cumNorm(data.metagenomeSeq, p=p)
#data.cumnorm
data.CSS = MRcounts(data.cumnorm, norm=TRUE, log=TRUE)
WP34_CSS_fung.prevalence <- WP34_initial_fung_prevalence
otu_table(WP34_CSS_fung.prevalence) <- otu_table(data.CSS, taxa_are_rows = T)

sample_data(WP34_CSS_fung.prevalence)$Time

# Ordination and plot

WP34_fung_ord <- ordinate(WP34_CSS_fung.prevalence, "PCoA", distance = "bray")
p.WP34_fung_ord <- plot_ordination(physeq = WP34_CSS_fung.prevalence, WP34_fung_ord, axes = c(1,2))
p.WP34_fung_ord <- p.WP34_fung_ord +
  geom_point(size = 3, stroke = 0.8, aes(fill = Diets, shape = Time))+
  #geom_line(aes(group = AnimalID)) +
  geom_vline(xintercept= 0, linetype="dotted") +
  geom_hline(yintercept= 0, linetype="dotted") +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  scale_shape_manual(values = c(24,21,22,25))+
  xlab("PCoA1 (40.9%)") +
  ylab("PCoA2 (5.4%)") +
  labs(fill = "Diet", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23))) +
  theme(legend.position="none")

p.WP34_fung_ord

# Calculate alpha-div
alphadiv_WP34_fung <- microbiome::richness(WP3WP4_raref_fung)
df <- as(sample_data(WP3WP4_raref_fung), "data.frame")
df <- cbind(df, alphadiv_WP34_fung)

row.names(WP34_fung_ord$vectors) == row.names(df)

df <- cbind(df, WP34_fung_ord$vectors[,1:2])

ggscatter(data = df, x = "Axis.1", y = "observed", add = "reg.line", add.params = list(linetype = "dotted")) +
  stat_cor(method = "pearson") +
  xlab("PCoA1") +
  ylab("Richness (n° of observed ASVs)")

ggscatter(data = df, x = "Axis.2", y = "observed", add = "reg.line", add.params = list(linetype = "dotted")) +
  stat_cor(method = "pearson") +
  xlab("PCoA2") +
  ylab("Richness (n° of observed ASVs)")

ggboxplot(data = df, x = "WP", y = "observed", add = "jitter",
          fill = "WP", palette ="grey", rotate = F, dot.size = 4) + theme_bw() +
  stat_compare_means(label.y = 90) +
  #ggtitle(label = "Fungi", subtitle =  "Richness (n° of ASVs)") +
  xlab("") +
  ylab("Richness (n° of observed ASVs)") +
  coord_flip() +
  theme(legend.position="none") -> sottoplot_f_ord

# evenness
alphadiv_WP34_fung <- microbiome::evenness(WP3WP4_raref_fung)
df <- as(sample_data(WP3WP4_raref_fung), "data.frame")
df <- cbind(df, alphadiv_WP34_fung)

row.names(alphadiv_WP34_fung$vectors) == row.names(df)

df <- cbind(df, WP34_fung_ord$vectors[,1:2])

ggscatter(data = df, x = "Axis.1", y = "pielou", add = "reg.line", add.params = list(linetype = "dotted")) +
  stat_cor(method = "pearson") +
  xlab("PCoA1") +
  ylab("Pielou's Evenness")

ggscatter(data = df, x = "Axis.2", y = "pielou", add = "reg.line", add.params = list(linetype = "dotted")) +
  stat_cor(method = "pearson") +
  xlab("PCoA2") +
  ylab("Pielou's Evenness")

ggboxplot(data = df, x = "WP", y = "pielou", add = "jitter",
          fill = "WP", palette ="grey", rotate = F, dot.size = 4) + theme_bw() +
  stat_compare_means(label.y = .2, label.x = 2) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  xlab("") +
  ylab("Pielou's Evenness") +
  coord_flip() +
  theme(legend.position="none") -> sottoplot_f_ord_eve

layout <- "
A
A
A
B
C
"

p.WP34_fung_ord / sottoplot_f_ord / sottoplot_f_ord_eve+
  plot_layout(design = layout) -> panel_ord_fung

ggarrange(panel_ord_bact, panel_ord_fung,
          labels = c("A", "B"),
          ncol = 2) -> figure2

ggsave('./Figure 2.png', figure2)

#' ```

#' ```{r write images, include=FALSE}
#' knitr::opts_chunk$set(echo = TRUE)

# use ggsave for images

#' ```


get_means<-function(b_data){
  assert_that(is.data.frame(b_data))

  means<-numeric(length(b_data[1,]))
  for(i in 1:length(means)){
    means[i]<-mean(b_data[,i])
  }
  means
}

get_sv_success_rate<-function(b_data){
  assert_that(is.data.frame(b_data))

  succ<-numeric(length(names(b_data))-2)
  for(i in 1:length(b_data[,1])){

    methods_results<-sort(b_data[i,3:length(names(b_data))])

    for(j in 1:length(succ)){
      if(b_data[[i,2]]==methods_results[j]){
        succ[j] <- succ[j]+1
        break
      }
    }
  }
  cum_succ <- cumsum(succ)
  succ_rate<-round(cum_succ/length(b_data[,1])*100,digits = 2)

  df<-data.frame("N-te beste Sch\344tzung" = 1:length(succ),
                 "# ausgew\344hlt"=succ,
                 "# ausgew\344hlt (kumuliert)"=cum_succ,
                 "Kumulierte Erfolgsrate"=paste(succ_rate,"%",sep = ""),
                 check.names = FALSE)

  return (df)
}

get_counts<-function(b_data){
  assert_that(is.data.frame(b_data))

  counts<-matrix(data = 0,nrow = 2,ncol = length(b_data[1,])-2)
  for(i in 1:length(b_data$oracle)){
    for (j in 3:length(b_data[1,])) {
      if(b_data$oracle[i]==b_data[i,j]){
        counts[1,j-2] <- counts[1,j-2]+1
      }
      if(b_data$synth_validation[i]==b_data[i,j]){
        counts[2,j-2] <- counts[2,j-2]+1
      }
    }
  }
  counts[1,] <- counts[1,]/sum(counts[1,])
  counts[2,] <- counts[2,]/sum(counts[2,])
  return (counts)
}


a<-Read.size.preference()
a<-subset(a,size.model==11,select=c( Species ,size.ratio, size.var))
a$size.ratio<-round(a$size.ratio,2)
a$size.var<-round(a$size.var,2)
names(a)<-c('Species','mean','variance')
a


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

rm(list=ls())
# ==============================================
library(ggplot2)
library(scales)
# ==============================================

# ==============================================
read_sat_report <- function(file_path) {
  # ==============================================
  report <- read.table(file=file_path,
                       header = FALSE,
                       sep = ",",
                       blank.lines.skip = TRUE,
                       fill = TRUE)

  names(report) <- as.matrix(report[1, ])
  report <- report[-1, ]
  report[] <- lapply(report, function(x) type.convert(as.character(x)))
  report
}
# ==============================================

geom_ptsize = 1
geom_stroke = 1
geom_shape = 19

make_plot_diagram <- function(report_file_str,plot_title_str) {
  report_data <- read_sat_report(report_file_str)

  g <- ggplot(report_data, aes(x=varisat_time, y=hibou_time, color=varisat_res)) +
    geom_point(size = geom_ptsize, stroke = geom_stroke, shape = geom_shape) +
    labs(colour = "isSAT", x = "varisat time", y = "hibou time") +
    ggtitle(plot_title_str) +
    theme(plot.title = element_text(margin = margin(b = -25)),
          axis.title.x = element_text(margin = margin(t = 5)),
          axis.title.y = element_text(margin = margin(r = 5)))
  g
  (g + scale_color_manual(values=c("False" = "red", "True" = "blue")))
}

make_plot_diagram("./satbenchmark_hibou/sat_membership_experiment_mahe.csv",
                  "Custom")

make_plot_diagram("./satbenchmark_hibou/sat_membership_experiment_uf20.csv",
                  "UF20")

uf20 <- read_sat_report("./satbenchmark_hibou/sat_membership_experiment_uf20.csv")

summary(uf20$varisat_time)
summary(uf20$hibou_time)
sd(uf20$varisat_time)
sd(uf20$hibou_time)


centroestim <- function (data, cl, resTest, nb_markers_selection, nb_markers_max_perClass, markers_cutoff_auc, add_markers = NULL,
markers_cutoff_pval_anovatest = 0.05, markers_pval_anovatest_fdr = TRUE)
{
    cl = as.factor(as.character(cl))
    nbclasses = length(levels(cl))
    if (nb_markers_selection == "custom") {
        marksList = lapply(levels(cl), function(aclass) {
            FC = resTest[resTest[, paste("AUC", aclass, sep = ".")] >=
            markers_cutoff_auc, ]
            rownames(FC)[order(FC[, paste("logFC", aclass, sep = ".")],
            decreasing = T)][1:min(nrow(FC), nb_markers_max_perClass)]
        })
        names(marksList) = levels(cl)
        if (!is.null(add_markers)) {
            marksList$add = add_markers
        }
    }

    if (nb_markers_selection == "optim_kappa") {
        bornMIN <- bornMinCN(data, cl, markers_cutoff_pval_anovatest, markers_pval_anovatest_fdr)
        allmarksList = lapply(bornMIN:200, function(x) {
            marksList = lapply(levels(cl), function(aclass) {
                resTest <- resTest[order(resTest[, paste("AUC",
                aclass, sep = ".")], resTest[, paste("logFC",
                aclass, sep = ".")], decreasing = T), ]
                rownames(resTest)[1:x]
            })
            names(marksList) = levels(cl)
            return(marksList)
        })
        allmarks = lapply(allmarksList, function(x) {xtemp = as.character(unique(unlist(x))); xtemp[!is.na(xtemp)]})
        allcondnumber <- lapply(allmarks, function(marks) {
            centroid = data.frame(t(apply(data[marks, ], 1, function(x) tapply(x,
            cl, mean))))
            kappa(centroid)
        })
        sumcn <- data.frame(geneNumber=unlist(lapply(allmarks, length)), conditionNumber=unlist(allcondnumber))
        write.table(sumcn, file="table_with_allConditionNumber.txt", sep="\t", row.names=FALSE)
        bestmarks <- allmarks[[which.min(allcondnumber)]]
        if (is.null(add_markers)) {
            centroid = data.frame(t(apply(data[bestmarks, ],
            1, function(x) tapply(x, cl, mean))))
            marksList = allmarksList[[which.min(allcondnumber)]]
        }
        else {
            add_markers_present = intersect(rownames(data), add_markers)
            if (length(intersect(rownames(data), add_markers)) ==
            0) {
                centroid = data.frame(t(apply(data[bestmarks,
                ], 1, function(x) tapply(x, cl, mean))))
                marksList = allmarksList[[which.min(allcondnumber)]]
            }
            else {
                centroid = data.frame(t(apply(data[unique(c(bestmarks,
                add_markers_present)), ], 1, function(x) tapply(x,
                cl, mean))))
                marksList = allmarksList[[which.min(allcondnumber)]]
                marksList$add = add_markers_present
            }
        }
    }
    if (sum(is.na(marksList))>0) {
        popweak = names(marksList)[which(is.na(marksList))]
        #warning(paste("Population", popweak, "has no specific markers and has been removed.", sep=" "))
        names(cl) = colnames(data)
        cl = cl[-which(cl %in% popweak)]
        data = data[,names(cl)]
        cl = as.factor(as.character(cl))
        marksList = marksList[levels(cl)]
    }
    centroid = data.frame(t(apply(data[unique(unlist(marksList)),
    ], 1, function(x) tapply(x, cl, mean))))
    return(list(centroid = centroid, marksList = marksList, cl = cl, data=data))
}


shinyServer(
  server <- function(input, output) {
    output$tocke <- renderPlot({
      ggplot(podatki %>% filter(Draws >= input$izenaceni), aes(x = Team, y = Points)) +
        scale_fill_continuous(low = "#69b8f6", high = "#142d45") +
        geom_bar(stat ="identity") +
        theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
        ggtitle("Katere ekipe imajo več izenačenih izidov")})

    names(podatki)[11] <- "Win_Lose"

    output$goli <- renderPlot({
      ggplot(podatki %>% filter(Win_Lose >= input$zmage), aes(x = Team, y = Goals_per_match), color="Blue") +
        scale_fill_continuous(low = "#69b8f6", high = "#142d45") +
        geom_bar(stat ="identity") +
        theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
        ggtitle("Goli na tekmo")})
  }
)


library(yaml)
library(ncdf4)
library(SPEI)
library(RColorBrewer) # nolint

getnc <- function(yml, m, lat = FALSE) {
  id <- nc_open(yml[m][[1]]$filename, readunlim = FALSE)
  if (lat){
    v <- ncvar_get(id, "lat")
  }else{
    v <- ncvar_get(id, yml[m][[1]]$short_name)
  }
  nc_close(id)
  return(v)
}

ncwritenew <- function(yml, m, hist, wdir, bins){
  fnam <- strsplit(yml[m][[1]]$filename, "/")[[1]]
  pcs <- strsplit(fnam[length(fnam)], "_")[[1]]
  pcs[which(pcs == yml[m][[1]]$short_name)] <- "spi"
  onam <- paste(pcs, collapse = "_")
  onam <- paste0(wdir, "/", strsplit(onam, ".nc"), "_hist.nc")
  ncid_in <- nc_open(yml[m][[1]]$filename)
  var <- ncid_in$var[[yml[m][[1]]$short_name]]
  xdim <- ncid_in$dim[["lon"]]
  ydim <- ncid_in$dim[["lat"]]
  hdim <- ncdim_def("bins", "level", bins[1:(length(bins) - 1)])
  hdim2 <- ncdim_def("binsup", "level", bins[2:length(bins)])
  var_hist <- ncvar_def("hist", "counts", list(xdim, ydim, hdim), NA)
  idw <- nc_create(onam, var_hist)
  ncvar_put(idw, "hist", hist)
  nc_close(idw)
  return(onam)
}

whfcn <- function(x, ilow, ihigh){
  return(length(which(x >= ilow & x < ihigh)))
}

args <- commandArgs(trailingOnly = TRUE)
params <- read_yaml(args[1])
metadata <- read_yaml(params$input_files)
modfile <- names(metadata)
wdir <- params$work_dir
rundir <- params$run_dir
dir.create(wdir, recursive = TRUE)
pdir <- params$plot_dir
dir.create(pdir, recursive = TRUE)
var1_input <- read_yaml(params$input_files[1])
nmods <- length(names(var1_input))

# setup provenance file and list
provenance_file <- paste0(rundir, "/", "diagnostic_provenance.yml")
provenance <- list()

histbrks <- c(-99999, -2, -1.5, -1, 1, 1.5, 2, 99999)
histnams <- c("Extremely dry", "Moderately dry", "Dry",
              "Neutral",
              "Wet", "Moderately wet", "Extremely wet")
refnam <- var1_input[1][[1]]$reference_dataset
n <- 1
while (n <= nmods){
  if (var1_input[n][[1]]$dataset == refnam) break
  n <- n + 1
}
nref <- n
lat <- getnc(var1_input, nref, lat = TRUE)
if (max(lat) > 90){
  print(paste0("Latitude must be [-90,90]: min=",
  min(lat), " max=", max(lat)))
  stop("Aborting!")
}
ref <- getnc(var1_input, nref, lat = FALSE)
refmsk <- apply(ref, c(1, 2), FUN = mean, na.rm = TRUE)
refmsk[refmsk > 10000] <- NA
refmsk[!is.na(refmsk)] <- 1

xprov <- list(ancestors = list(""),
              authors = list("berg_peter"),
              references = list("mckee93"),
              projects = list("c3s-magic"),
              caption = "",
              statistics = list("other"),
              realms = list("atmos"),
              themes = list("phys"),
              domains = list("global"))

histarr <- array(NA, c(nmods, length(histnams)))
for (mod in 1:nmods){
   v1 <- getnc(var1_input, mod)
   print(var1_input[mod][[1]]$cmor_table)
   d <- dim(v1)
   v1_spi <- v1 * NA
   for (i in 1:d[1]){
     wh <- which(!is.na(refmsk[i,]))
     if (length(wh) > 0){
       tmp <- v1[i,wh,]
       v1_spi[i,wh,] <- t(spi(t(tmp), 1, na.rm = TRUE,
                        distribution = "PearsonIII")$fitted)
     }
   }
   v1_spi[is.infinite(v1_spi)] <- NA
   v1_spi[v1_spi > 10000] <- NA
   hist_spi <- array(NA, c(d[1], d[2], length(histbrks) - 1))
   for (nnh in 1:(length(histbrks) - 1)){
     hist_spi[,,nnh] <- apply(v1_spi, c(1, 2), FUN = whfcn,
                              ilow = histbrks[nnh],
                              ihigh = histbrks[nnh + 1])
   }
   filename <- ncwritenew(var1_input, mod, hist_spi, wdir, histbrks)
   # Set provenance for output files
   xprov$caption <- "Histogram of SPI index per grid point."
   xprov$ancestors <- modfile[mod]
   provenance[[filename]] <- xprov
   # Weight against latitude
   h <- c(1:length(histnams)) * 0
   for (j in 1:d[2]){
     h <- h + hist(v1_spi[j,,], breaks = histbrks,
                   plot = FALSE)$counts * cos(lat[j] * pi / 180.)
   }
   histarr[mod, ] <- h / sum(h, na.rm = TRUE)
}
filehist <- paste0(params$work_dir, "/", "histarr.rsav")
save(histarr, file = filehist)
plot_file <- paste0(params$plot_dir, "/", "histplot.png")
xprov$caption <- "Global latitude-weighted histogram of SPI index."
xprov$ancestors <- list(modfile)
xprov[["plot_file"]] <- plot_file
provenance[[filehist]] <- xprov
write_yaml(provenance, provenance_file)

bhistarr <- array(NA, c(nmods - 1, 7))
marr <- c(1:nmods)[c(1:nmods) != nref]
cnt <- 1
for (m in marr){
  bhistarr[cnt, ] <- histarr[m, ] - histarr[nref, ]
  cnt <- cnt + 1
}
parr <- c(nref, marr)

mnam <- c(1:nmods) * NA
for (m in 1:nmods) mnam[m] <- var1_input[m][[1]]$dataset

qual_col_pals <- brewer.pal.info[brewer.pal.info$category == "qual", ] # nolint
col_vector <- unlist(mapply(brewer.pal, qual_col_pals$maxcolors, # nolint
                           rownames(qual_col_pals)))
cols <- c("black", sample(col_vector, nmods - 1))

png(plot_file, width = 1000, height = 500)
 par(mfrow = c(2, 1), oma = c(3, 3, 3, 13), mar = c(2, 1, 1, 1))
 barplot(histarr[parr, ], beside = 1, names.arg = histnams,
         col = cols, xaxs = "i")
 box()
 mtext("Probability", side = 2, line = 2.1)
 barplot(bhistarr, beside = 1, names.arg = histnams,
         col = cols[2:nmods], xaxs = "i")
 box()
 mtext("Absolute difference", side = 2, line = 2.1)
 mtext("Standardized precipitation index", outer = TRUE,
       cex = 2, font = 2)
 par(fig = c(0.8, .95, 0.1, 0.9), new = T, oma = c(0, 0, 0, 0),
     mar = c(0, 0, 0, 0))
 legend("topright", mnam[parr], fill = cols)
dev.off()


# 1. graf: vrste dohodka

graf_vrste_dohodka <- ggplot(vrste_dohodka, aes(x=factor(Leto), y=Dohodek,group=Vrsta.dohodka, colour=Vrsta.dohodka)) +
  geom_line(aes(colour=Vrsta.dohodka)) +
  geom_point(aes(colour=Vrsta.dohodka)) +
  scale_x_discrete(guide = guide_axis(check.overlap = TRUE)) +
  labs(title="Dohodek glede na vrsto", x="Leto", y = "Dohodek", colour="Vrsta dohodka")
print(graf_vrste_dohodka)

# 2. graf: delež vrste dohodka 2019

vrste_dohodka_19 <- vrste_dohodka %>%
  filter(Leto == 2019) %>%
  select(Vrsta.dohodka, Dohodek) %>%
  mutate(Delez19 = round((Dohodek/sum(Dohodek))*100, 0))

dohodek_19 <- vrste_dohodka_19 %>%
  select(Delez19) %>%
  unlist()

vrste_imena <- sprintf("%s (%s)", vrste_dohodka_19$Vrsta.dohodka,
                       percent(round(vrste_dohodka_19$Dohodek/sum(vrste_dohodka_19$Dohodek), 2)))

names(dohodek_19) <- vrste_imena

graf_delez_vrste <- waffle(dohodek_19, rows = 6, title = "Delež dohodka glede na vrsto 2019")

print(graf_delez_vrste)

# 3. graf: razlika po spolu, (starost = skupaj)

graf_spol <- ggplot(spol, aes(x=factor(Leto), y=Dohodek, group=Spol)) +
  geom_line(aes(color=Spol)) +
  geom_point(aes(color=Spol)) +
  scale_x_discrete(guide = guide_axis(check.overlap = TRUE)) +
  labs(x="Leto", y = "Dohodek", fill="Leto")
print(graf_spol)

# 4. graf: razlika po spolu 2

razlika_spol <- spol %>%
  arrange(desc(Leto)) %>%
  pivot_wider(names_from = Spol, values_from = Dohodek) %>%
  mutate(Razlika = Moški - Ženske)

graf_razlika_spol <- ggplot(razlika_spol, aes(x=factor(Leto), y=Razlika, group=1)) +
  geom_line() +
  geom_point() +
  scale_x_discrete(guide = guide_axis(check.overlap = TRUE)) +
  labs(x="Leto", y = "Razlika dohodka")

print(graf_razlika_spol)

# 5. graf: Razlika med spoloma - skupaj
graf_spol_skupaj <- ggarrange(graf_spol, graf_razlika_spol, labels=c("Dohodek po spolu", "Razlika"),
                              common.legend = TRUE, legend = "bottom")
print(graf_spol_skupaj)

# 6. graf: izobrazba

izobrazba_spol_2 <- izobrazba_spol %>%
  mutate(Izobrazba2=Izobrazba, Spol2=Spol)

graf_izobrazba_spol <- ggplot(izobrazba_spol_2, aes(x=factor(Leto), y=Dohodek)) +
  geom_line(izobrazba_spol_2 %>% select(-Izobrazba, -Spol),
            mapping=aes(group=interaction(Spol2, Izobrazba2)), color="grey", size=0.5) +
  geom_line(aes(group=interaction(Spol, Izobrazba), color=Spol), size=1.2)+
  scale_color_manual(breaks=c("Moški", "Ženske"), values=c("#00BFC4", "#F8766D"))+
  theme_bw() +
  theme(plot.title = element_text(), panel.grid = element_blank()) +
  labs(title="Izobrazba in spol", x="Leto", y = "Dohodek") +
  scale_x_discrete(guide = guide_axis(check.overlap = TRUE)) +
  facet_wrap(~Izobrazba)

print(graf_izobrazba_spol)

#7. graf: starost
starost_spol_2 <- starost_spol %>%
  mutate(Starost2=Starost, Spol2=Spol)

graf_starost_spol <- ggplot(starost_spol_2, aes(x=factor(Leto), y=Dohodek)) +
  geom_line(starost_spol_2 %>% select(-Starost, -Spol),
            mapping=aes(group=interaction(Spol2, Starost2)), color="grey", size=0.5) +
  geom_line(aes(group=interaction(Spol, Starost), color=Spol), size=1.2)+
  scale_color_manual(breaks=c("Moški", "Ženske"), values=c("#00BFC4", "#F8766D"))+
  theme_bw() +
  theme(plot.title = element_text(), panel.grid = element_blank()) +
  labs(title="Starost in spol", x="Leto", y = "Dohodek") +
  scale_x_discrete(guide = guide_axis(check.overlap = TRUE)) +
  facet_wrap(~Starost)

print(graf_starost_spol)

# Zemljevid statističnih regij

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

zemljevid_regije$NAME_1 <- as.factor(iconv(as.character(zemljevid_regije$NAME_1),
                                           "UTF-8"))

#Spodnjeposavska = Posavska
#Notranjsko-kraška = Primorsko-notranjska

levels(zemljevid_regije$NAME_1)[levels(zemljevid_regije$NAME_1)=="Spodnjeposavska"] <- "Posavska"
levels(zemljevid_regije$NAME_1)[levels(zemljevid_regije$NAME_1)=="Notranjsko-kraška"] <- "Primorsko-notranjska"

regije_8_19 <- regije %>%
  select(Regija, Leto, Dohodek) %>%
  filter(Leto %in% c(2008, 2019)) %>%
  pivot_wider(names_from = Leto, values_from = Dohodek) %>%
  mutate(Rast = (((`2019` - `2008`) / `2008`) * 100))

narisi_zemljevid <- tm_shape(merge(zemljevid_regije, regije_8_19, by.x="NAME_1", by.y="Regija")) +
  tm_polygons(c("2008", "2019", "Rast") , style="cont", palette = "YlGn") +
  tm_layout(legend.position = c("right", "bottom"),
            main.title = "Zemljevid razpoložljivega dohodka gospodinjstev") +
  tm_facets(sync = TRUE, ncol = 2)

print(narisi_zemljevid)

narisi_zemljevid_regije <- tm_shape(zemljevid_regije) +
  tm_polygons(col = "white") +
  tm_text("NAME_1", size = "AREA")
print(narisi_zemljevid_regije)

#zemljevid_skupaj <- tmap_arrange(narisi_zemljevid)
#
#print(zemljevid_skupaj)


#----------------------------#
# LA variation analysis data #
#----------------------------#

library(dplyr)
library(purrr)

analysis_dat <- readRDS("N:/Documents/Data & Programming/RDS files/la_analysis_dat.rds") %>%
  filter(!la_code %in% c("E09000001", "E06000053") & year > 2005) %>%  # remove city of london & isles of scilly
  mutate(n_child_pct = n_child*100/pop_U1,
         n_child_10000 = n_child*10000/pop_U1,
         pop_U1_1000 = pop_U1/1000,
         any_ara_pct = any_ara_sum*100/n_mother,
         teen_birth_pct = teen_birth_sum*100/n_mother,
         #imd_20pc_pct = imd_20pc_sum*100/n_mother,
         imd_10pc_pct = imd_10pc_sum*100/n_mother,
         prop10_imd_pct = prop10_imd*100,
         #prop10_idaci_pct = prop10_idaci*100,
         #violence_1000 =
         #imd_quint = as.factor(case_when(decile_imd %in% c(1,2) ~ 1,
                                         # decile_imd %in% c(3,4) ~ 2,
                                         # decile_imd %in% c(5,6) ~ 3,
                                         # decile_imd %in% c(7,8) ~ 4,
                                         # decile_imd %in% c(9,10) ~ 5)),
         total_1000 = total/1000) %>%
  ungroup()%>%
  mutate(year_std = year - 2006,
         ofsted_protect = factor(case_when(protect_score == "Inadequate" ~ 4,
                                           protect_score == "Requires improvement" ~ 3,
                                           protect_score == "Good" ~ 2,
                                           protect_score == "Outstanding" ~ 1)),
         ofsted_prt_bad = ifelse(protect_score %in% c("Inadequate", "Requires improvement"),1,0),
         ofsted_lscb = factor(case_when(lscb_score == "Inadequate" ~ 4,
                                        lscb_score == "Requires improvement" ~ 3,
                                        lscb_score == "Good" ~ 2,
                                        lscb_score == "Outstanding" ~ 1)))

# taking out bad la data
dat_2010 <- filter(analysis_dat, year == 2010)

#dat_2010_cc <- filter(analysis_dat, year == 2010 & bad_la_linkrate == 0 & bad_bwmiss_rate == 0)

#------------------------------------------#
# adapt data for longitudinal modelling ----
#------------------------------------------#

# split out within and between LA effect ----
model_dat <- analysis_dat %>%
  group_by(la_code) %>%
  dplyr::mutate_at(vars(total_1000,
                        any_ara_pct,
                        teen_birth_pct,
                        #imd_20pc_pct,
                        imd_10pc_pct,
                        lowbw_pct,
                        preterm_pct,
                        child_lowinc,
                        starts_with("cong_anom")),
                   list(wt = ~(. - mean(., na.rm = TRUE) ), # within-LA effect
                        bt = ~mean(., na.rm = TRUE))) %>%    # between-LA effect
  mutate(any_bad_linkrate = as.numeric(any(bad_la_linkrate == 1)),
         any_bad_bwrate = as.numeric(any(bad_bw_missrate == 1)),
         any_bad_gestatrate = as.numeric(any(bad_gestat_missrate == 1))) %>%
  ungroup() %>%
  left_join(dplyr::select(dat_2010, la_code, teenbirth_2010 = teen_birth_pct, lowbw_2010 = lowbw_pct,
                          child_lowinc_2010 = child_lowinc, imd_10pc_2010 = imd_10pc_pct,
                          ca_feud_2010 = cong_anom_feud_sum_pct, ca_hardelid_2010 = cong_anom_sum_pct,
                          total_2010 = total_1000, any_ara_2010 = any_ara_pct, preterm_2010 = preterm_pct,
                          early_csc_2010 = early_csc_spend_pc), by = c("la_code"))

model_dat_cc <- model_dat %>%
  filter(any_bad_linkrate == 0 & any_bad_bwrate == 0) %>%
  group_by(la_code) %>%
  dplyr::mutate_at(vars(total_1000,
                        any_ara_pct,
                        teen_birth_pct,
                        #imd_20pc_pct,
                        imd_10pc_pct,
                        lowbw_pct,
                        preterm_pct,
                        child_lowinc,
                        starts_with("cong_anom")),
                   list(wt = ~(. - mean(., na.rm = TRUE) ), # within-LA effect
                        bt = ~mean(., na.rm = TRUE))) %>%    # between-LA effect
  ungroup() %>%
  dplyr::select(contains("total_1000"),
                contains("any_ara_pct"),
                contains("teen_birth_pct"),
                contains("pc_pct"),
                contains("lowbw_pct"),
                contains("preterm_pct"),
                contains("child_lowinc"),
                starts_with("cong_anom"),
                contains("n_child"),
                lone_parent_pct,
                violent_crime,
                prop10_imd_pct,
                pop_U1,
                la_code,
                la_name,
                region_name,
                year_std,
                ends_with("2010"))


# run_analyses.r

# This will run all analyses reported in the paper and send the results in
# csv format to a subdirectory called /output.

# Table 1 ------------------------------------------------------------

# summary statistics

tibble(
  group = c("total", "dup", "del", "noncarrier"),
  age_mean =
    subjects$raw %>%
    map(pull, age_months) %>%
    map(mean) %>%
    map(function(x) x / 12),
  age_sd =
    subjects$raw %>%
    map(pull, age_months) %>%
    map(sd) %>%
    map(function(x) x / 12),
  iq_mean =
    subjects$raw %>%
    map(pull, diagnosis_summary.best_full_scale_iq) %>%
    map(mean),
  iq_sd =
    subjects$raw %>%
    map(pull, diagnosis_summary.best_full_scale_iq) %>%
    map(sd),
  female_n =
    subjects$raw %>%
    map(filter, gender == 1) %>%
    map(nrow),
  female_percent =
    subjects$raw %>%
    map(function(x) nrow(filter(x, gender == 1)) / nrow(x) * 100),
  asd_n =
    subjects$raw %>%
    map(filter, clinical_asd == 1) %>%
    map(nrow),
  asd_percent =
    subjects$raw %>%
    map(function(x) nrow(filter(x, clinical_asd == 1)) / nrow(x) * 100),
  ocd_n =
    subjects$raw %>%
    map(filter, ocd == 1) %>%
    map(nrow),
  ocd_percent =
    subjects$raw %>%
    map(function(x) nrow(filter(x, ocd == 1)) / nrow(x) * 100)
) %>%
  unnest() %>%
  mutate_if(is.numeric, round, digits = 2) %>%
  write_excel_csv(here("r","output","table1","summary_stats.csv"))
# group comparisons

anova <- list()
anova$iq <- aov(diagnosis_summary.best_full_scale_iq ~ sample_group,
                data = subjects$raw$total)
anova$age <- aov(age_months ~ sample_group,
                 data = subjects$raw$total)

chi <- list()
chi$gender <- chisq.test(subjects$raw$total$gender,
                         subjects$raw$total$sample_group)
chi$asd <- chisq.test(subjects$raw$total$clinical_asd,
                      subjects$raw$total$sample_group)
chi$ocd <- chisq.test(subjects$raw$total$ocd,
                      subjects$raw$total$sample_group)

anova_posthoc <- list()
anova_posthoc$iq <- TukeyHSD(anova$iq)
anova_posthoc$age <- TukeyHSD(anova$age)

chi_posthoc <- list()
chi_posthoc$gender <- chisq.post.hoc(
  xtabs(~ gender + sample_group, data = subjects$raw$total),
  test = "chisq.test",
  popsInRows = FALSE,
  control = "bonferroni")
chi_posthoc$asd <- chisq.post.hoc(
  xtabs(~ clinical_asd + sample_group, data = subjects$raw$total),
  test = "chisq.test",
  popsInRows = FALSE,
  control = "bonferroni")
chi_posthoc$ocd <- chisq.post.hoc(
  xtabs(~ ocd + sample_group, data = subjects$raw$total),
  test = "chisq.test",
  popsInRows = FALSE,
  control = "bonferroni")

tibble(
  variable = c("iq","age"),
  test = anova %>% map(tidy)
) %>%
  unnest() %>%
  mutate_at(vars(-variable, -term, -p.value),
            round, digits = 2) %>%
  write_excel_csv(here("r","output","table1","anova.csv"))

tibble(
  variable = c("gender","asd","ocd"),
  test = chi %>% map(tidy)
) %>% unnest() %>%
  mutate_at(vars(-variable, -method, -p.value),
            round, digits = 2) %>%
  write_excel_csv(here("r","output","table1","chi.csv"))

tibble(
  variable = c("iq","age"),
  test = anova_posthoc %>% map(tidy)
) %>%
  unnest() %>%
  mutate_at(vars(-variable, -term, -comparison, -adj.p.value),
            round, digits = 2) %>%
  write_excel_csv(here("r","output","table1","anova_posthoc.csv"))

tibble(
  variable = c("gender","asd","ocd"),
  test = chi_posthoc %>% map(as.tibble)
) %>% unnest() %>%
  write_excel_csv(here("r","output","table1","chi_posthoc.csv"))

# Table 2 ------------------------------------------------------------

tibble(
  group = c("total", "dup", "del", "noncarrier"),
  ados =
    subjects$raw %>%
    map(function (x) filter(x, !is.na(ados_css_total_combined))) %>%
    map(function (x) nrow(x)),
  adir =
    subjects$raw %>%
    map(function (x) filter(x, !is.na(adi_r.c_total))) %>%
    map(function (x) nrow(x)),
  bapq =
    subjects$raw %>%
    map(function (x) filter(x, !is.na(bapq.total))) %>%
    map(function (x) nrow(x)),
  scq =
    subjects$raw %>%
    map(function (x) filter(x, !is.na(scq_life.summary_score))) %>%
    map(function (x) nrow(x)),
  srs_child =
    subjects$raw %>%
    map(function (x) filter(x, !is.na(srs_parent.total))) %>%
    map(function (x) nrow(x)),
  srs_adult =
    subjects$raw %>%
    map(function (x) filter(x, !is.na(srs_adult.total))) %>%
    map(function (x) nrow(x)),
  mullen =
    subjects$raw %>%
    map(function (x) filter(x, !is.na(mullen.measure.measure_type))) %>%
    map(function (x) nrow(x)),
  das2_early_lower =
    subjects$raw %>%
    map(function (x) filter(
      x, !is.na(das_ii_early_years.gca_lower_standard))) %>%
    map(function (x) nrow(x)),
  das2_early_upper =
    subjects$raw %>%
    map(function (x) filter(
      x, !is.na(das_ii_early_years.gca_upper_standard))) %>%
    map(function (x) nrow(x)),
  das2_school =
    subjects$raw %>%
    map(function (x) filter(
      x,!is.na(das_ii_school_age.measure.measure_type))) %>%
    map(function (x) nrow(x)),
  wasi =
    subjects$raw %>%
    map(function (x) filter(x, !is.na(wasi.measure.measure_type))) %>%
    map(function (x) nrow(x)),
  cbcl =
    subjects$raw %>%
    map(function (x) filter(x, !is.na(cbcl_6_18.thought_problems_t_score))) %>%
    map(function (x) nrow(x)),
  abcl =
    subjects$raw %>%
    map(function (x) filter(x, !is.na(abcl_18_59.thought_t_score))) %>%
    map(function (x) nrow(x)),
  scl =
    subjects$raw %>%
    map(function (x) filter(x, scl_90_r.measure.eval_age_months>0)) %>%
    map(function (x) nrow(x)),
  disc =
    subjects$raw %>%
    map(function (x) filter(x, !is.na(disc_youth.measure.measure_type))) %>%
    map(function (x) nrow(x)),
  sops =
    subjects$raw %>%
    map(function (x) filter(x, !is.na(eval_age_months))) %>%
    map(function (x) nrow(x))
) %>%
  unnest() %>%
  write_excel_csv(here("r","output","table2","table2.csv"))

# Table 3 -------------------------------------------------------------

tibble(
  group = c("total","dup","del","noncarrier"),
  bcl_received =
    subjects$raw %>%
    map(filter, bcl_data == 1) %>%
    map(nrow),
  bcl_positive =
    subjects$raw %>%
    map(filter, bcl_missingness == 1) %>%
    map(nrow),
  bcl_percent =
    subjects$raw %>%
    map(function (x)
      nrow(filter(x, bcl_missingness == 1)) /
      nrow(filter(x, bcl_data == 1)) * 100 ),
  scl_received =
    subjects$raw %>%
    map(filter, scl_data == 1) %>%
    map(nrow),
  scl_positive =
    subjects$raw %>%
    map(filter, scl_missingness_binary == 1) %>%
    map(nrow),
  scl_percent =
    subjects$raw %>%
    map(function (x)
      nrow(filter(x, scl_missingness_binary == 1)) /
        nrow(filter(x, scl_data == 1)) * 100 ),
  disc_received =
    subjects$raw %>%
    map(filter, disc_data == 1) %>%
    map(nrow),
  disc_positive =
    subjects$raw %>%
    map(filter, disc_missingness == 1) %>%
    map(nrow),
  disc_percent =
    subjects$raw %>%
    map(function (x)
      nrow(filter(x, disc_missingness == 1)) /
        nrow(filter(x, disc_data == 1)) * 100 ),
  sops_received =
    subjects$raw %>%
    map(filter, sops_data == 1) %>%
    map(nrow),
  sops_positive =
    subjects$raw %>%
    map(filter, sops_missingness == 1) %>%
    map(nrow),
  sops_percent =
    subjects$raw %>%
    map(function (x)
      nrow(filter(x, sops_missingness == 1)) /
        nrow(filter(x, disc_data == 1)) * 100 )
) %>%
  unnest() %>%
  mutate_if(is.numeric, round, digits = 2) %>%
  write_excel_csv(here("r","output","table3","table3.csv"))

# Table 4 -------------------------------------------------------------

# number of participants with each combination

tibble(
  bcl_scl_data =
    subjects$raw$total %>%
    filter(bcl_data == 1 & scl_data == 1) %>%
    nrow(),
  bcl_scl_positive =
    subjects$raw$total %>%
    filter(bcl_missingness == 1 & scl_missingness_binary == 1) %>%
    nrow(),

  bcl_disc_data =
    subjects$raw$total %>%
    filter(bcl_data == 1 & disc_data == 1) %>%
    nrow(),
  bcl_disc_positive =
    subjects$raw$total %>%
    filter(bcl_missingness == 1 & disc_missingness == 1) %>%
    nrow(),

  bcl_sops_data =
    subjects$raw$total %>%
    filter(bcl_data == 1 & sops_data == 1) %>%
    nrow(),
  bcl_sops_positive =
    subjects$raw$total %>%
    filter(bcl_missingness == 1 & sops_missingness == 1) %>%
    nrow(),

  scl_sops_data =
    subjects$raw$total %>%
    filter(scl_data == 1 & sops_data == 1) %>%
    nrow(),
  scl_sops_positive =
    subjects$raw$total %>%
    filter(scl_missingness_binary == 1 & sops_missingness == 1) %>%
    nrow(),

  disc_sops_data =
    subjects$raw$total %>%
    filter(disc_data == 1 & sops_data == 1) %>%
    nrow(),
  disc_sops_positive =
    subjects$raw$total %>%
    filter(disc_missingness == 1 & sops_missingness == 1) %>%
    nrow()
) %>%
  write_excel_csv(here("r","output","table4","pairwise_combinations.csv"))

crosstabs <- list()
crosstabs$bcl_scl <- xtabs(
  ~ bcl_missingness + scl_missingness_binary, data = subjects$raw$total)
crosstabs$bcl_disc <- xtabs(
  ~ bcl_missingness + disc_missingness, data = subjects$raw$total)
crosstabs$bcl_sops <- xtabs(
  ~ bcl_missingness + sops_missingness, data = subjects$raw$total)
crosstabs$scl_sops <- xtabs(
  ~ scl_missingness_binary + sops_missingness, data = subjects$raw$total)
crosstabs$disc_sops <- xtabs(
  ~ disc_missingness + sops_missingness, data = subjects$raw$total)

tibble(
  pair = c("BCL x SCL","BCL x DISC","BCL x SOPS",
           "SCL x SOPS","Disc x SOPS"),
  fisher = crosstabs %>%
    map(fisher.test) %>%
    map(tidy)
) %>%
  unnest() %>%
  mutate_at(vars(-pair, -p.value, -method, -alternative),
            round, digits = 2) %>%
  write_excel_csv(here("r","output","table4","relationship_strengths.csv"))

index_measures <- subjects$raw$total %>%
  select(scl_missingness_binary,
         bcl_missingness,
         sops_missingness,
         disc_missingness)

Hmisc::rcorr(as.matrix(index_measures), type=c("spearman"))

# Correlation matrix

subjects$analysis$all <- subjects$analysis$all %>% mutate(
  duplication_standardized = arm::rescale(
    duplication, binary.inputs = "center"))

subjects$analysis$all <- subjects$analysis$all %>% mutate(
  deletion_standardized = arm::rescale(
    deletion, binary.inputs = "center"))

subjects$analysis$all <- subjects$analysis$all %>% mutate(
  asd_standardized = arm::rescale(
    clinical_asd, binary.inputs = "center"))

subjects$analysis$all <- subjects$analysis$all %>% mutate(
  ocd_standardized = arm::rescale(
    ocd, binary.inputs = "center"))

subjects$analysis$all <- subjects$analysis$all %>% mutate(
  gender_standardized = arm::rescale(
    gender, binary.inputs = "center"))

subjects$analysis$all <- subjects$analysis$all %>% mutate(
  age_standardized = arm::rescale(age_months))

subjects$analysis$all <- subjects$analysis$all %>% mutate(
  iq_standardized = arm::rescale(diagnosis_summary.best_full_scale_iq))

matrix <- subjects$analysis$all %>% select(
  duplication_standardized,
  deletion_standardized,
  age_standardized,
  iq_standardized,
  asd_standardized,
  ocd_standardized,
  gender_standardized
)

correlations <- Hmisc::rcorr(as.matrix(matrix),type=c("pearson"))

correlations_r_rounded <- correlations$r %>% round(digits=3)

correlations_p_rounded <- correlations$P %>% round(digits=3)

correlations_r_rounded %>%
  as.data.frame() %>%
  write_excel_csv(here("r","output","correlation_matrix","cor_r.csv"))

correlations_p_rounded %>%
  as.data.frame() %>%
  write_excel_csv(here("r","output","correlation_matrix","cor_p.csv"))

# Table 5 ----------------------------------------

models <- list()

models$base$all <-
  geeglm(binary_psychosis ~
           duplication +
           deletion +
           age_years +
           diagnosis_summary.best_full_scale_iq +
           clinical_asd +
           ocd +
           gender,
         data = subjects$analysis$all,
         family = binomial(link="logit"),
         na.action = na.exclude,
         id = family)

models$base$all %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table5","table5_or.csv"))

models$base$all %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  write_excel_csv(here("r","output","table5","table5_unrounded.csv"))

models$base$all %>%
  tidy(conf.int = TRUE, exponentiate = FALSE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table5","table5_b.csv"))

# Table 6 -------------------------------------------------------------

models$base$duplication_only <-
  geeglm(binary_psychosis ~
           age_years +
           diagnosis_summary.best_full_scale_iq +
           clinical_asd +
           ocd +
           gender,
         data = subjects$analysis$duplication,
         family = binomial(link="logit"),
         na.action = na.exclude,
         id = family)

models$base$duplication_only %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table6","dup_or.csv"))

models$base$duplication_only %>%
  tidy(conf.int = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table6","dup_b.csv"))

models$base$duplication_only %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  write_excel_csv(here("r","output","table6","dup_unrounded.csv"))

models$base$deletion_only <-
  geeglm(binary_psychosis ~
           age_years +
           diagnosis_summary.best_full_scale_iq +
           clinical_asd +
           ocd +
           gender,
         data = subjects$analysis$deletion,
         family = binomial(link="logit"),
         na.action = na.exclude,
         id = family)

models$base$deletion_only %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table6","del_or.csv"))

models$base$deletion_only %>%
  tidy(conf.int = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table6","del_b.csv"))

models$base$deletion_only %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  write_excel_csv(here("r","output","table6","del_unrounded.csv"))

models$base$noncarriers <-
  geeglm(binary_psychosis ~
           age_years +
           diagnosis_summary.best_full_scale_iq +
           clinical_asd +
           ocd +
           gender,
         data = subjects$analysis$noncarrier,
         family = binomial(link="logit"),
         na.action = na.exclude,
         id = family)

models$base$noncarriers %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table6","nc_or.csv"))

models$base$noncarriers %>%
  tidy(conf.int = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table6","nc_b.csv"))

models$base$noncarriers %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  write_excel_csv(here("r","output","table6","nc_unrounded.csv"))

# Table S2 ---------------------------------------------------------

exploratory_all <- subjects$analysis$all %>% filter(
  !is.na(ados_css_total_combined))

models$exploratory$total_css <-
  geeglm(binary_psychosis ~
           duplication +
           deletion +
           age_years +
           diagnosis_summary.best_full_scale_iq +
           ados_css_total_combined +
           ocd +
           gender,
         data = exploratory_all,
         family = binomial(link="logit"),
         na.action = na.exclude,
         id = family)

models$exploratory$total_css %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table_s2","total_css_all_or.csv"))

models$exploratory$total_css %>%
  tidy(conf.int = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table_s2","total_css_all_b.csv"))

models$exploratory$total_css %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  write_excel_csv(here("r","output","table_s2","total_css_all_unrounded.csv"))

exploratory_duplication <- subjects$analysis$duplication %>% filter(
  !is.na(ados_css_total_combined))

models$exploratory$total_css_duplication <-
  geeglm(binary_psychosis ~
           age_years +
           diagnosis_summary.best_full_scale_iq +
           ados_css_total_combined +
           ocd +
           gender,
         data = exploratory_duplication,
         family = binomial(link="logit"),
         na.action = na.exclude,
         id = family)

models$exploratory$total_css_duplication %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table_s2","total_css_dup_or.csv"))

models$exploratory$total_css_duplication %>%
  tidy(conf.int = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table_s2","total_css_dup_b.csv"))

models$exploratory$total_css_duplication %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  write_excel_csv(here("r","output","table_s2","total_css_dup_unrounded.csv"))

exploratory_deletion <- subjects$analysis$deletion %>% filter(
  !is.na(ados_css_total_combined))

models$exploratory$total_css_deletion <-
  geeglm(binary_psychosis ~
           age_years +
           ados_css_total_combined +
           diagnosis_summary.best_full_scale_iq +
           ocd +
           gender,
         data = exploratory_deletion,
         family = binomial(link="logit"),
         na.action = na.exclude,
         id = family)

models$exploratory$total_css_deletion %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table_s2","total_css_del_or.csv"))

models$exploratory$total_css_deletion %>%
  tidy(conf.int = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table_s2","total_css_del_b.csv"))

models$exploratory$total_css_deletion %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  write_excel_csv(here("r","output","table_s2","total_css_del_unrounded.csv"))

exploratory_noncarrier <- subjects$analysis$noncarrier %>% filter(
  !is.na(ados_css_total_combined))

models$exploratory$total_css_noncarrier <-
  geeglm(binary_psychosis ~
           age_years +
           diagnosis_summary.best_full_scale_iq +
           ados_css_total_combined +
           ocd +
           gender,
         data = exploratory_noncarrier,
         family = binomial(link="logit"),
         na.action = na.exclude,
         id = family)

models$exploratory$total_css_noncarrier %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table_s2","total_css_nc_or.csv"))

models$exploratory$total_css_noncarrier %>%
  tidy(conf.int = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table_s2","total_css_nc_b.csv"))

models$exploratory$total_css_noncarrier %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  write_excel_csv(here("r","output","table_s2","total_css_nc_unrounded.csv"))

# Table S3 ---------------------------------------------------------------

exploratory_all_domain <- subjects$analysis$all %>% filter(
  !is.na(ados_css_rrb_derived) & !is.na(ados_css_sa_derived))

models$exploratory$domain_css <-
  geeglm(binary_psychosis ~
           duplication +
           deletion +
           age_years +
           diagnosis_summary.best_full_scale_iq +
           ados_css_rrb_derived +
           ados_css_sa_derived +
           ocd +
           gender,
         data = exploratory_all_domain,
         family = binomial(link="logit"),
         na.action = na.exclude,
         id = family)

models$exploratory$domain_css %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table_s3","domain_css_all_or.csv"))

models$exploratory$domain_css %>%
  tidy(conf.int = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table_s3","domain_css_all_b.csv"))

models$exploratory$domain_css %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  write_excel_csv(here("r","output","table_s3","domain_css_all_unrounded.csv"))

exploratory_duplication_domain <- filter(
  subjects$analysis$duplication,
  !is.na(ados_css_rrb_derived) & !is.na(ados_css_sa_derived))

models$exploratory$domain_css_duplication <-
  geeglm(binary_psychosis ~
           age_years +
           diagnosis_summary.best_full_scale_iq +
           ados_css_rrb_derived +
           ados_css_sa_derived +
           ocd +
           gender,
         data = exploratory_duplication_domain,
         family = binomial(link="logit"),
         na.action = na.exclude,
         id = family)

models$exploratory$domain_css_duplication %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table_s3","domain_css_dup_or.csv"))

models$exploratory$domain_css_duplication %>%
  tidy(conf.int = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table_s3","domain_css_dup_b.csv"))

models$exploratory$domain_css_duplication %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  write_excel_csv(here("r","output","table_s3","domain_css_dup_unrounded.csv"))

exploratory_deletion_domain <- subjects$analysis$deletion %>% filter(
  !is.na(ados_css_rrb_derived) & !is.na(ados_css_sa_derived))

models$exploratory$domain_css_deletion <-
  geeglm(binary_psychosis ~
           age_years +
           diagnosis_summary.best_full_scale_iq +
           ados_css_rrb_derived +
           ados_css_sa_derived +
           ocd +
           gender,
         data = exploratory_deletion_domain,
         family = binomial(link="logit"),
         na.action = na.exclude,
         id = family)

models$exploratory$domain_css_deletion %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table_s3","domain_css_del_or.csv"))

models$exploratory$domain_css_deletion %>%
  tidy(conf.int = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table_s3","domain_css_del_b.csv"))

models$exploratory$domain_css_deletion %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  write_excel_csv(here("r","output","table_s3","domain_css_del_unrounded.csv"))

exploratory_noncarrier_domain <- filter(
  subjects$analysis$noncarrier,
  !is.na(ados_css_rrb_derived) & !is.na(ados_css_sa_derived))

models$exploratory$domain_css_noncarrier <-
  geeglm(binary_psychosis ~
           age_years +
           diagnosis_summary.best_full_scale_iq +
           ados_css_rrb_derived +
           ados_css_sa_derived +
           ocd +
           gender,
         data = exploratory_noncarrier_domain,
         family = binomial(link="logit"),
         na.action = na.exclude,
         id = family)

models$exploratory$domain_css_noncarrier %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table_s3","domain_css_nc_or.csv"))

models$exploratory$domain_css_noncarrier %>%
  tidy(conf.int = TRUE) %>%
  mutate_at(vars(-term), round, digits = 3) %>%
  write_excel_csv(here("r","output","table_s3","domain_css_nc_b.csv"))

models$exploratory$domain_css_noncarrier %>%
  tidy(conf.int = TRUE, exponentiate = TRUE) %>%
  write_excel_csv(here("r","output","table_s3","domain_css_nc_unrounded.csv"))


#===================================================================================================#

# Expression Table

    #For  "Heatmap for methylation regulating TF (Fig. 2b, d)" in Methyl850_HEP.r

#===================================================================================================#
expMatrix <- read.table("iPS_HEP_diff_F5.TPM.txt", header=TRUE, row.name=NULL, sep="\t", stringsAsFactors=FALSE)
expMatrix <- expMatrix[,c(1:4,14:16,5:13)]    # reorder based on time point

#summrize by gene
promoterID <- expMatrix[,"prmtrID"]    # extraction of promoter IDs
gene_name <- sapply(strsplit(promoterID, "@"), function(x){x[2]})    # Extraction of gene names
unique.gene_name <- unique(gene_name)    #removing the redundancy
## Combine all promoter tag counts of each gene
## !!This process takes times!!
gene_expMatrix <- NULL
counter <- 0    # Initialization of the counter
for(i in unique.gene_name){
gene_expMatrix <- rbind(gene_expMatrix, apply(expMatrix[which(gene_name == i),-1],2,sum))
## For loop counter
counter <- counter + 1
progress <- floor((counter/length(unique.gene_name))*100)
cat(paste0(" ##### Progress:",progress, "% #####\r"))
}
rownames(gene_expMatrix) <- unique.gene_name
save(gene_expMatrix, file="gene_expMatrix.RData")    ## aveing the data

#mean and sd
rep_group <- c(rep(1,3), rep(2,3), rep(3,3), rep(4,3), rep(5,3))
## Mean
mean.gene_expMatrix <- cbind(apply(gene_expMatrix[,which(rep_group==1)], 1, mean),
    apply(gene_expMatrix[,which(rep_group==2)], 1, mean),
    apply(gene_expMatrix[,which(rep_group==3)], 1, mean),
    apply(gene_expMatrix[,which(rep_group==4)], 1, mean),
    apply(gene_expMatrix[,which(rep_group==5)], 1, mean)
)
colnames(mean.gene_expMatrix) <- c("iPS_HEP_D00", "iPS_HEP_D07", "iPS_HEP_D14", "iPS_HEP_D21", "iPS_HEP_D28")
## SD
sd.gene_expMatrix <- cbind(apply(gene_expMatrix[,which(rep_group==1)], 1, sd),
    apply(gene_expMatrix[,which(rep_group==2)], 1, sd),
    apply(gene_expMatrix[,which(rep_group==3)], 1, sd),
    apply(gene_expMatrix[,which(rep_group==4)], 1, sd),
    apply(gene_expMatrix[,which(rep_group==5)], 1, sd)
)
colnames(sd.gene_expMatrix) <- c("iPS_HEP_D00", "iPS_HEP_D07", "iPS_HEP_D14", "iPS_HEP_D21", "iPS_HEP_D28")

save(list=ls(), file="out/CAGE_HEP/gene_expMatrix.RData")
#===================================================================================================#

# Marker gene exprssion (Supplementary Figure 1c, 2c and 4c)

    #description: This script vidualize expression of indicated genes as a line plot.

#===================================================================================================#
#loding the CAGE expression data
expMatrix <- read.table("iPS_HEP_diff_F5.TPM.txt", header = TRUE, row.name = NULL, sep = "\t", stringsAsFactors = FALSE)
expMatrix <- expMatrix[,c(1:4,14:16,5:13)]    # reorder based on time point

#Compute mean and sd of replicates
mean.expMatrix <- cbind(
    apply(expMatrix[,c(2:4)], 1, mean),
    apply(expMatrix[,c(5:7)], 1, mean),
    apply(expMatrix[,c(8:10)], 1, mean),
    apply(expMatrix[,c(11:13)], 1, mean),
    apply(expMatrix[, c(14:16)], 1, mean)
)
colnames(mean.expMatrix) <- c(0, 7, 14, 21, 28)
rownames(mean.expMatrix) <- expMatrix$prmtrID

#compute sd of replicates
sd.expMatrix <- cbind(
    apply(expMatrix[,c(2:4)], 1, sd),
    apply(expMatrix[,c(5:7)], 1, sd),
    apply(expMatrix[,c(8:10)], 1, sd),
    apply(expMatrix[,c(11:13)], 1, sd),
    apply(expMatrix[, c(14:16)], 1, sd)
)
colnames(sd.expMatrix) <- c(0, 7, 14, 21, 28)
rownames(sd.expMatrix) <- expMatrix$prmtrID

#extraction of GOI
psc_marker <- c("POU5F1", "NANOG")
de_marker <- c("SOX17", "FOXA2")
hep_marker <- c("HNF1A", "TBX3", "HNF4A", "ASGR1", "APOB","SLC10A1", "AFP", "KRT18", "SERPINA1" "ALB", "CYP3A4", "FOXA2")
methylation_genes <- c("DNMT1", "DNMT3A", "DNMT3B", "TET1", "TET2", "TET3")

gois <- c(psc_marker, de_marker,hep_marker, methylation_genes)

for(i in gois){
    #extraction of GOI expression data
    goi <- i
    gene_names <- sapply(strsplit(rownames(mean.expMatrix), "@"), function(x){ x[2] })

    goi.mean.expMatrix <- mean.expMatrix[gene_names %in% goi, , drop=FALSE]
    goi.sd.expMatrix <- sd.expMatrix[gene_names %in% goi, ,drop=FALSE]

    ##order based on promoter number
    goi.mean.expMatrix <- goi.mean.expMatrix[order(as.numeric(gsub("p", "", sapply(strsplit(rownames(goi.mean.expMatrix), "@"), function(x){x[1]})))),]
    goi.sd.expMatrix <- goi.sd.expMatrix[order(as.numeric(gsub("p", "", sapply(strsplit(rownames(goi.sd.expMatrix), "@"), function(x){x[1]})))),]

    #remove low expreeesion promoters
    cutoff <- 5
    tpm_cutoff <- which((apply(goi.mean.expMatrix, 1, max) >= cutoff))
    goi.mean.expMatrix <- goi.mean.expMatrix[tpm_cutoff, ,drop=FALSE]
    goi.sd.expMatrix <- goi.sd.expMatrix[tpm_cutoff,, drop = FALSE]

    if(nrow(goi.mean.expMatrix) == 0) next

    #line plot
    goi.mean.expMatrix %>%
        as.data.frame() %>%
        mutate(Gene = rownames(.)) %>%
        pivot_longer(cols = -Gene, values_to = "TPM", names_to = "Days") -> y

    goi.sd.expMatrix %>%
        as.data.frame() %>%
        mutate(Gene = rownames(.)) %>%
        pivot_longer(cols = -Gene, values_to = "sd", names_to = "Days") -> sd.y

    y.df <- cbind(y, sd = sd.y[,3])
    y.df$Days <- factor(y.df$Days, levels = c(0, 7, 14, 21, 28))

    theme <- theme(
        panel.background = element_blank(),
        panel.border = element_rect(fill = NA),
        panel.grid.major = element_line(colour = "gray"),
        panel.grid.minor = element_blank(),
        strip.background=element_blank(),
        axis.text.x = element_text(colour = "black"),
        axis.text.y = element_text(colour = "black"),
        axis.ticks=element_line(colour="black"),
        legend.key = element_rect(fill = "white"),
        legend.position="bottom",
        plot.margin = unit(c(1, 1, 1, 1), "line"))

    g <- ggplot(y.df, aes(x = Days, y = TPM, color = Gene))
    g <- g + geom_line(aes(group = Gene))
    g <- g + geom_errorbar(aes(ymin = TPM - sd, ymax = TPM + sd, width = 0.3))
    g <- g + theme
    g <- g + guides(color=guide_legend("Gene"),fill=guide_legend("Gene"))
    plot(g)

    ggsave(g, file = paste0(goi, "_.expression.pdf"), width = 9, height = 7)
}


x=numeric(10)  # allocate a numeric vector of size 10 to x
rm(x)  # remove x

x=vector("list",10) #allocate a list of length 10
x=vector("numeric",10) #same as x=numeric(10), space allocated to list vector above now freed
rm(x)  # remove x


suppressPackageStartupMessages(library(float))
set.seed(1234)

x1 = c(1, NaN, Inf, -Inf, 2, NA_real_)
s1 = fl(x1)

x2 = matrix(1:30, 10)
x2[c(1, 3, 5, 7), 3] = NA
x2[2, 1] = NA
s2 = fl(x2)

stopifnot(all.equal(is.na(s1), is.na(x1)))
stopifnot(all.equal(is.na(s2), is.na(x2)))

stopifnot(all.equal(dbl(na.omit(s1)), na.omit(x1), check.attributes=FALSE))
stopifnot(all.equal(dbl(na.omit(s2)), na.omit(x2), check.attributes=FALSE))

stopifnot(all.equal(dbl(na.omit(na.omit(s1))), na.omit(na.omit(x1)), check.attributes=FALSE))
stopifnot(all.equal(dbl(na.omit(na.omit(s2))), na.omit(na.omit(x2)), check.attributes=FALSE))