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

#preprocessing

#===================================================================================================
library("InfiniumDiffMetMotR")

selDataMatrix <- lumiMethyNorm(
    fileName = "TableControl.txt",
    inputtype = "signal",
    sample_names = c("ID00", "ID48", "ID54", "D60", "ID66", "ID72", "ID96")
)

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

# DMR b2b plot (Fig. 4b)

#===================================================================================================
#Count DMP
comp <- data.frame(
    DE0h_DE48h = c(1, 2),
    DE48h_DE54h = c(2, 3),
    DE54h_DE60h = c(3, 4),
    DE60h_DE66h = c(4, 5),
    DE66h_DE72h = c(5, 6)
)

M_ndiffprobes <- sapply(comp, function(x){
    sum(selDataMatrix[, as.numeric(x[1])] - selDataMatrix[, x[2]] <= -2)
})
D_ndiffprobes <- sapply(comp, function(x){
    sum(selDataMatrix[, as.numeric(x[1])] - selDataMatrix[, x[2]] >= 2)
})

nprobes_df <- data.frame(
    Time = c("0h-48h", "48h-54h", "54h-60h", "60h-66h", "66h-72h"),
    Methylated = M_ndiffprobes,
    Demethylated = D_ndiffprobes
)

#plot
nprobes_b2b_df <- tidyr::pivot_longer(nprobes_df, col = -Time,, names_to = "MetDemet", values_to = "nprobes")

library(dplyr)
the_order <- rev(as.character(unlist(
    nprobes_b2b_df %>%
        filter(MetDemet == "Methylated") %>%
        select(Time)
)))

theme <- theme(
    panel.background = element_blank(), # initialization
    panel.border = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    strip.background = element_blank(),
    plot.title = element_text(size = 10, hjust = 0.5),
    axis.text.x = element_blank(),
    axis.text.y = element_blank(),
    axis.title.y = element_blank(),
    axis.ticks = element_blank(),
    legend.key = element_blank(),
    legend.position = "none",
    plot.margin = unit(c(1, 1, 1, 1), "line"),
    panel.grid.major.x = element_line(linetype = "dotted", size = 0.3, color = "#3A3F4A")
)

g <- ggplot(nprobes_b2b_df, aes(x = Time))
g <- g + scale_x_discrete(limits = the_order)

#Methylated plot (left)
g.M <- g + geom_bar(
    data = nprobes_b2b_df[nprobes_b2b_df[["MetDemet"]] == "Methylated",],
    aes(y = nprobes), fill = rgb(0.8, 0, 0.2, alpha = 0.9),
    stat = "identity"
)
g.M <- g.M + scale_y_reverse(limits = c(max(nprobes_b2b_df[["nprobes"]]) * 1.2, 0))
g.M <- g.M + ggtitle('Methylated')
g.M <- g.M + ylab("Number of probes")
g.M <- g.M + coord_flip()
g.M <- g.M + theme
g.M <- g.M + theme(
    axis.text.x = element_text(size = 10),
    axis.ticks.x = element_line(size = 0.5),
    axis.line.x = element_line(size = 0.5)
)

#Demethylated plot (Right)
g.D <- g + geom_bar(
    data = nprobes_b2b_df[nprobes_b2b_df[["MetDemet"]] == "Demethylated",],
    aes(y = nprobes), fill = rgb(0, 0.7, 0, alpha = 0.9),
    stat = "identity"
)
g.D <- g.D + scale_y_continuous(limits = c(0, max(nprobes_b2b_df[["nprobes"]]) * 1.2))
g.D <- g.D + ggtitle('Demethylated')
g.D <- g.D + ylab("Number of probes")
g.D <- g.D + coord_flip()
g.D <- g.D + theme
g.D <- g.D + theme(
    axis.text.x = element_text(size = 10),
    axis.ticks.x = element_line(size = 0.5),
    axis.line.x = element_line(size = 0.5)
)

#labels (Center)
g.time <- g + geom_bar(
    data = nprobes_b2b_df[nprobes_b2b_df[["MetDemet"]] == "Demethylated",],
    aes(y = 0, fill = 'white'),
    alpha = 0, stat = "identity"
)
g.time <- g.time + geom_text(aes(y = 0, label = as.character(Time)), size = 4)
g.time <- g.time + ggtitle("Time")
g.time <- g.time + coord_flip()
g.time <- g.time + ylab("")
g.time <- g.time + theme
g.time <- g.time + theme(panel.grid.major.x = element_blank())

g_all <- grid.arrange(
    g.M, g.time, g.D,
    ncol = 3,
    widths = c(4.25 / 10, 1.5 / 10, 4.25 / 10)
)

ggsave(g_all, file = "nDMP_b2bplot.pdf", width = 7, height = 7)

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

#enrichment plot (Supplementary Figure 5b and 5c)

#===================================================================================================
#motif database construction
motif_names <- "GATA6"
motifDBList <- IMAGE_PWMlist
motif <- motifDBList[grep(motif_names, names(motifDBList))]

# parameter setting
outname <- "DE" #output file name
MethylDemethyl <- "Demethyl" #Indication of methylated regions or demethylated regions
COMP <- data.frame(DE_00_48 = c(1, 2), DE_48_54 = c(2, 3), DE_54_60 = c(3, 4), DE_60_66 = c(4, 5), , DE_66_72 = c(5, 6), DE_00_72 = c(1, 6))

#enrichment score computation
All_enrichments <- as.list(NULL) #List file to be input all nerichment scores
comp_names <- NULL #vector to be input comparison names

for(i in seq(ncol(COMP))){
    ControlColnum <- as.numeric(COMP[1, i])
    TreatmentColnum <- as.numeric(COMP[2, i])
    comp_names <- c(
        comp_names,
        paste0(colnames(selDataMatrix)[ControlColnum], "_vs_", colnames(selDataMatrix)[TreatmentColnum])
    )

    #extraction of differentially methylated probe IDs
    DMP_IDs <- DmpId(selDataMatrix = selDataMatrix, ControlColnum = ControlColnum, TreatmentColnum = TreatmentColnum, MethylDemethyl = Demethyl)
    nDMP_IDs <- length(DMP_IDs)

    #extraction of DMP positions and stratified sampling
    probe_annotation <- EPICanno
    target_position <- na.omit(probeID2position(probe_IDs = DMP_IDs, anno_info = probe_annotation)) #conversion of DMP IDs to position
    randomProbe_IDs <- stratSampling(target_IDs = DMP_IDs, anno_info = probe_annotation) #stratified sampling for negative control
    random_position <- na.omit(probeID2position(probe_IDs = randomProbe_IDs, anno_info = probe_annotation)) #conversion of NC probe IDs to position
    positionsList <- list("target" = target_position, "random" = random_position) #integrate DMP positoins and NC positions

    #Sequence extraction
    library("BSgenome.Hsapiens.UCSC.hg19")
    tmp <- ls(paste("package", "BSgenome.Hsapiens.UCSC.hg19", sep = ":"))
    genome <- eval(parse(text = tmp))

    seq_range <- c(-5000, 5000) #range from the CpG position to be extracted
    sequences <- lapply(positionsList, function(x){ seqExtract(positions = x, genome = genome, seq_range) })

    #Write splitted sequences
    tempDir <- paste(outname, "_temp", sep = "")
    dir.create(tempDir)

    seqs <- sequences$target
    target_all_filenames <- writeSplitSeq(seqs = seqs, split_num = 2500, tempDir = tempDir, output_file = "target")
    seqs <- sequences$random
    random_all_filenames <- writeSplitSeq(seqs = seqs, split_num = 2500, tempDir = tempDir, output_file = "random")
    rm(sequences)
    rm(seqs)
    invisible(replicate(3, gc()))

    #motif search
    target_positionsList <- splitSeqMotDist(filenames = target_all_filenames, motif_list = motif, min.score = min.score)
    file.remove(target_all_filenames)
    gc()
    random_positionsList <- splitSeqMotDist(filenames = random_all_filenames, motif_list = motif, min.score = min.score)
    file.remove(random_all_filenames)
    gc()

    #computation of enrichment score
    target_mot_posi <- unlist(target_positionsList)
    ctrl_mot_posi <- unlist(random_positionsList)
    enrichment_scores <- enrichScoreDist(target_mot_posi, ctrl_mot_posi, seq_range = seq_range, motif_name = motif_names, nDMP_IDs = nDMP_IDs, outname = outname, plot_draw = FALSE)

    All_enrichments <- c(All_enrichments, list(enrichment_scores))

    file.remove(tempDir)
}

#Vidualization
ranks <- seq(seq_range[1], seq_range[2], length = 1001) # x-axis values
data <- sapply(All_enrichments, cbind)
rownames(data) <- ranks
colnames(data) <- comp_names

data.df <- as.data.frame(data)
data.df %>%
    mutate(Position = rownames(data.df)) %>%
    mutate_at(vars("Position"), as.integer) -> data.df

data.df2 <- tidyr::pivot_longer(data.df, cols = -Position, names_to = "comparison", values_to = "ES")

data_names <- c("ID00_vs_ID48", "ID48_vs_ID54", "ID54_vs_ID60", "ID60_vs_ID66", "ID66_vs_ID72", , "ID00_vs_ID72")
cols <- brewer.pal(7, "Dark2")

g_list <- NULL
for(i in seq(length(data_names))){
    data.df3 <- filter(data.df2, comparison == eval(data_names[i]))

    g <- ggplot(data.df3, aes(x = Position, y = ES, color = eval(cols[i])))
    g <- g + geom_line()
    g <- g + ylim(-0.1, 0.25)
    g <- g + xlab("Distance from CpG") # X-axis label
    g <- g + ylab("Enrichment Score") # Y-axis label
    g <- g + geom_hline(yintercept = 0) # wtire a horizontal line at intercept=0
    g <- g + geom_vline(xintercept = 0, color = "Gray51") # wtire a horizontal line at intercept=0
    g <- g + scale_colour_manual(values = c(cols[i]))
    ## Settings of axes
    g <- g + theme(
        axis.text.x = element_text(color = "black", size = 14), # X-axis texit setting
        axis.text.y = element_text(color = "black", size = 14), # Y-axis texit setting
        axis.ticks = element_line(color = "black", size = .5), # Setting of scale ticks line
        axis.title = element_text(color = "black", size = 14), # Setting of scale ticks texit
        panel.background = element_rect(fill = "white", color = NA), # panel background color
        panel.border = element_rect(fill = NA, color = "black"), # panel border
        panel.grid.major = element_blank(), # panel major grid
        panel.grid.minor = element_blank() # panel minor grid
        )
    ## Settings of legend
    g <- g + theme(legend.position = 'none')
    g_list <- c(g_list, list(g))
}

g_all <- plot_grid(plotlist = g_list, nrow = 1)
pdfout <- paste(outname, "_enrichment_plot.pdf", sep = "")
ggsave(g_all, file = pdfout, width = 42, height = 7)

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

#overlap of demethylated probes(upset plot)(Fig. 4c)

#===================================================================================================
bed_list <- NULL
for( i in 2:6){
    bed <- dmr2bed(data_matrix = selDataMatrix, ControlColnum = 1, TreatmentColnum = i)
    bed_list <- c(bed_list, list(bed))
}
data <- lapply(bed_list, function(x){ x[, 4] })
names(data) <- c("Demet.0h_48h", "Demet.0h_54h", "Demet.0h_60h", "Demet.0h_66h", "Demet.0h_72h")

#upset plot
pdf("upset.pdf", width = 17.5, height = 7)
upset(fromList(data),
    sets = rev(names(data)),
    nsets = 5,
    order.by = "freq",
    set_size.show = TRUE,
    keep.order = TRUE,
    set_size.scale_max = 1000,
    sets.bar.color = rgb(0, 0.7, 0, alpha = 0.9)
)
dev.off()

#===================================================================================================
#
#methylation heatmap for uninheited demet probes (Supplementary Figure 5d)
#
#===================================================================================================
df <- selDataMatrix[rownames(selDataMatrix) %in% data[5], 1:6]
names(df) <- c("0 h", "48 h", "54 h", "60 h", "66 h", "72 h")

#heatmap
breaks <- seq(-2, 2, length = 500)
mycols <- colorRamp2(breaks, colorRampPalette(brewer.pal(9, "PuBu"))(500))
ht <- tcHeatmap(df, mycols = mycols, z = TRUE)

pdf("DE0_72_M_heatmap.pdf", width = 7, height = 10.5)
draw(ht)
dev.off()
#===================================================================================================

#enrichment plot for uninherited demethylated regions (Fig. 4d)

#===================================================================================================
#uninherited
uninherit_demet_list <- list(
    Demet.0h_48h = data[[1]],
    Demet.0h_54h = data[[2]][!(data[[2]] %in% unlist(data[1]))],
    Demet.0h_60h = data[[3]][!(data[[3]] %in% unlist(data[1:2]))],
    Demet.0h_66h = data[[4]][!(data[[4]] %in% unlist(data[1:3]))],
    Demet.0h_72h = data[[5]][!(data[[5]] %in% unlist(data[1:4]))],
)

outname <- "uninherited" #output file name

#motif pwm
motif_names <- "GATA6"
motifDBList <- IMAGE_PWMlist
motif <- motifDBList[grep(motif_names, names(motifDBList))]

#enrichment score computation
All_enrichments <- as.list(NULL) #List file to be input all nerichment scores
comp_names <- NULL #vector to be input comparison names
for(i in seq(length(uninherit_demet_list))){
    # loop of the computation by comarison
    comp_names <- c(
        comp_names,
        gsub("ui", "", names(uninherit_demet_list)[i])
    )

    #extraction of differentially methylated probe IDs
    DMP_IDs <- uninherit_demet_list[[i]]
    nDMP_IDs <- length(DMP_IDs)
    allProbe_IDs <- rownames(selDataMatrix)

    #Extraction of DMP positions and stratified sampling
    probe_annotation <- InfiniumDiffMetMotR::EPICanno

    target_position <- na.omit(probeID2position(probe_IDs = DMP_IDs, anno_info = probe_annotation)) #conversion of DMP IDs to position
    randomProbe_IDs <- stratSampling(target_IDs = DMP_IDs, anno_info = probe_annotation) #stratified sampling for negative control
    random_position <- na.omit(probeID2position(probe_IDs = randomProbe_IDs, anno_info = probe_annotation)) #conversion of NC probe IDs to position
    positionsList <- list("target" = target_position, "random" = random_position) #integrate DMP positoins and NC positions

    #Sequence extraction
    library("BSgenome.Hsapiens.UCSC.hg19")
    tmp <- ls(paste("package", "BSgenome.Hsapiens.UCSC.hg19", sep = ":"))
    genome <- eval(parse(text = tmp))

    seq_range <- c(-5000, 5000) #range from the CpG position to be extracted
    sequences <- lapply(positionsList, function(x){ seqExtract(positions = x, genome = genome, seq_range) })

    #Write splitted sequences
    tempDir <- paste(outname, "_temp", sep = "")
    dir.create(tempDir)

    seqs <- sequences$target
    target_all_filenames <- writeSplitSeq(seqs = seqs, split_num = 2500, tempDir = tempDir, output_file = "target")
    seqs <- sequences$random
    random_all_filenames <- writeSplitSeq(seqs = seqs, split_num = 2500, tempDir = tempDir, output_file = "random")
    rm(sequences)
    rm(seqs)
    invisible(replicate(3, gc()))

    #motif search
    target_positionsList <- splitSeqMotDist(filenames = target_all_filenames, motif_list = motif, min.score = min.score)
    file.remove(target_all_filenames)
    random_positionsList <- splitSeqMotDist(filenames = random_all_filenames, motif_list = motif, min.score = min.score)
    file.remove(random_all_filenames)

    #computation of enrichment score
    target_mot_posi <- unlist(target_positionsList)
    ctrl_mot_posi <- unlist(random_positionsList)

    #motif enrichment score
    enrichment_scores <- enrichScoreDist(
        target_mot_posi = target_mot_posi,
        ctrl_mot_posi = ctrl_mot_posi,
        seq_range = seq_range,
        motif_name = motif_names,
        nDMP_IDs = nDMP_IDs,
        outname = outname,
        plot_draw = FALSE
    )
    All_enrichments <- c(All_enrichments, list(enrichment_scores))

    file.remove(tempDir)
}

#Vidualization
ranks <- seq(seq_range[1], seq_range[2], length = 1001) # x-axis values
data <- sapply(All_enrichments, cbind)
rownames(data) <- ranks
colnames(data) <- comp_names

data.df <- as.data.frame(data)
data.df %>%
    mutate(Position = rownames(data.df)) %>%
    mutate_at(vars("Position"), as.integer) -> data.df

data.df2 <- tidyr::pivot_longer(data.df, cols = -Position, names_to = "comparison", values_to = "ES")

##ggplot
data_names <- names(uninherit_demet_list)

cols <- brewer.pal(6, "Dark2")
g_list <- NULL
for(i in seq(length(data_names))){
    data.df3 <- filter(data.df2, comparison == eval(data_names[i]))

    g <- ggplot(data.df3, aes(x = Position, y = ES, color = eval(cols[i])))
    g <- g + geom_line()
    g <- g + ylim(-0.1, 0.25)
    g <- g + xlab("Distance from CpG") # X-axis label
    g <- g + ylab("Enrichment Score") # Y-axis label
    g <- g + geom_hline(yintercept = 0) # wtire a horizontal line at intercept=0
    g <- g + geom_vline(xintercept = 0, color = "Gray51") # wtire a horizontal line at intercept=0
    g <- g + scale_colour_manual(values = c(cols[i]))
    ## Settings of axes
    g <- g + theme(
        axis.text.x = element_text(color = "black", size = 14), # X-axis texit setting
        axis.text.y = element_text(color = "black", size = 14), # Y-axis texit setting
        axis.ticks = element_line(color = "black", size = .5), # Setting of scale ticks line
        axis.title = element_text(color = "black", size = 14), # Setting of scale ticks texit
        panel.background = element_rect(fill = "white", color = NA), # panel background color
        panel.border = element_rect(fill = NA, color = "black"), # panel border
        panel.grid.major = element_blank(), # panel major grid
        panel.grid.minor = element_blank() # panel minor grid
        )
    ## Settings of legend
    g <- g + theme(legend.position = 'none')
    g_list <- c(g_list, list(g))
}

g_all <- plot_grid(plotlist = g_list, nrow = 1)
ggsave(g_all, file = "uninherited_enrichment_plot.pdf", width = 35, height = 7)

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

#  Enrichment heatmap
#
# 1. GATA6 ChIPmeantation (Fig. 4e)
# 2. ATAC-seq (Fig. 5b)

#===================================================================================================
#-------------------------------------------------
#bed file expoert
#-------------------------------------------------
extension <- c(0, 1)
ui.1_bed_list <- NULL
for(i in 2:6){
    ui.1_bed_list  <- c(
        ui.1_bed_list ,
        list(dmr2bed(
            data_matrix = selDataMatrix,
            ControlColnum = 1,
            TreatmentColnum = i,
            extension = extension
        ))
    )
}

names(ui.1_bed_list) <- c("Demet.0h_48h", "Demet.0h_54h", "Demet.0h_60h", "Demet.0h_66h", "Demet.0h_72h")

dmr.probeID <- lapply(ui.1_bed_list, function(x){ x[, 4] })

#uninherited
uninherit_demet_list <- list(
    Demet.0h_48h = ui.1_bed_list[[1]],
    Demet.0h_54h = ui.1_bed_list[[2]][!(dmr.probeID[[2]] %in% unlist(dmr.probeID[1])),],
    Demet.0h_60h = ui.1_bed_list[[3]][!(dmr.probeID[[3]] %in% unlist(dmr.probeID[1:2])),],
    Demet.0h_66h = ui.1_bed_list[[4]][!(dmr.probeID[[4]] %in% unlist(dmr.probeID[1:3])),],
    Demet.0h_72h = ui.1_bed_list[[5]][!(dmr.probeID[[5]] %in% unlist(dmr.probeID[1:4])),]
)

#export uninherited demet beds
dir.create("data/Methyl850_DE/bed_d1", recursive = TRUE)

for(j in 1:5){ write.table(
    x = uninherit_demet_list[[j]],
    file = paste0("data/Methyl850_DE/bed_d1/", names(uninherit_demet_list)[j], ".bed"),
    quote = FALSE,
    sep = "\t",
    row.names = FALSE,
    col.names = FALSE
)}

#-------------------------------------------------
#heatmap of GATA6 ChIPmentation
#-------------------------------------------------
bed_path <- "data/ethyl850_DE/d1/"
beds <- c("Demet.0h_48h.bed", "Demet.0h_54h.bed", "Demet.0h_60h.bed", "Demet.0h_66h.bed", "Demet.0h_72h.bed")

#bigwig files
bws_ch <- c("GATA6_0h.sorted.bw", "GATA6_48h.sorted.bw", "GATA6_54h.sorted.bw", "GATA6_60h.sorted.bw", "GATA6_66h.sorted.bw", "GATA6_72h.sorted.bw")
bws_ac <- c("atac_merged_0h.bw", "atac_merged_48h.bw", "atac_merged_54h.bw", "atac_merged_60h.bw", "atac_merged_66h.bw", "atac_merged_72h.bw")

titles <- c("0 h", "48 h", "54 h", "60 h", "66 h", "72 h")

hm_list_all_ChIP <- list()
hm_list_all_ATAC <- list()
for(k in seq(length(beds))){
    #ChIPmenatation
    hm_list_ChIP <- NULL
    for(l in seq(lHeatmapength(bws_ch))){
        hm_chip <- covHeatmap(
            target = paste0(bed_path, beds[k]),
            bw = paste0(bw_path, bws_ch[l]),
            add_profile = FALSE,
            heatmap_legend_param = list(title = titles[l], title_gp = gpar(fontsize = 12, fontfamily = "HersheySans")),
            column_title = titles[l],
            column_title_gp = gpar(fontsize = 12, fontfamily = "HersheySans")
            col = colorRamp2(c(0, 15), c("darkblue", "darkgoldenrod1"))
        )
        hm_list_ChIP <- c(hm_list_ChIP, list(hm_chip))
    }
    #integrate heatmaps of a same DMRs
    hm_list_ChIP_int <- hm_list_ChIP[[1]] +
        hm_list_ChIP[[2]] +
        hm_list_ChIP[[3]] +
        hm_list_ChIP[[4]] +
        hm_list_ChIP[[5]] +
        hm_list_ChIP[[6]]
    hm_list_all_ChIP <- c(hm_list_all_ChIP, list(hm_list_ChIP_int))

    #ATAC-seq
    hm_list_ATAC <- NULL
    for(m in seq(length(bws_ac))){
        hm_atac <- covHeatmap(
            target = paste0(bed_path, beds[k]),
            bw = paste0(bw_path, bws_ac[m]),
            add_profile = FALSE,
            heatmap_legend_param = list(title = titles[m], title_gp = gpar(fontsize = 12, fontfamily = "HersheySans")),
            column_title = titles[m],
            column_title_gp = gpar(fontsize = 12, fontfamily = "HersheySans"),
            cols = c("white", "red")
        )
        hm_list_ATAC <- c(hm_list_ATAC, list(hm_atac))
    }
    #integrate heatmaps of a same DMRs
    hm_list_ATAC_int <- hm_list_ATAC[[1]] +
        hm_list_ATAC[[2]] +
        hm_list_ATAC[[3]] +
        hm_list_ATAC[[4]] +
        hm_list_ATAC[[5]] +
        hm_list_ATAC[[6]]
    hm_list_all_ATAC <- c(hm_list_all_ATAC, list(hm_list_ATAC_int))
}

# integrated heatmaps of different DMRs
grab_list_ChIP <- lapply(hm_list_all_ChIP, function(x){grid.grabExpr(draw(x))})
grab_list_AtAC <- lapply(hm_list_all_ATAC, function(x){grid.grabExpr(draw(x))})

#plot
g_C <- plot_grid(plotlist = grab_list_ChIP, ncol = 1, align = "hv", axis =  "tblr")
g_ATAC <- plot_grid(plotlist = grab_list_ATAC, ncol = 1, align = "hv", axis =  "tblr")

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

#expression analysis for demet probes (Fig. 5a)

#===================================================================================================
#bed files of demethylated region
#used for ctss count (the ctss count data are stored in data/Methyl850_DE/exp_table)
extension <- c(-250, 250)
ui.250_bed_list <- NULL
for(i in 2:6){
    ui.250_bed <- dmr2bed(data_matrix = selDataMatrix, ControlColnum = 1, TreatmentColnum = i, extension = extension)
    ui.250_bed_list <- c(ui.250_bed_list, list(ui.250_bed))
}
names(ui.250_bed_list) <- c("DE_0.48", "DE_0.54", "DE_0.60", "DE_0.66", "DE_0.72")

dir.create("data/Methyl850_DE/bed_d500", recursive = TRUE)
for(i in seq(ncol(ui.250_bed_list))){
    write.table(
        ui.250_bed_list[[j]],
        file = paste0("data/Methyl850_DE/bed/", names(ui.250_bed_list)[j], ".bed"),
        quote = FALSE,
        sep = "\t",
        row.names = FALSE,
        col.names = FALSE
    )
}

#read the xpression tabels
data_dir <- "data/Methyl850_DE/exp_table"
files <- c(
    "iPS-DE_0.48_demethyl.TPM.txt",
    "iPS-DE_0.54_demethyl.TPM.txt",
    "iPS-DE_0.60_demethyl.TPM.txt",
    "iPS-DE_0.66_demethyl.TPM.txt",
    "iPS-DE_0.72_demethyl.TPM.txt"
)
sample_names <- sapply(files, function(x){ gsub(".TPM.txt", "", x) })

#expression table list
exp_list <- NULL
list_names <- NULL
for(i in seq(length(files))){
    exp_data <- read.table(
        file = paste0("data/Methyl850_DE/exp_table/", files[i]),
        header = TRUE,
        sep = "\t",
        stringsAsFactors = FALSE
    )
    #column reorder
    id_index <- 1
    reorder_index <- order(colnames(exp_data)[-id_index])
    exp_data2 <- cbind(probeID = exp_data[, id_index], exp_data[, - id_index][, reorder_index])

    #output list
    exp_list <- c(exp_list, list(exp_data2))
}
names(exp_list) <- sample_names

#mean and sd of rxpression
group_ids <- c("iPS_DE_00h","iPS_DE_48h","iPS_DE_54h","iPS_DE_60h","iPS_DE_66h","iPS_DE_72h")

mean_expMatrix_list <- NULL
sd_expMatrix_list <- NULL

for(i in seq(length(exp_list))){
    exp_table <- exp_list[[i]]
    ##compute mean of replicates
    mean_expMatrix <- NULL
    sd_expMatrix <- NULL

    for(j in seq(length(group_ids))){
        #mean
        mean_exp <- select(exp_table, starts_with(group_ids[j])) %>% rowMeans()
        mean_expMatrix <- cbind(mean_expMatrix, mean_exp)

        #sd
        sd_exp <- select(exp_table, starts_with(group_ids[j])) %>% apply(., 1, sd)
        sd_expMatrix <- cbind(sd_expMatrix, sd_exp)
    }

    colnames(mean_expMatrix) <- paste0(group_ids, "exp_mean")
    rownames(mean_expMatrix) <- exp_table$probeID
    mean_expMatrix_list <- c(mean_expMatrix_list, list(mean_expMatrix))

    colnames(sd_expMatrix) <- paste0(group_ids, "exp_sd")
    rownames(sd_expMatrix) <- exp_table$probeID
    sd_expMatrix_list <- c(sd_expMatrix_list, list(sd_expMatrix))
}

names(mean_expMatrix_list) <- sample_names
names(sd_expMatrix_list) <- sample_names

#Vidualization
g_list <- NULL
for(i in seq(length(mean_expMatrix_list))){
    df <- as.data.frame(mean_expMatrix_list[[i]])
    names(df) <- c(0, 48, 54, 60, 66, 72)

    g <- tcLinePlot(df = df, is.log = FALSE, color = "green4", fill = alpha("palegreen1", 0.4), y_limit = c(-30, 30))
    glist <- c(g_list, list(g))
}

g_all <- plot_grid(plotlist = g_list, nrow = 1)
ggsave(g_all, file = "mean.tpm_heatmap_demet.pdf", width = 42, height = 7)

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

#Functional Annotation of DMRs (Supplementary Figure 7a)

#===================================================================================================
#Processing of gencode gff3 file
filepath <- "data/Methyl850_DE/gencode.v19.gene_only.gff3"
gencode.gff <- readGFF(filepath, version = 1)
gencode.gr <- makeGRangesFromDataFrame(gencode.gff, keep.extra.columns = TRUE)

annotations <- strsplit(as.character(gencode.gr$group), ";")

gene_name <- sapply(annotations, function(x){
    gsub("gene_name=", "", x[6])
})

gencode.gr$gene_name <- gene_name

#Promoter extraction
upstream <- 1000
downstream <- 200
prom.gr <- promoters(gencode.gr, upstream = upstream, downstream = downstream)

#loading  enhances
eh.gr <- import("data/human_permissive_enhancers_phase_1_and_2.bed")

#count overlaps
Promoter <- NULL
Enhancer <- NULL
Both <- NULL
Unannotated <- NULL
for(i in seq(length(uninherit_demet_list))){
    prom_count <- countOverlaps(uninherit_demet_list[[i]], prom.gr)
    eh_count <- countOverlaps(uninherit_demet_list[[i]], eh.gr)

    nboth <- sum(prom_count != 0 & eh_count != 0)
    weight_both <- nboth / length(uninherit_demet_list[[i]])
    Both <- c(Both, weight_both)

    nprom <- sum(prom_count != 0) - nboth
    weight_prom <- nprom / length(uninherit_demet_list[[i]])
    Promoter <- c(Promoter, weight_prom)

    neh <- sum(eh_count != 0) - nboth
    weight_eh <- neh / length(uninherit_demet_list[[i]])
    Enhancer <- c(Enhancer, weight_eh)

    nunannotated <- length(uninherit_demet_list[[i]]) - nboth - nprom - neh
    weight_nunannotated <- 1 - weight_both - weight_prom - weight_eh
    Unannotated <- c(Unannotated, weight_nunannotated)
}
df <- data.frame(comp = names(uninherit_demet_list), Promoter, Enhancer, Unannotated)

#vidualization
theme <- theme(panel.background = element_blank(), # initialization
            panel.border = element_blank(),
            panel.grid.major = element_blank(),
            panel.grid.minor = element_blank(),
            strip.background = element_blank(),
            plot.title = element_text(size = 10, hjust = 0.5),
            axis.text.x = element_text(size = 10, angle = 90),
            axis.text.y = element_text(size = 10),
            axis.title.x = element_blank(),
            axis.title.y = element_text(size = 10),
            axis.ticks = element_line(size = 0.5),
            axis.line = element_line(size = 0.5),
            plot.margin = unit(c(1, 1, 1, 1), "line")
    )

df2 <- pivot_longer(df, col = -comp, names_to = "Annotation", values_to = "Proportion")
g <- ggplot(df2, aes(x = comp, y = Proportion, fill = Annotation))
g <- g + geom_bar(stat = "identity")
g <- g + scale_fill_manual(values = c("royalblue4", "royalblue1", "lightskyblue1"))
g <- g + theme
g

outprefix <- "annotation_proportion.pdf"
ggsave(plot = g, file = outprefix, width = 7, height = 7)


page_info = "edges_1_0025_edges" ; page_info_width=4000
page_info = "edges_test_d0p" ; page_info_width=1000
page_info = "edges_test_d1p" ; page_info_width=1000
page_info = "edges_test_d1p_a1p" ; page_info_width=1000
page_info = "t" ; page_info_width=1000

page_info_base = paste("~/git/innodb_ruby/", page_info, sep="")
p <- read.table(paste(page_info_base, ".page_info", sep=""), header=TRUE)

colors = c()
colors[1] = "black"
colors[p$index[1]+1] = "red"
colors[p$index[2]+1] = "green"
levels = c(46, 20, 20, 20, 20, 20, 20)

png(filename=paste(page_info_base, "_used.png", sep=""), width=page_info_width, height=800)
plot(p$data ~ p$page, pch=levels[p$level+1], xlab="page number", ylab="data per page", main=page_info, col=colors[p$index+1], xaxs="i", yaxp=c(0,16384,8), ylim=c(0,18000))
legend("topleft", c("PRIMARY", "unique_source_id_destination_id", "(unallocated pages)"), col=c("red", "green", "black"), pch=15)
dev.off()

png(filename=paste(page_info_base, "_free.png", sep=""), width=page_info_width, height=800)
plot(p$free ~ p$page, pch=levels[p$level+1], xlab="page number", ylab="free space per page", main=page_info, col=colors[p$index+1], xaxs="i", yaxp=c(0,16384,8), ylim=c(0,18000))
legend("topleft", c("PRIMARY", "unique_source_id_destination_id", "(unallocated pages)"), col=c("red", "green", "black"), pch=15)
dev.off()

png(filename=paste(page_info_base, "_cumulative_free.png", sep=""), width=page_info_width, height=800)
plot((cumsum(p$free)/1024^2) ~ p$page, xlab="page number", ylab="cumulative free space (MB)", main=page_info, col=colors[p$index+1], xaxs="i", pch=".", cex=4)
legend("topleft", c("PRIMARY", "unique_source_id_destination_id", "(unallocated pages)"), col=c("red", "green", "black"), pch=15)
dev.off()

h320 <- read.table("~/git/innodb_ruby/edges_1_0025_edges_320.histogram", header=FALSE)
h321 <- read.table("~/git/innodb_ruby/edges_1_0025_edges_321.histogram", header=FALSE)

png(filename="~/git/innodb_ruby/edges_1_0025_edges_hist.png", width=1600, height=800)
plot(h320$V2, h320$V1, type="s", ylab="number of pages (log scale)", xlab="data per page", log="y", ylim=c(1, 100000), xlim=c(0,16384), col="red")
lines(h321$V2, h321$V1, type="s", col="green")
legend("topleft", c("PRIMARY", "unique_source_id_destination_id"), col=c("red", "green"), pch=15)
dev.off()


library("ggplot2")

dns <- read.csv("output/dns_response_ttl/part-r-00000", header=F)

pdf(file="output/dns_response_ttl/plot.pdf")

ggplot(dns, aes(x=dns$V2, y=dns$V1)) + geom_point(shape=4)
qplot(x=dns$V2, stat='density', geom='line', ylab="Density")


install.packages(c('psych','dynlm'), repos = 'http://cran.us.r-project.org')


#devtools::test("asremlPlus")
context("model_selection3")
asr3.lib <- "D:\\Analyses\\R oldpkg"

cat("#### Test for changeTerms using wheat example with asreml3\n")
test_that("Wheatchange_asreml3", {
  skip_if_not_installed("asreml")
  skip_on_cran()
  library(dae)
  library(asreml, lib.loc = asr3.lib)
  library(asremlPlus)
  ## use asremlPlus to analyse the wheat (barley) example from section 8.6 of the asreml manual (Butler et al. 2010)
  data(Wheat.dat)
  #'## Add cubic trend to Row so that spline is not bound
  Wheat.dat <- within(Wheat.dat,
                      {
                        vRow <- as.numeric(Row)
                        vRow <- vRow - mean(unique(vRow))
                        yield <- yield + 10*vRow + 20 * (vRow^2) + 5 * (vRow^3)
                      })

  #Function to check with models have been changes
  chk.changes <- function(test.summary)
  {
    changes <- tail(test.summary[test.summary$action != "Boundary",], 1)
    changes <- unlist(lapply(c("fixed", "random", "residual"),
                             function(x, changes){grepl(x, changes, fixed = TRUE)},
                             changes = changes$action))
    return(changes)
  }

  # Fit initial model

  current.asr <- do.call("asreml",
                         args = list(yield ~ Rep + WithinColPairs + Variety,
                                     random = ~ Row + Column,
                                     rcov = ~ ar1(Row):ar1(Column),
                                     data=Wheat.dat))
  summary(current.asr)$varcomp
  current.asrt <- as.asrtests(current.asr, NULL, NULL)
  testthat::expect_equal(nrow(summary(current.asrt$asreml.obj)$varcomp), 5)
  testthat::expect_equal(nrow(current.asrt$wald.tab), 4)

  # Add and drop both fixed and random terms (No units term in model)
  current.asrt <- changeTerms(current.asrt, addFixed = "vRow", dropFixed = "WithinColPairs",
                              addRandom = "spl(vRow)", dropRandom = "units+Row",
                              checkboundaryonly = TRUE, data = Wheat.dat)
  testthat::expect_equal(sum(chk.changes(current.asrt$test.summary)), 2)
  testthat::expect_equal(nrow(summary(current.asrt$asreml.obj)$varcomp), 5)
  testthat::expect_equal(nrow(current.asrt$wald.tab), 4)

  # Drop all fixed terms
  current.asrt <- changeTerms(current.asrt, dropFixed = "Rep + Variety + vRow")
  print(summary(current.asrt$asreml.obj)$varcomp)
  print(current.asrt$wald.tab)
  testthat::expect_equal(sum(chk.changes(current.asrt$test.summary)), 1)
  testthat::expect_equal(nrow(summary(current.asrt$asreml.obj)$varcomp), 4)
  testthat::expect_equal(nrow(current.asrt$wald.tab), 1)

  # Add back fixed terms
  current.asrt <- changeTerms(current.asrt, addFixed = "Rep + Variety + vRow")
  testthat::expect_equal(sum(chk.changes(current.asrt$test.summary)), 1)
  testthat::expect_equal(nrow(summary(current.asrt$asreml.obj)$varcomp), 4)
  testthat::expect_equal(nrow(current.asrt$wald.tab), 4)

  # Restart with residual, remove it and then return it
  current.asr <- do.call("asreml",
                         args = list(yield ~ Rep + WithinColPairs + Variety,
                                     random = ~ Row + Column,
                                     rcov = ~ ar1(Row):ar1(Column),
                                     data=Wheat.dat))
  current.asrt <- as.asrtests(current.asr, NULL, NULL)
  current.asrt <- changeTerms(current.asrt, newResidual = "-(.)")
  testthat::expect_equal(sum(chk.changes(current.asrt$test.summary)), 1)
  testthat::expect_equal(nrow(summary(current.asrt$asreml.obj)$varcomp), 2)
  testthat::expect_equal(nrow(current.asrt$wald.tab), 4)
  current.asrt <- changeTerms(current.asrt, newResidual = "ar1(Row):ar1(Column)")
  testthat::expect_equal(sum(chk.changes(current.asrt$test.summary)), 1)
  testthat::expect_equal(nrow(summary(current.asrt$asreml.obj)$varcomp), 4)
  testthat::expect_equal(nrow(current.asrt$wald.tab), 4)

  # Restart with no random and add them back in
  current.asr <- do.call("asreml",
                         args = list(yield ~ Rep + WithinColPairs + Variety,
                                     rcov = ~ ar1(Row):ar1(Column),
                                     data=Wheat.dat))
  summary(current.asr)$varcomp
  current.asrt <- as.asrtests(current.asr, NULL, NULL)
  current.asrt <- changeTerms(current.asrt, addRandom = "Column")
  testthat::expect_equal(sum(chk.changes(current.asrt$test.summary)), 1)
  testthat::expect_equal(nrow(summary(current.asrt$asreml.obj)$varcomp), 3)
  testthat::expect_equal(nrow(current.asrt$wald.tab), 4)

  #Change residual with no random terms
  current.asrt <- as.asrtests(current.asr, NULL, NULL)
  current.asrt <- changeTerms(current.asrt,
                              newResidual = "Row:ar1(Column)",
                              label="Row autocorrelation")
  testthat::expect_equal(sum(chk.changes(current.asrt$test.summary)), 1)
  testthat::expect_equal(nrow(summary(current.asrt$asreml.obj)$varcomp), 2)
  testthat::expect_equal(nrow(current.asrt$wald.tab), 4)
})


chart_df <- reactiveValues(chart_df = data.frame(Data = "no"))
chart_df2 <- reactiveValues(chart_df2 = data.frame(Data = "No historical data to display"))

output$plotly_control_ui <- renderUI ({
	if(length(ticker_df$ticker_df[[3]]) > 1) {
		df1 <- data.frame(matrix(unlist(ticker_df$ticker_df[[3]]), nrow=length(ticker_df$ticker_df[[3]]), byrow=TRUE),stringsAsFactors=FALSE)
		colnames(df1) <- names(ticker_df$ticker_df[[3]][[1]])
		chart_df2$chart_df2 <- df1
		dateRangeInput("chart_dates", "Select Date Range", start = df1[1,10], end = df1[nrow(df1),10], min = df1[1,10], max = df1[nrow(df1),10])
	} else {
		HTML("No historical data to chart")
	}
})

output$plotly_control_ui2 <- renderUI ({
	if(length(ticker_df$ticker_df[[3]]) > 1) {
		checkboxGroupInput("plotly_options", label="Indicators", choices = c("volume", "ma5","ma10","ma20","ma60","Bollinger Bands"), selected = c("volume","ma20"), inline = TRUE)
	} else {
		HTML("")
	}
})

output$plotly_color <- renderUI ({
	if(length(ticker_df$ticker_df[[3]]) > 1) {
		colourInput("colo1", "Increase color", "forestgreen")
	} else {
		HTML("")
	}
})

output$plotly_color2 <- renderUI ({
	if(length(ticker_df$ticker_df[[3]]) > 1) {
		colourInput("colo2", "Decrease color", "red")
	} else {
		HTML("")
	}
})

observeEvent(input$chart_dates, {
	temp1 <- chart_df2$chart_df2[chart_df2$chart_df2[,10] >= input$chart_dates[1],]
	temp1 <- temp1[temp1[,10] <= input$chart_dates[2],]
	chart_df$chart_df <- temp1
})

output$plotly_chart_ui <- renderUI ({
	if(length(ticker_df$ticker_df[[3]]) > 1) {
		temp1 <- chart_df2$chart_df2[chart_df2$chart_df2[,10] >= input$chart_dates[1],]
		temp1 <- temp1[temp1[,10] <= input$chart_dates[2],]
		C <- as.numeric(chart_df2$chart_df2[,1])
		output$plotly_chart <- renderPlotly({
			colors <- c(input$colo2, input$colo1)
			df1 <- chart_df$chart_df
			price <- list(
				name = "price",
				text = "",
				type = "candlestick",
				x = df1[,10],
				low = df1[,3],
				high = df1[,2],
				open = df1[,4],
				close = df1[,1],
				decreasing = list(line = list(color = input$colo2)),
				increasing = list(line = list(color = input$colo1))
			)
			fig <- plot_ly()
			fig <- add_trace(fig, type=price$type, x=price$x, low=price$low, high=price$high, open=price$open, close=price$close, decreasing=price$decreasing, increasing=price$increasing)
			for(o in input$plotly_options) {
				if(o == "ma5") {
					ma5 <- SMA(x = C, n = 5)
					ma5 <- ma5[which(chart_df2$chart_df2[,10] >= input$chart_dates[1])]
					ma5 <- ma5[which(temp1[,10] <= input$chart_dates[2])]
					nal <- length(which(is.na(ma5)))
					nal <- nal + 1
					ma5 <- na.omit(ma5)
					trace1 <- list(
						line = list(
							dash = "solid",
							color = "blue",
							width = 1.3
						),
						mode = "lines",
						name = "MA5",
						text = "",
						type = "scatter",
						x = df1[nal:nrow(df1),10],
						y = ma5
					)
					fig <- add_trace(fig, line=trace1$line, mode=trace1$mode, name=trace1$name, text=trace1$text, type=trace1$type, x=trace1$x, y=trace1$y)
				}
				if(o == "ma10") {
					ma10 <- SMA(x = C, n = 10)
					ma10 <- ma10[which(chart_df2$chart_df2[,10] >= input$chart_dates[1])]
					ma10 <- ma10[which(temp1[,10] <= input$chart_dates[2])]
					nal <- length(which(is.na(ma10)))
					nal <- nal + 1
					ma10 <- na.omit(ma10)
					trace2 <- list(
						line = list(
							dash = "solid",
							color = "black",
							width = 1.3
						),
						mode = "lines",
						name = "MA10",
						text = "",
						type = "scatter",
						x = df1[nal:nrow(df1),10],
						y = ma10
					)
					fig <- add_trace(fig, line=trace2$line, mode=trace2$mode, name=trace2$name, text=trace2$text, type=trace2$type, x=trace2$x, y=trace2$y)
				}
				if(o == "ma20") {
					ma20 <- SMA(x = C, n = 20)
					ma20 <- ma20[which(chart_df2$chart_df2[,10] >= input$chart_dates[1])]
					ma20 <- ma20[which(temp1[,10] <= input$chart_dates[2])]
					nal <- length(which(is.na(ma20)))
					nal <- nal + 1
					ma20 <- na.omit(ma20)
					trace3 <- list(
						line = list(
							dash = "solid",
							color = "red",
							width = 1.3
						),
						mode = "lines",
						name = "MA20",
						text = "",
						type = "scatter",
						x = df1[nal:nrow(df1),10],
						y = ma20
					)
					fig <- add_trace(fig, line=trace3$line, mode=trace3$mode, name=trace3$name, text=trace3$text, type=trace3$type, x=trace3$x, y=trace3$y)
				}
				if(o == "ma60") {
					ma60 <- SMA(x = C, n = 60)
					ma60 <- ma60[which(chart_df2$chart_df2[,10] >= input$chart_dates[1])]
					ma60 <- ma60[which(temp1[,10] <= input$chart_dates[2])]
					nal <- length(which(is.na(ma60)))
					nal <- nal + 1
					ma60 <- na.omit(ma60)
					trace4 <- list(
						line = list(
							dash = "solid",
							color = "green",
							width = 1.3
						),
						mode = "lines",
						name = "MA60",
						text = "",
						type = "scatter",
						x = df1[nal:nrow(df1),10],
						y = ma60
					)
					fig <- add_trace(fig, line=trace4$line, mode=trace4$mode, name=trace4$name, text=trace4$text, type=trace4$type, x=trace4$x, y=trace4$y)
				}
				if(o == "Bollinger Bands") {
					HLC <- cbind(as.numeric(chart_df2$chart_df2[,2]), as.numeric(chart_df2$chart_df2[,3]), as.numeric(chart_df2$chart_df2[,1]))
					BB <- BBands(HLC = HLC)
					BB <- BB[which(chart_df2$chart_df2[,10] >= input$chart_dates[1]),]
					BB <- BB[which(temp1[,10] <= input$chart_dates[2]),]
					nal <- length(which(is.na(BB[,1])))
					nal <- nal + 1
					BB <- na.omit(BB)
					lower <- list(
						line = list(
							dash = "dash",
							color = "black",
							width = 1.3
						),
						mode = "lines",
						name = "Bollinger Band",
						text = "",
						type = "scatter",
						x = df1[nal:nrow(df1),10],
						y = BB[,1]
					)
					upper <- list(
						line = list(
							dash = "dash",
							color = "black",
							width = 1.3
						),
						mode = "lines",
						name = "Bollinger Band",
						text = "",
						type = "scatter",
						x = df1[nal:nrow(df1),10],
						y = BB[,3]
					)
					ma <- list(
						line = list(
							dash = "dash",
							color = "red",
							width = 1.3
						),
						mode = "lines",
						name = "Bollinger Band",
						text = "",
						type = "scatter",
						x = df1[nal:nrow(df1),10],
						y = BB[,2]
					)
					fig <- add_trace(fig, line=upper$line, mode=upper$mode, name=upper$name, text=upper$text, type=upper$type, x=upper$x, y=upper$y)
					fig <- add_trace(fig, line=lower$line, mode=lower$mode, name=lower$name, text=lower$text, type=lower$type, x=lower$x, y=lower$y)
					fig <- add_trace(fig, line=ma$line, mode=ma$mode, name=ma$name, text=ma$text, type=ma$type, x=ma$x, y=ma$y)
				}
			}
			fig <- fig %>% layout(showlegend = FALSE, yaxis = list(title = "Price"), plot_bgcolor="#f5f5f5", paper_bgcolor="#f5f5f5", xaxis = list(rangeslider = list(visible = F)))
				if(any(input$plotly_options == "volume")) {
				fig2 <- df1
				fig2 <- fig2 %>% plot_ly(x=~date, y=~volume, type='bar', name = "Volume", color = ~close > open, colors = colors)
				fig2 <- fig2 %>% layout(showlegend = FALSE, yaxis = list(title = "Volume"), plot_bgcolor="#f5f5f5", paper_bgcolor="#f5f5f5")
				fig <- subplot(fig, fig2, heights = c(0.7, 0.2), nrows=2, shareX = TRUE, titleY = TRUE, titleX=FALSE)
			}
			return(fig)
		})
		plotlyOutput("plotly_chart")
	} else {
		HTML("No historical data to chart")
	}
})

chart_data_table <- reactiveValues(chart_data_table = data.frame(Data = "No historical data to display"))

update_table_chart <- function() {
	if(length(ticker_df$ticker_df[[3]]) > 1) {
		df1 <- data.frame(matrix(unlist(ticker_df$ticker_df[[3]]), nrow=length(ticker_df$ticker_df[[3]]), byrow=TRUE),stringsAsFactors=FALSE)
		colnames(df1) <- names(ticker_df$ticker_df[[3]][[1]])
		chart_data_table$chart_data_table <- df1
		colnames(chart_data_table$chart_data_table) <- colnames(df1)
	} else {
		chart_data_table$chart_data_table <- data.frame(Data = "No historical data to display")
	}
}

output$chart_table <- DT::renderDataTable ({
	DT::datatable(chart_data_table$chart_data_table, extensions = 'Buttons', options = list(dom = "Blfrtip", buttons = list("copy", list(extend = "collection", buttons = c("csv","excel","pdf"), text = "Download")), lengthMenu = c(5,10,15,20,25,50,100,nrow(chart_data_table$chart_data_table)), pageLength = 15, scrollX=TRUE), rowname = FALSE)
})


#source('D:/ICDM11/mygit/Kalpit/editors_mnthly_edits.r')
rm(list = setdiff(ls(),c('DATADIR','RESDIR','MAIN_DIR')))

NE = 44514
t0 = strptime("2001-01-01 0:0:0", "%Y-%m-%d %H:%M:%S");
te = strptime("2010-09-01 0:0:0", "%Y-%m-%d %H:%M:%S");
NM = 116
Mlen = as.numeric((te-t0)/NM)

A <- scan(paste(RESDIR,'edit_times_unrounded.csv',sep=''),'character');
stopifnot(length(A) == NE)

MatAll <- matrix(0,NE,NM+1)
MatUnq <- matrix(0,NE,NM+1)

fsdt = read.csv(paste(RESDIR,'eid_fsdt_regdate_table.csv',sep=''), header = TRUE);

for (ia in 1:NE){

	if (ia%%2000 == 0) {cat(sprintf("Parsed %i of %i editors",ia,NE),"\n")}

	MatAll[ia,1] = fsdt[ia,1]
	MatUnq[ia,1] = fsdt[ia,1]

	splita <- as.numeric(strsplit(A[ia],",",fixed=T)[[1]])
	for (m in 1:NM){
		winst = (m-1)*Mlen
		winen = winst + Mlen
		iwithin = (splita > winst & splita <= winen)
		MatAll[ia,m+1] = sum(iwithin)
		if (MatAll[ia,m+1] > 0){
			MatUnq[ia,m+1] = sum(diff(sort(splita[iwithin])) > 0.5) + 1
		}
	}
}
cat(sprintf("Writing tables into CSV files..."),"\n")
colnames(MatAll) = c("user_id",seq(1,NM,1));
colnames(MatUnq) = c("user_id",seq(1,NM,1));

# write(t(MatAll),paste(RESDIR,'editor_monthly_edits_unrounded.csv',sep=''),ncolumns = dim(MatAll)[2],sep = ",")
# write(t(MatUnq),paste(RESDIR,'editor_monthly_edits_unique_sessions_unrounded.csv',sep=''),ncolumns = dim(MatUnq)[2],sep = ",")
write.csv(MatAll, file=paste(RESDIR,'editor_monthly_edits_unrounded.csv',sep=''),row.names=F)
write.csv(MatUnq, file=paste(RESDIR,'editor_monthly_edits_unique_sessions_unrounded.csv',sep=''),row.names=F)

alarm()


REBOL [
    Title: "rowsets - Tests"
    Version: 1.0.0
    Rights: {
        Copyright 2017 Brett Handley
    }
    License: {
        Licensed under the Apache License, Version 2.0
        See: http://www.apache.org/licenses/LICENSE-2.0
    }
    Author: "Brett Handley"
    Purpose: {Testing.}
]

script-needs [
    %requirements.r
    %../rowsets.r
]

players: [
    words [name score]
    rows [
        [{Tom}   4]
        [{Dick}  9]
        [{Harry} 7]
    ]
]

requirements 'rowset [

    [{Select}
        players = rowset/query [
			select * from x players
		]
    ]

    [{Where}
        result: rowset/query [
			select * where [score = 7] from x players
		]
        all [
            1 = length? result/rows
            result/rows/1/1 = {Harry}
        ]
    ]

    [{Join}
		result: rowset/query [
			select [
				w: x/name
				l: y/name
				s: x/score * 10
			]
			join [
				x/score < y/score
				x/name <> y/name
			]
			from x players
			from y players
		]
        all [
            [w l s] = result/words
            3 = length? result/rows
        ]
    ]

    [{Simple series}
		result: rowset/query [
			select [x: x + 10]
			from-series s [x y] [1 2 3 4 5 6]
		]
        all [
            [x] = result/words
            3 = length? result/rows
        ]
    ]

]


#' R colors and their names
#'
#' Show a PDF with all R colors and their names for reference.
#' @export
#'
#' @examples
#' colorList()
colorList <- function(){
  require(colorRamps, quietly=T)

  dstpdf <- file.path(tempdir(),'colorlist.pdf')
  pdf(dstpdf,width=14.57, height=8.2, onefile=TRUE)

  kol <- colors()
  kol <- kol[!grepl('grey',kol)]

  rows = 50
  cols = 11
  m      <- matrix(1:(rows*cols), nc=cols, nr=rows, byrow=F)

  kol <- c(rep(NA,rows*cols - length(kol)), kol)

  transm   <- t(m)[,rows:1]
  transkol <- kol[order(t(transm))]
  txtcolor <- ifelse(colMeans(col2rgb(transkol))<100, "white", "black")

  op     <- par(mar=c(0,0,0,0))
  image(1:cols, 1:rows, transm, col=kol, axes=FALSE, ann=FALSE)
  text(as.numeric(col(m)), as.numeric(row(m)), transkol, cex=.7, col=txtcolor, adj=c(0.5,0.5))
  par(op)

  dev.off()
  browseURL(dstpdf)
}


    # -----------------------------------------------------------------------------
    # PROJECT:
    #    Evaluating the structure of the communities of the estuary
    #    and gulf of St.Lawrence
    # -----------------------------------------------------------------------------

    # -----------------------------------------------------------------------------
    # STEP:
    #   2. Tanimoto analysis for multiple parameter values
    # -----------------------------------------------------------------------------

    # Evaluating the contribution of the catalog vs the predictions to the algorithm

    # -----------------------------------------------------------------------------
    # FILES:
    #   RData <- file = "RData/Tanimoto_analysis.RData" XXX adjust name with type of analysis
    #   Script  <- file = "Script/2-1-Tanomoto_analysis.r"
    # -----------------------------------------------------------------------------

    # -----------------------------------------------------------------------------
    # PARAMETERS:
        filename <- 'Catalog_vs_predictions'
        min.tx = 45
        K.values = 8
        MW = 1
        WT = seq(0,1,by=0.1)
        blind = FALSE
        minimum_threshold = 0.3
    # -----------------------------------------------------------------------------

    # -----------------------------------------------------------------------------
    # SCRIPT
    # -----------------------------------------------------------------------------
    load("./RData/Tanimoto_data.RData")
    load("./RData/interactions_source.RData")
    suppressMessages(load("./RData/Similarity.matrices.RData")) # For similarity matrices already evaluated

    # S0: A large set of species and their preys, with column structure ['taxon', 'taxonomy', 'resource', 'non-resource']
    # Format interaction catalogue to fit this table format
        S0_catalog <- matrix(nrow = nrow(Tanimoto_data[[1]]), ncol = 4, data = "", dimnames = list(Tanimoto_data[[1]][, 'taxon'], c('taxon', 'taxonomy', 'resource', 'non-resource')))
        S0_catalog[, 1] <- Tanimoto_data[[1]][, 'taxon']
        S0_catalog[, 2] <- Tanimoto_data[[1]][, 'kingdom | phylum | class | order | family | genus | species']
        # From binary interactions catalogue with consumer, resources, interaction or non-interaction
        for(k in 1:nrow(Tanimoto_data[[3]])) {
            S0_catalog[Tanimoto_data[[3]][k, 'consumer'], 3] <- Tanimoto_data[[3]][k, 'resource']
            S0_catalog[Tanimoto_data[[3]][k, 'consumer'], 4] <- Tanimoto_data[[3]][k, 'non-resource']
        }

    # setting up the analyses for multiple communities
    # Data for communities on which to test the algorithm
        Cm <- unique(interactions_sources[, 'source'])
        communities <- vector("list", length(Cm))
        names(communities) <- Cm

        # Taxa list per community to predict
            for(i in 1:length(communities)) {
                Ci <- which(interactions_sources[, 'source'] == Cm[i])
                S1 <- unique(c(interactions_sources[Ci, 'consumer'], interactions_sources[Ci, 'resource']))

                if(length(which(!S1 %in% S0_catalog)) > 0) {
                    print('Taxa in C[i] are not all included in taxa list S0')
                    break
                }

                communities[[i]] <- S1
            }

    # Substracting GloBI interactions for this portion
        Cm.lg <- numeric()
        for(i in 1:length(communities)) {
            Cm.lg <- c(Cm.lg,length(communities[[i]]))
        }

        to.delete <- c(which(Cm.lg < min.tx), which(Cm.lg > 1000)) # > 1000 is for GloBI

        Cm <- Cm[-to.delete]
        for(i in rev(to.delete)) {
            communities[[i]] <- NULL
        }
        names(communities) <- Cm

    # Setting up lists to store the results
        wt.init <- seq(0,1,by=0.1)
        wt.remove <- which(!wt.init %in% WT)# selecting a subset of similarity matrices
        for(i in rev(wt.remove)) {
            similarity.matrices[[i]] <- NULL
        }

        sim.wt <- names(similarity.matrices)
        Tanimoto_analysis <- vector("list",length(sim.wt))
        names(Tanimoto_analysis) <- sim.wt
        for(i in 1:length(sim.wt)) {
            Tanimoto_analysis[[i]] <- vector("list", length(Cm))
            names(Tanimoto_analysis[[i]]) <- Cm
        }

    # List to store results of multiple K values
    K <- vector("list", length(K.values))
    for(i in 1:length(K.values)) {
        K[[i]] <- Tanimoto_analysis
    }
    Tanimoto_analysis <- K
    names(Tanimoto_analysis) <- K.values
    remove(K)

    min.wt <- vector("list", length(MW))
    for(i in 1:length(MW)) {
        min.wt[[i]] <- Tanimoto_analysis
    }
    Tanimoto_analysis <- min.wt
    names(Tanimoto_analysis) <- MW
    remove(min.wt)

    file.to.save <- serialNext("./Analyses/Tanimoto_temp/Tanimoto_analysis.RData")
    save(x = Tanimoto_analysis, file = file.to.save)

    init.time <- Sys.time()
    for(n in 1:length(MW)) {
        mw <- MW[n]
        for(m in 1:length(K.values)) {

            # Tanimoto analysis with different weights for different communities
                # Parameters:
                    Kc <- K.values[m]  # Integer, how many neighbors to select for consumers
                    Kr <-  K.values[m]  # Integer, how many neighbors to select for resources
                    # MW = minimum_weight  # Mimimum weight to accept a candidate as a prey
                #   wt  Weight of traits in similarity measurement
                #   S0  A large set of species and their preys, with column structure ['taxon', 'taxonomy', 'resource', 'non-resource']
                #   S1  The subset of S0 where we want to predict new preys, string vector with taxa name

                # Output:
                #   A vector of sets of resources for each taxon

                for(i in 1:length(WT)){ #1st loop for all types of wt values
                    wt <- WT[i]
                    pb <- txtProgressBar(min = 0,max = length(Cm), style = 3)

                    for(j in 1:length(Cm)) { #2nd loop for all C[i]
                        S1 <- communities[[j]]
                        S0 <- S0_catalog
                        similarity.matrix <- similarity.matrices[[i]]

                        # Two choices here:
                        #   1. The analysis is blind, which means we remove all the information available in the catalogue for all species in S1
                        #   2. The analysis takes into account preexisting information already contained in the catalogue

                        # 1. Blind analysis, removing all information on taxa in S1 from S0 (rownames need to == taxa name)
                        if(blind == TRUE) {
                            for(k in 1:length(S1)) {
                              S0[S1[k], 'resource'] <- ""
                              S0[S1[k], 'non-resource'] <- ""
                            }

                        # 2. Preexisting information kept to inform algorithm
                        } else { # blind == FALSE

                            interactions <- interactions_sources[-which(interactions_sources[, 'source'] == Cm[j]), 1:3]

                            # Only modifying those that are loosing data from the catalogue, less time
                                to.change <- numeric()
                                for(k in 1:length(S1)) {
                                    to.change <- c(to.change, which(interactions[, 'consumer'] == S1[k]), which(interactions[, 'resource'] == S1[k]))
                                }
                                to.change <- unique(to.change)

                            # Modifying sets of resources and non-resources for taxa in S1
                                interactions <- interactions[to.change, ]
                                rownames(interactions) <- seq(1,nrow(interactions))
                                resource_set <- consumer_set_of_resource(consumer = interactions[, 'consumer'],
                                                                          resource = interactions[, 'resource'],
                                                                          inter_type = interactions[, 'inter'])

                            # From binary interactions catalogue with consumer, resources, interaction or non-interaction (rownames need to == taxa name)
                                for(k in 1:nrow(resource_set)) {
                                  S0[resource_set[k, 'consumer'], 3] <- resource_set[k, 'resource']
                                  S0[resource_set[k, 'consumer'], 4] <- resource_set[k, 'non-resource']
                                }
                            remove(interactions, resource_set, to.change)
                        } #if blind or not blind

                        # Recalculate similarity
                            similarity.matrix <- similarity_taxon_predict(S0 = S0,
                                                                                S1 = S1,
                                                                                wt = wt,
                                                                                similarity.matrix = similarity.matrix)

                        # Predicting interactions
                            Tanimoto_analysis[[n]][[m]][[i]][[j]] <- two_way_tanimoto_predict(Kc = Kc,
                                                                                Kr = Kr,
                                                                                S0 = S0,
                                                                                S1 = S1,
                                                                                MW = mw,
                                                                                similarity.matrix = similarity.matrix,
                                                                                minimum_threshold = minimum_threshold)

                        save(x = Tanimoto_analysis, file = file.to.save)
                        remove(S0, S1, similarity.matrix)
                        setTxtProgressBar(pb, j)
                    }#2nd loop for all C[i]

                    save(x = Tanimoto_analysis, file = file.to.save)
                    remove(wt)

                }#1st loop for all types of wt values
                close(pb)
        }#m
    }#n
    print(Sys.time() - init.time)

# Catalog vs predictions
    accuracy  <- vector('list', 3)
    names(accuracy) <- c('Catalog', 'Predict', 'Algorithm')
    accuracy[[1]] <- tanimoto_accuracy(Tanimoto_analysis = Tanimoto_analysis, empirical.only = TRUE)
    accuracy[[2]] <- tanimoto_accuracy(Tanimoto_analysis = Tanimoto_analysis, predict.only = TRUE)
    accuracy[[3]] <- tanimoto_accuracy(Tanimoto_analysis = Tanimoto_analysis)

#Figure
    pdf("./Article/Catalog_vs_predictions.pdf",width=7,height=7)
    # Plots
    par(mfrow=c(2,2))
    # Graph
    for(j in 9:12) {
            eplot(xmin = -0.09, xmax = 1.09)
            par(pch = 21,  xaxs = "i", yaxs = "i", family = "serif")
            foodwebs <- names(Tanimoto_analysis[[1]][[1]][[1]])
            names <- c('TSS','Score y', 'Score -y', 'Accuracy score')
            col <- c("#FF8822","#449955","#2288FF")
            # col <- c("#FF000088","#00FF0088","#0000FF88")
            # col <- gray.colors(11, start = 0, end = 0.8, gamma = 2.2, alpha = NULL) # grey scale ramp
            # col <- sample(colours(), length(foodwebs))

            # Axes
                # rect(0, 0, 1, 1, col = "#eeeeee", border = NA)
                axis(side = 1, at = seq(0, 1, by = 0.2), labels = seq(0, 1, by = 0.2), las = 1, pos = -0.02)
                axis(side = 2, at = seq(0, 1, by = 0.2), labels = seq(0, 1, by = 0.2), las = 1, pos = -0.02)
                axis(side = 3, at = seq(0, 1, by = 0.2), labels = seq(0, 1, by = 0.2), las = 1, pos = 1.02)
                axis(side = 4, at = seq(0, 1, by = 0.2), labels = seq(0, 1, by = 0.2), las = 1, pos = 1.02)
                # abline(v = seq(0,6,by = 2), col = "white", lty = 2)
                # abline(h = seq(1,2,by = 1), col = "white", lty = 2)

                mtext(text = names[j-8], side = 2, line = 2, at = 0.5, font = 2, cex = 1)
                mtext(text = "Similarity weight", side = 1, line = 2, at = 0.5, font = 2, cex = 1)

            for(i in 1:length(accuracy)) {
                accuracy_mean <- aggregate(as.numeric(accuracy[[i]][,j]) ~ as.numeric(accuracy[[i]][, 'wt']), data=accuracy[[i]], FUN=function(x) c(mean=mean(x), sd=sd(x)))
                # hack: we draw arrows but with very special "arrowheads" for error bars
                arrows(accuracy_mean[, 1], accuracy_mean[, 2][,1] - accuracy_mean[, 2][, 2], accuracy_mean[, 1], accuracy_mean[, 2][, 1] + accuracy_mean[, 2][, 2], length=0.05, angle=90, code=3, col = col[i])
                points(x = accuracy_mean[, 1], y = accuracy_mean[, 2][, 1], cex = 1.5, pch = 22, col = col[i])
            } #i

            ## Add legend
            if(j == 12) {
                legend(0.45, 0.3, lwd = 3, col = col, legend = names(accuracy), bty = 'n', y.intersp = 1)
            }
    } #j
    dev.off()

save(x = Tanimoto_analysis, file = paste('./Analyses/',filename,'.RData',sep=''))


library("ggplot2")
setwd("~/dev/BitFunnel/build-ninja/") # TODO: make path general.
df <- read.csv(header=TRUE, file="sum.csv")

png(filename="true-matches.png",width=1600,height=1200)
ggplot(df, aes(TermPos,TruePositives)) +
    geom_point(alpha=1/5) +
    theme_bw() +
    theme(axis.text = element_text(size=40),
          axis.title = element_text(size=40))
dev.off()

png(filename="false-rate.png",width=1600,height=1200)
ggplot(df, aes(TermPos,FalseRate)) +
    geom_point(alpha=1/100) +
    theme_bw() +
    theme(axis.text = element_text(size=40),
          axis.title = element_text(size=40))
dev.off()

png(filename="false-matches.png",width=1600,height=1200)
ggplot(df, aes(TermPos,FalsePositives)) +
    geom_point(alpha=1/5) +
    theme_bw() +
    theme(axis.text = element_text(size=40),
          axis.title = element_text(size=40))
dev.off()


# example
a = 2;
b <- 3;

mySecFun<-function(v,M)
{
    u=c(0,0,0,0);
    for(i in 1:length(v))
    {
      if (i == 1) {
        u[i]=myFirstFun(v[i]);
        }
        else  {
            u[i]=mySecondFun(v[i])+2;
            u[i+1]=myThirdFun(v[i]);
        }
    }
    return(u);
}

Sqv=mySecFun(v);
Sqv;


##
## wealth rank by zhu/not
##
# source("data functions/reproductive success - load data.r")
source("init.r")
library(tidyverse)

# summarise
wealths = hh %>%
  group_by(WealthRank, zhubo1) %>%
  dplyr::summarise(count=n())

# calc proportions
wealths$prop = wealths$count / ifelse(wealths$zhubo1==1, sum(subset(wealths, zhubo1==1)$count), sum(subset(wealths, zhubo1==0)$count))

ggplot(wealths, aes(x=factor(WealthRank), y=prop, fill=factor(zhubo1))) +
  # geom_bar(aes(fill=factor(zhubo1)), position="dodge", binwidth=1, stat = "identity") +
  geom_bar(aes(fill=factor(zhubo1)), position="dodge", stat = "identity") +

  # scale_x_discrete(labels=c("Poorest", "", "", "", "", "Richest")) +

  scale_fill_manual(values = wes_palette("Chevalier")) +
  xlab("Wealth rank") +
  ylab("Proportion of households") +

  theme_bw() +
  #eliminates baground, gridlines, and chart border
  theme(
    plot.background = element_blank()
    ,panel.grid.major = element_blank()
    ,panel.grid.minor = element_blank()
    ,panel.border = element_blank()
    ,panel.background = element_blank()
    # ,axis.text.x = element_blank()
    # ,axis.text.y = element_blank()
  ) + theme(axis.line = element_line(color = 'black')) +
  # hide legend
  theme(legend.position="none")

# ggsave(filename="witches - household wealth.pdf", width=150, height=100, units="mm")
ggsave(filename="witches - household wealth.png", width=150, height=100, units="mm")


# ==============================
# Graphs and tables of simulation results - Original data (population and strata level)
# Nuno Prista, SLU Aqua, 2019 @ KustMonitoring project
# ==============================

rm(list=ls()); graphics.off()

library(data.table)

# select site
	site<-"Asköfjärden" # sites in c("Asköfjärden", "Galtfjärden","Gaviksfjärden","Holmön","Kinnbäcksfjärden","Kvädöfjärden_Warm","Lagnö","Långvindsfjärden","Norrbyn", "Råneå","Torhamn")

# select scenario
	scenario <- "AllocOrigin" # "AllocScenarioWhitefishN" # "AllocScenarioHerringN", "AllocOrigin"

# option for Swedish captions
	sve=TRUE

# table spp conversion eng to sve
	spp_name_conv<-data.frame(eng = c('CodN','CyprinidsB','CyprinidsN','FlounderN','HerringN','PerchB','PerchN','PikeN','PikeperchN','PiscivoresN','WhitefishN'),
			sve = c('TorskN','CypriniderB','CypriniderN','SkrubbskäddaN','StrömmingN','AbborreB','AbborreN','GäddaN','GösN','PiscivorerN','SikN'))

for (site in c("Asköfjärden", "Norrbyn","Kvädöfjärden_Warm", "Galtfjärden","Gaviksfjärden","Holmön","Kinnbäcksfjärden","Lagnö","Långvindsfjärden","Råneå","Torhamn")
{

	# loads original data
		dir_inputs<-"001_Inputs/prepared_main/"
		load(file=paste("001_Inputs/prepared_main/",site,".Rdata",sep=""))

	# loads simulations
		dir_sim_outputs <- paste("002_Sim_Outputs/",scenario,"/prepared/",sep="")
		load(file=paste(dir_sim_outputs, site, "_", scenario,"_5000sims_res_pop_prep.rdata", sep=""))
		load(file=paste(dir_sim_outputs, site, "_", scenario,"_5000sims_res_strata_prep.rdata", sep=""))

# ====================
# Present ("true") estimates: Plot of Bootstrap CIs
# ====================

	# ===================
	# Population level
	# ===================

		dir_graph <- paste("003_Results/005_Origin_estimates_with_cis/",scenario,"/",sep=""); dir.create(dir_graph, showWarnings = FALSE)

		if(sve==TRUE) {boot_res_pop$variable<-spp_name_conv$sve[match(boot_res_pop$variable, spp_name_conv$eng)]
						target_vars<-spp_name_conv$sve[match(target_vars, spp_name_conv$eng)]
						}

		for (target_var in target_vars)
		{
		print(target_var)

			# subsets
			b<-boot_res_pop[variable==target_var,list(Year, SampSize, true_mean, true_clow_mean, true_chigh_mean, boot_mean, bootlow_aprox, boothigh_aprox, bootlow_perc, boothigh_perc)]
			b$id<-as.integer(as.character(b$Year))

			# graphs
				if(sum(!is.na(b$true_mean))>0) ylimite <- c(min(c(b$bootlow_perc), na.rm=T), max(c(b$boothigh_perc), na.rm=T)*1.3)
					windows(7,5)
					if(sve==TRUE) {
						if(site=="Kvädöfjärden_Warm") site2 <- "Kvädöfjärden" else site2 <- site
						tit<-paste(site2, target_var)
								} else {tit<-paste(site, target_var)}
					plot(b$boothigh_perc~b$id, type="n", ylim=ylimite, ylab="Indikatorvärde", xlab="", las=2, main=tit, xlim=c(min(boot_res_pop$Year), max(boot_res_pop$Year)+1), cex.axis=1.2, cex.lab=1.2)
				counter<-0
				for(sampsize in c("N"))
				{
					print(sampsize)
					a<-b[SampSize==sampsize,]

					if(sum(!is.na(a$true_mean))>0)
					{

					#inside_ids <- a[as.numeric(eval(paste(true_mean))) %between% list(clow_mean, chigh_mean),]$id
					#outside_ids <- a$id[!a$id %in% inside_ids]

					segments(x0 = a$id+counter, y0 = a$bootlow_perc, x1 = a$id+counter, y1 = a$boothigh_perc, col="blue", lwd=2)
					#points(a$boot_mean~c(a$id+counter), col="red", pch=19, cex=0.8)
					points(a$boot_mean~c(a$id+counter), col="blue", pch=19, cex=0.8)
					points(a$true_mean~c(a$id+counter), col="black", pch=4, cex=0.8)
					counter <- counter+0.08
					} else print(".no data")
				}

				legend("topright", legend=c("bootstrap medelvärde","uppmätt medelvärde","bootstrap konfidensintervall"), lty=c(0,0,1), lwd = c(0,0,2), col=c("blue","black","blue"), pch=c(19, 4, -1),cex=0.9)
			# save plot
				if(sve==TRUE) {
						savePlot(paste(dir_graph, paste(site, target_var, scenario, sep="_"), "_N_sve.png", sep=""), type="png")
							} else	{savePlot(paste(dir_graph, paste(site, target_var, scenario, sep="_"), "_N.png", sep=""), type="png")}

			# save bootstrap results
				if(sve==TRUE) {
							write.csv2(b, file=paste(dir_graph, paste(site, target_var, scenario, sep="_"), "_N_sve.csv", sep=""), row.names=FALSE)
								} else	{write.csv2(b, file=paste(dir_graph, paste(site, target_var, scenario, sep="_"), "_N.csv", sep=""), row.names=FALSE)}
				}
		graphics.off()

	# ===================
	# Strata level	[single graph]
	# ===================

		dir_graph <- paste("003_Results/005_Origin_estimates_with_cis/",scenario,"/",sep=""); dir.create(dir_graph, showWarnings = FALSE)

		if(sve==TRUE) {boot_res_strata$variable<-spp_name_conv$sve[match(boot_res_strata$variable, spp_name_conv$eng)]
						#target_vars<-spp_name_conv$sve[match(target_vars, spp_name_conv$eng)]
						}

		for (target_var in target_vars)
		{
		print(target_var)
			# subsets
			b<-boot_res_strata[variable==target_var,list(Year, SampSize, stratum, true_mean, true_clow_mean, true_chigh_mean, boot_mean, bootlow_aprox, boothigh_aprox, bootlow_perc, boothigh_perc)]
			b$id<-as.numeric(as.character(b$Year))

			# graphs
				if(sum(!is.na(b$true_mean))>0) ylimite <- c(min(c(b$bootlow_perc), na.rm=T), max(c(b$boothigh_perc), na.rm=T)*1.4)
					windows(7,5)
					if(sve==TRUE) {
						if(site=="Kvädöfjärden_Warm") site2 <- "Kvädöfjärden" else site2 <- site
						tit<-paste(site2, target_var)
								} else {tit<-paste(site, target_var)}
					plot(b$boothigh_perc~b$id, type="n", ylim=ylimite, ylab="Indikatorvärde", xlab="", las=2, main=tit, xlim=c(min(boot_res_pop$Year), max(boot_res_pop$Year)+1), cex.axis=1.2, cex.lab=1.2)
				for(sampsize in c("N"))
				{
					print(sampsize)
					b1<-b[SampSize==sampsize,]
						counter<-0
						for (stratum1 in unique(b1$stratum))
						{
						print(stratum1)
						a <- b1[stratum==stratum1,]
						# defines colours
						if(stratum1=="0-3m") color<-"black"
						if(stratum1=="3-6m") color<-"darkgreen"
						if(stratum1=="6-10m") color<-"blue"
						if(stratum1=="10-20m") color<-"brown"

						if(sum(!is.na(a$true_mean))>0)
						{

						#inside_ids <- a[as.numeric(eval(paste(true_mean))) %between% list(clow_mean, chigh_mean),]$id
						#outside_ids <- a$id[!a$id %in% inside_ids]

						segments(x0 = a$id+counter, y0 = a$bootlow_perc, x1 = a$id+counter, y1 = a$boothigh_perc, col=color, lwd=2)
						points(a$boot_mean~c(a$id+counter), col="black", pch=21, cex=0.7, bg=color)
						points(a$true_mean~c(a$id+counter), col="black", pch=4, cex=0.7)
						counter <- counter+0.1
						print(counter)
						} else print(".no data")
						}

				# save bootstrap results
					b1$id<-NULL
					if(sve==TRUE) {
					write.csv2(b1, file=paste(dir_graph, paste(site, target_var, scenario, sep="_"), "_N_strata_sve.csv", sep=""), row.names=FALSE)
								} else { write.csv2(b1, file=paste(dir_graph, paste(site, target_var, scenario, sep="_"), "_N_strata.csv", sep=""), row.names=FALSE)}

				}

				legend("topright", ncol=2, legend=c("bootstrap_medelvärde","uppmätt medelvärde","","","0-3m","3-6m","6-10m","10-20m"), lty=c(0,0,0,0,1,1,1,1), lwd = c(0,0,0,0,2,2,2,2), col=c("black","black","white","white","black","darkgreen", "blue","brown"), pch=c(1, 4, -1,-1,-1, -1, -1, -1),cex=0.8)

				# save plot
					if(sve==TRUE) {
						savePlot(paste(dir_graph, paste(site, target_var, scenario, sep="_"), "_N_strata_1_sve.png", sep=""), type="png")
							} else	{savePlot(paste(dir_graph, paste(site, target_var, scenario, sep="_"), "_N_strata_1.png", sep=""), type="png")}

		}
		graphics.off()
}

	# ===================
	# Strata level	[panel with 4 graphs]
	# ===================

		dir_graph <- paste("003_Results/005_Origin_estimates_with_cis/",scenario,"/",sep=""); dir.create(dir_graph, showWarnings = FALSE)

		for (target_var in target_vars)
		{
		print(target_var)

			# subsets
			b<-boot_res_strata[variable==target_var,list(Year, SampSize, stratum, true_mean, true_clow_mean, true_chigh_mean, boot_mean, bootlow_aprox, boothigh_aprox, bootlow_perc, boothigh_perc)]
			b$id<-as.numeric(as.character(b$Year))

			# graphs
			if(sum(!is.na(b$true_mean))>0) ylimite <- c(min(c(b$bootlow_perc), na.rm=T), max(c(b$boothigh_perc), na.rm=T))
				windows(15,10); par(mfrow=c(2,2))
			for(sampsize in c("N"))
			{
				print(sampsize)
				b1<-b[SampSize==sampsize,]
					for (stratum1 in unique(b1$stratum))
					{
					print(stratum1)
					a <- b1[stratum==stratum1,]
					# defines colours
					color<-"blue"

					if(sum(!is.na(a$true_mean))>0)
					{
					plot(a$boothigh_perc~a$id, type="n", ylim=ylimite, ylab="indicator value", xlab="year", las=2, main=paste(site, target_var, stratum1), xlim=c(min(boot_res_pop$Year), max(boot_res_pop$Year)+1))
					segments(x0 = a$id+counter, y0 = a$bootlow_perc, x1 = a$id+counter, y1 = a$boothigh_perc, col=color)
					points(a$boot_mean~c(a$id+counter), col="red", pch=17, cex=0.5)
					points(a$true_mean~c(a$id+counter), col="black", pch=4, cex=0.5)
					legend("topright", legend=c("bootstrap_sample_mean","true_sample_mean", "boot_ci_perc"), lty=c(0,0,1), col=c("red","black","blue"), pch=c(19, 4, -1),cex=0.5)
					print(counter)
					} else print(".no data")
					}
			}

			# save plot
				savePlot(paste(dir_graph, paste(site, target_var, scenario, sep="_"), "_N_strata_2.png", sep=""), type="png")
		}

		graphics.off()


##############
############# DO Synthesis Report
############

############
###########  Chapter 2
#########

setwd("C:/Users/jrinde/OneDrive - California Department of Water Resources/DO Modification/Synthesis/Csv files")
library("ggplot2")
library("ggthemes")
library(cowplot)
theme_set(theme_bw())

CM = read.csv(file = "CM.RRI.data.csv")
head(CM)

#subset by station
CM40<- subset(CM, station== "CM40")
CM42<- subset(CM, station== "CM42")
CM43<- subset(CM, station== "CM43")
CM48<- subset(CM, station== "CM48")
RRI<- subset(CM, station== "CM42_RRI")

CM$column_new<-factor(CM$season, levels=c('Summer', 'Fall'))
new<-CM$column_new

## Jenna make/share code to calculate excursions in R for the "percent.exceed.csv

#now with the season order changed make plot
DO.ex = read.csv(file = "percent.exceed.csv")
DO.ex

summer.ex <- subset(DO.ex, season != "fall")
head(summer.ex)
fall.ex <- subset(DO.ex, season != "summer")

summer.explot <- ggplot(data=summer.ex, aes(x=station, y=percent, fill=station, shape=as.factor(station))) + geom_bar(stat="identity") + facet_wrap(~year) + ggtitle("Summer") + theme(legend.position = "none") + labs(y="DO Excursion (%)", x = "Station") + ylim(0,70)
summer.explot

fall.explot <- ggplot(data=fall.ex, aes(x=station, y=percent, fill=station, shape=as.factor(station))) + geom_bar(stat="identity") + facet_wrap(~year) + ggtitle("Fall") + theme(legend.position = "none") + labs(y="DO Excursion (%)", x = "Station") + ylim(0,70)
fall.explot

plot_grid(summer.explot, fall.explot)

#DO Stats
#compute stats for DO study
#output: .csv containing stats
#questions: sarah.perry@water.ca.gov

#import packages
library(tidyverse)
library(lubridate)

#import files
dfRRI <- read_csv('CM.RRI.data.csv')

#round dates
dfRRI$date.time <- mdy_hm(dfRRI$date.time) #convert to datetime object
dfRRI$Date <- format(as.Date(dfRRI$date.time, format = '%m/%d/%Y %H:%m:%s'), '%m/%d/%Y') #date col without time
dfRRI$date.time <- floor_date(dfRRI$date.time, '15 minutes')

#add season col
dfRRI <- dfRRI %>%
  mutate(Season =
           case_when(
             month == 3 | month == 4 | month == 5 ~ 'Spring',
             month == 6 | month == 7 | month == 8 ~ 'Summer',
             month == 9 | month == 10 | month == 11 ~ 'Fall',
             month == 12 | month == 1 | month == 2 ~ 'Winter'
           )
  )

#subset out DO
dfRRI_DO <- subset(dfRRI, select = c(station, day, month, year, Date, Season, DO))

#add summary stats by day
dfRRI_DayStats <- dfRRI_DO %>%
  group_by(station, day, month, year, Date) %>%
  summarise(
    Mean = mean(DO, na.rm = TRUE),
    Median = median(DO, na.rm = TRUE),
    `Std Dev` = sd(DO, na.rm = TRUE),
    Max = max(DO, na.rm = TRUE),
    Min = min(DO, na.rm = TRUE),
    `Number of Datapoints` = n())

#cleaup data
dfRRI_DayStats <- dfRRI_DayStats %>% arrange(station, year, month)
dfRRI_DayStats <- subset(dfRRI_DayStats, select = -c(month, year, day))
dfRRI_DayStats$`Std Dev`[is.nan(dfRRI_DayStats$`Std Dev`)] <- NA
dfRRI_DayStats$Mean[is.nan(dfRRI_DayStats$Mean)] <- NA
dfRRI_DayStats$Median[is.nan(dfRRI_DayStats$Median)] <- NA
dfRRI_DayStats$Max[is.infinite(dfRRI_DayStats$Max)] <- NA
dfRRI_DayStats$Min[is.infinite(dfRRI_DayStats$Min)] <- NA

#write file
write_csv(dfRRI_DayStats, 'C:/DOStudy/DO.Daily.Med.csv')

#****NOTE
#in excel added a new column to showr year
#see if Sarah P can show me how to add it in, also make station to Station with a capitol

#Boxplots with Daily Medians

CM.med = read.csv(file = "DO.Daily.Med.csv")

fall <- subset(CM.med, Season != "Summer")
summer <- subset(CM.med, Season != "Fall")

med.sum.box<-ggplot(summer, aes(x=station, y=Median, fill=station, shape=as.factor(station))) +
  geom_boxplot(aes(fill=factor(station))) + facet_wrap(~Year) + ggtitle("Summer Daily Median") + theme(legend.position = "none") + scale_y_continuous(limits = c(2,12), breaks=c(2,4,6,8,10,12)) + labs(y="Dissolved Oxygen (mg/L)", x = "Station") + geom_hline(yintercept=5, linetype="dashed", color = "red")

med.sum.box

med.fall.box<-ggplot(fall, aes(x=station, y=Median, fill=station, shape=as.factor(station))) +
  geom_boxplot(aes(fill=factor(station))) + facet_wrap(~Year) + ggtitle("Fall Daily Median") + theme(legend.position = "none") + scale_y_continuous(limits = c(2,12), breaks=c(2,4,6,8,10,12)) + labs(y="Dissolved Oxygen (mg/L)", x = "Station") + geom_hline(yintercept=6, linetype="dashed", color = "red")

med.fall.box

# Subset by year

summer <- subset(CM.med, Season != "Fall")
sum.2007 <- subset(summer, Year=="2007")
sum.2008 <- subset(summer, Year=="2008")
sum.2009 <- subset(summer, Year=="2009")
sum.2010 <- subset(summer, Year=="2010")

fall <- subset(CM.med, Season != "Summer")
fall.2007 <- subset(fall, Year=="2007")
fall.2008 <- subset(fall, Year=="2008")
fall.2009 <- subset(fall, Year=="2009")
fall.2010 <- subset(fall, Year=="2010")

#Summer comparisons
kruskal.test(Median~station, data = sum.2007)
pairwise.wilcox.test(sum.2007$Median, sum.2007$station, p.adjust.method = "BH")

kruskal.test(Median~station, data = sum.2008)
pairwise.wilcox.test(sum.2008$Median, sum.2008$station, p.adjust.method = "BH")

kruskal.test(Median~station, data = sum.2009)
pairwise.wilcox.test(sum.2009$Median, sum.2009$station, p.adjust.method = "BH")

kruskal.test(Median~station, data = sum.2010)
pairwise.wilcox.test(sum.2010$Median, sum.2010$station, p.adjust.method = "BH")

#Fall comparisons
kruskal.test(Median~station, data = fall.2007)
pairwise.wilcox.test(fall.2007$Median, fall.2007$station, p.adjust.method = "BH")

kruskal.test(Median~station, data = fall.2008)
pairwise.wilcox.test(fall.2008$Median, fall.2008$station, p.adjust.method = "BH")

kruskal.test(Median~station, data = fall.2009)
pairwise.wilcox.test(fall.2009$Median, fall.2009$station, p.adjust.method = "BH")

kruskal.test(Median~station, data = fall.2010)
pairwise.wilcox.test(fall.2010$Median, fall.2010$station, p.adjust.method = "BH")

####Section 3, compare CM40 to RRI
#~~~Import Data~~~#
#import packages
library('tidyverse')
library('readxl')
library('lubridate')

#~~~Variables to Edit~~~#
mainPath <- 'C:/R/DO Check/' #new csv's will be saved to here

fileName <- 'CM.RRI.data.csv' #name of data file
#~~~~~~~~~~~~~~~~~~#
#~~~Read In Data~~~#
#~~~~~~~~~~~~~~~~~~#
#data filepath
filePath <- paste(mainPath,fileName,sep = '')

#data filepath
doDatRaw <- read_csv(filePath)

#drop qual column
keepVars <- c('station','date.time','year','season','DO')
doDat <- doDatRaw[keepVars]

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
#~~~Calculate % Under Threshold~~~#
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
#grab lists of variables
stations <- unique(doDat$station)
seasons <- unique(doDat$season)
years <- unique(doDat$year)

#initiate empty df
underDf <- NULL

#initiate for loops
for (stat in stations) { #this a for loop, it goes through the list of stations
  for (sea in seasons) { #before moving to next station, goes through list of seasons
    for (yr in years) { #before going to next season, goes through list of years

      #create name for saving
      name <- paste(stat,sea,yr,sep = '')

      #create filtered df (overwritten during each iteration of the nested for loop)
      df <-
        doDat %>%
        filter(station == stat &
                 season == sea &
                 year == yr &
                 !is.na(DO))

      #assign threshold based on fall/summer
      if (grepl('Fall',name)) { #based on if fall is in the variable 'name'
        threshold <- 6
      } else {
        threshold <- 5
      }

      #do the calculation
      countBelow <- nrow(df[df['DO'] < threshold,]) #comma tells it to call rows, not columns
      countTotal <- nrow(df)
      perUnder <- round(countBelow/(countTotal)*100,2)

      #bind row to output df
      underDf <- rbind(underDf, data.frame('station' = name, 'percent under threshold' = perUnder))
    }
  }
}

#create output file path
underPath <- paste(mainPath,'percentUnder.csv',sep = '')

#append output df to text file
write.table(
  underDf,
  underPath,
  sep = ',',
  col.names = TRUE,
  row.names = FALSE,
  quote = FALSE)

```{r}
#~~~~~~~~~~~~~~~~~~~~~~#
#~~~Compare Stations~~~#
#~~~~~~~~~~~~~~~~~~~~~~#
#initiate empty df
compDf <- NULL

for (sea in seasons) {
  for (yr in years) {
    #create name for saving
    name <- paste(sea,yr,sep = '')

    #create filtered dfs
    dfFourty <-
      doDat %>%
      filter(station == 'CM40' &
               season == sea &
               year == yr &
               !is.na(DO))

    dfRRI <-
      doDat %>%
      filter(station == 'CM44_RRI' &
               season == sea &
               year == yr &
               !is.na(DO))

    #change dates columns to type(datetime) (or whatevs R uses :/) and round to nearest 15min
    dfFourty$date.time <- parse_date_time(dfFourty$date.time,'mdy HM')
    dfFourty$date.time <- round_date(dfFourty$date.time, '15 minutes')

    #same, but for RRI, accounting for the fact that in '07 it was collected hourly
    if (yr == '2007') {
      dfRRI$date.time <- parse_date_time(dfRRI$date.time,'mdy HM')
      dfRRI$date.time <- round_date(dfRRI$date.time, '1 hour')
    } else {
      dfRRI$date.time <- parse_date_time(dfRRI$date.time,'mdy HM')
      dfRRI$date.time <- round_date(dfRRI$date.time, '15 minutes')
    }

    #assign threshold based on fall/summer
    if (grepl('Fall',name)) {
      threshold <- 6
    } else {
      threshold <- 5
    }

    #merge the two dfs
    dfMerge <- merge(dfFourty,dfRRI,by = c('season','year','date.time'))

    #initalize counts
    doBoth <- 0
    doRRI <- 0
    doFourty <- 0

    #start for loop (element-wise :/)
    for (i in 1:nrow(dfMerge)) {
      #populate the count variables
      if ((dfMerge[i,]['DO.x'][[1]] < threshold) && (dfMerge[i,]['DO.y'][[1]] < threshold)) {
        doBoth = doBoth + 1
      } else if ((dfMerge[i,]['DO.x'][[1]] < threshold) && (dfMerge[i,]['DO.y'][[1]] >= threshold)) {
        doFourty = doFourty + 1
      } else if ((dfMerge[i,]['DO.x'][[1]] >= threshold) && (dfMerge[i,]['DO.y'][[1]] < threshold)) {
        doRRI = doRRI + 1
      }

    }

    #calculate percents
    calcBoth <- round(doBoth/nrow(dfMerge) * 100,2)
    calcFourty <- round(doFourty/nrow(dfMerge) * 100,2)
    calcRRI <- round(doRRI/nrow(dfMerge) * 100,2)

    #bind rows to output df
    compDf <-
      rbind(
        compDf,
        data.frame(
          'time period' = name,
          'both under threshold' = calcBoth,
          'fourty under threshold' = calcFourty,
          'RRI under threshold' = calcRRI))

  }
}

#create output file path
compPath <- paste(mainPath,'percentCompare.csv',sep = '')

#append output df to text file
write.table(
  compDf,
  compPath,
  sep = ',',
  col.names = TRUE,
  row.names = FALSE,
  quote = FALSE)

#Bar Plot with percentcompare.csv

setwd("C:/Users/jrinde/OneDrive - California Department of Water Resources/DO Modification/Synthesis/Csv files")
library("ggplot2")
library("ggthemes")
theme_set(theme_bw())

compare = read.csv(file = "percent.compare.csv")
head(compare)

compare.plot <- ggplot(data=compare, aes(x=station, y=percent, fill=station, shape=as.factor(order))) + geom_bar(stat="identity") + facet_wrap(~season) + ggtitle("Summer") + theme(legend.position = "none") + labs(y="Dissolved Oxygen (%)", x = "Station") + ylim(0,50)
compare.plot


#Variance decomposition plots.
rm(list=ls())
source('paths.r')

#set output path.----
output.path <- 'test.png'
output.path <- NEON_ddirch_var.decomp_cosmo_figure.path

#load data.----
d <- readRDS(NEON_ddirch_var.decomp_cosmo.path)

core <- d$core_decomp
plot <- d$plot_decomp
site <- d$site_decomp

fungi_names <- colnames(d$core_decomp)
fungi_names <- fungi_names[!(fungi_names %in% ('other'))]
scale_names <- c('core-level','plot-level','site-level')

#setup output spec.----
png(filename=output.path,width=10,height=14,units='in',res=300)

#Loop plots over species/scale.----
par(oma = c(2, 8,2,2))
par(mar = c(rep(2.5,4)))
par(mfrow = c(7,3))
for(k in 1:length(fungi_names)){
  for(i in 1:length(d)){
    to_plot <- d[[i]][,fungi_names[k]]
    to_plot <- to_plot[-1]
    to_title <- paste0(fungi_names[k],' ',scale_names[i])
    if(i == 1){
      x <- barplot(to_plot, col = 'grey50', space = 1,  las = 2, main = to_title, horiz = T, xlab = NA, xlim = c(0,1.05))
    }
    if(i != 1){
      x <- barplot(to_plot, col = 'grey50', space = 1,  las = 2, main = to_title, horiz = T, yaxt='n', xlim = c(0,1.05))
    }

  }
}

#end plot.----
dev.off()


con <- url("http://www.cis.jhu.edu/~parky/MRN/cci.txt")
cci <- scan(con)
close(con)
cci

con <- url("http://www.cis.jhu.edu/~parky/MRN/fibergraph.Rbin")
load(con)
close(con)
(m <- length(fibergraph.list))


library(rstan)
library(data.table)
library(lubridate)
library(gdata)
library(dplyr)
library(tidyr)
library(EnvStats)
library(scales)
library(stringr)
library(abind)
library(scales)
library(zoo)
library(matrixStats)
library(optparse)

source("usa/code/utils/process-covariates.r")

simulate_scenarios <- function(JOBID, StanModel, scenario_type,
                               len_forecast = 0, subdir='usa', simulate_code='usa/code/stan-models/simulate-regional-state.stan',
                               mobility_vars, mobility_vars_partial_regional=mobility_vars, mobility_vars_partial_state=mobility_vars,
                               mobility_increases = 20, ext = ".png"){

  for (mobility_increase in mobility_increases){
    load(paste0(subdir, '/results/', StanModel, '-', JOBID, '-stanfit.Rdata'))

    old_dates <- dates
    print(sprintf("Simulating %s days from %s with a %s%% increase in mobility", len_forecast, max(old_dates[[1]]), mobility_increase))
    total_sim<- stan_data$N2 + len_forecast
    N3=total_sim-stan_data$N2
    # adjust SI
    stan_data$SI <- c(stan_data$SI,rep(stan_data$SI[stan_data$N2],N3))
    # adjust f
    stan_data$f2 <- matrix(NA, nrow=total_sim, ncol=dim(stan_data$f)[2])
    for(i in 1:dim(stan_data$f)[2]){
      stan_data$f2[,i] <- c(stan_data$f[,i],rep(stan_data$f[stan_data$N2,i],N3))
    }

    for(i in 1:length(dates)){
      dates_tmp = as.Date(dates[[i]],format='%Y-%m-%d')
      new_dates = dates_tmp[length(dates_tmp)]
      how_many_days = total_sim-length(dates[[i]])
      pad_dates <- new_dates + days(1:how_many_days)
      dates_tmp  =c(dates_tmp, pad_dates)
      dates[[i]] = dates_tmp
    }
    for(i in 1:length(reported_cases)){
      how_many_days = total_sim-length(reported_cases[[i]])
      reported_cases[[i]] = c(reported_cases[[i]],rep(0,how_many_days))
    }
    for(i in 1:length(reported_deaths)){
      how_many_days = total_sim-length(reported_deaths[[i]])
      reported_deaths[[i]] = c(reported_deaths[[i]],rep(0,how_many_days))
    }

    stan_data$X2<-array(NA,c(dim(stan_data$X)[1], total_sim,dim(stan_data$X)[3]))
    for(i in 1:dim(stan_data$X)[1]){
      for(j in 1:dim(stan_data$X)[3]){
        if (j %in% mobility_vars){
          last7 = stan_data$X[i,(stan_data$N[i]-7):stan_data$N[i],j]
          remaining = dim(stan_data$X2)[2] - length(stan_data$X[i,1:stan_data$N[i],j])
          scenario = rep(last7*((100-mobility_increase)/100), ceiling(remaining/7))[1:remaining]
          stan_data$X2[i,,j] = c(stan_data$X[i,1:stan_data$N[i],j], scenario)
        } else {
          last7 = stan_data$X[i,(stan_data$N[i]-7):stan_data$N[i],j]
          remaining = dim(stan_data$X2)[2] - length(stan_data$X[i,1:stan_data$N[i],j])
          scenario = rep(last7, ceiling(remaining/7))[1:remaining]
          stan_data$X2[i,,j] = c(stan_data$X[i,1:stan_data$N[i],j], scenario)
        }
      }
    }

    stan_data$X2_partial_regional <-array(NA,c(dim(stan_data$X_partial_regional)[1], total_sim,dim(stan_data$X_partial_regional)[3]))
    for(i in 1:dim(stan_data$X_partial_regional)[1]){
      for(j in 1:dim(stan_data$X_partial_regional)[3]){
        if (j %in% mobility_vars_partial_regional){
          last7 = stan_data$X_partial_regional[i,(stan_data$N[i]-7):stan_data$N[i],j]
          remaining = dim(stan_data$X2_partial_regional)[2] - length(stan_data$X_partial_regional[i,1:stan_data$N[i],j])
          scenario = rep(last7*((100-mobility_increase)/100), ceiling(remaining/7))[1:remaining]
          stan_data$X2_partial_regional[i,,j] = c(stan_data$X_partial_regional[i,1:stan_data$N[i],j], scenario)
        } else {
          last7 = stan_data$X_partial_regional[i,(stan_data$N[i]-7):stan_data$N[i],j]
          remaining = dim(stan_data$X2_partial_regional)[2] - length(stan_data$X_partial_regional[i,1:stan_data$N[i],j])
          scenario = rep(last7, ceiling(remaining/7))[1:remaining]
          stan_data$X2_partial_regional[i,,j] = c(stan_data$X_partial_regional[i,1:stan_data$N[i],j], scenario)
        }

      }
    }

    stan_data$X2_partial_state <-array(NA,c(dim(stan_data$X_partial_state)[1], total_sim,dim(stan_data$X_partial_state)[3]))
    for(i in 1:dim(stan_data$X_partial_state)[1]){
      for(j in 1:dim(stan_data$X_partial_state)[3]){
        if (j %in% mobility_vars_partial_regional){
          last7 = stan_data$X_partial_state[i,(stan_data$N[i]-7):stan_data$N[i],j]
          remaining = dim(stan_data$X2_partial_state)[2] - length(stan_data$X_partial_state[i,1:stan_data$N[i],j])
          scenario = rep(last7*((100-mobility_increase)/100), ceiling(remaining/7))[1:remaining]
          stan_data$X2_partial_state[i,,j] = c(stan_data$X_partial_state[i,1:stan_data$N[i],j], scenario)
        } else {
          last7 = stan_data$X_partial_state[i,(stan_data$N[i]-7):stan_data$N[i],j]
          remaining = dim(stan_data$X2_partial_state)[2] - length(stan_data$X_partial_state[i,1:stan_data$N[i],j])
          scenario = rep(last7, ceiling(remaining/7))[1:remaining]
          stan_data$X2_partial_state[i,,j] = c(stan_data$X_partial_state[i,1:stan_data$N[i],j], scenario)
        }

      }
    }

    # update stan_data
    stan_data$N2 = total_sim
    stan_data$X = stan_data$X2
    stan_data$X_partial_regional = stan_data$X2_partial_regional
    stan_data$X_partial_state = stan_data$X2_partial_state
    stan_data$f = stan_data$f2

    if(!is.null(stan_data$week_index)) {
      stan_data$week_index2 = matrix(0,nrow(stan_data$week_index),total_sim)
      stan_data$week_index2[1:nrow(stan_data$week_index),1:ncol(stan_data$week_index)] = stan_data$week_index
      # AR week index setup
      for(state.i in 1:stan_data$M) {
        # find the week_index for today (stan_data$N[state.i]) and carry that forward to the end
        stan_data$week_index2[state.i,stan_data$N[state.i]:total_sim] = stan_data$week_index[state.i,stan_data$N[state.i]]
      }
      stan_data$week_index = stan_data$week_index2
    }

    m2 <- stan_model(simulate_code)

    fit <- gqs(m2, data=stan_data, draws = as.matrix(fit))

    out <- rstan::extract(fit)
    estimated_cases_raw <- out$prediction
    estimated_deaths_raw <- out$E_deaths
    estimated_deaths_cf <- out$E_deaths0

    print(paste0("saving: ", subdir,'/results/sim-', StanModel,'-', len_forecast, '-', mobility_increase,
                 '-',JOBID,'-standata.Rdata'))
    save(fit, dates, reported_cases, reported_deaths, states,
         estimated_cases_raw, estimated_deaths_raw, estimated_deaths_cf, out,
         file=paste0(subdir,'/results/sim-',StanModel,'-',len_forecast, '-', mobility_increase, '-', JOBID,'-stanfit.Rdata'))

  }

}


fn main (){
   let y = 4;
   let x = |x:i32| x + y;
   assert_eq!(x(5),9);
}


a = readline(prompt="Digite a: ")
b = readline(prompt="Digite b: ")
soma = as.integer(a) + as.integer(b)
sprintf("Soma: %d", soma)


#' Read MODFLOW .wel File
#'
#' This function reads in a wel file and creates a list
#' composed of the following vectors:
#' \describe{
#' \item{TEXT}{is a character variable (199 characters) that starts in column 2 of the .wel file. Any characters can be included in Text.
#' The “#” character is in column 1. Text is written to the Listing File.}
#' \item{PARAMETER}{The optional items NPWEL and MXL (below) must start with the word "PARAMETER"}
#' \item{NPWEL}{is the number of well parameters}
#' \item{MXL}{is the maximum number of wells that will be defined using parameters}
#' \item{MXACTW}{is the maximum number of wells in use during any stress period, including those that are defined using parameters}
#' \item{IWELCB}{is a flag and a unit number.
#' If IWELCB > 0, cell-by-cell flow terms will be written to this unit number when "SAVE BUDGET" or a nonzero
#' value for ICBCFL is specified in Output Control.
#' If IWELCB = 0, cell-by-cell flow terms will not be written.
#' If IWELCB < 0, well recharge for each well will be written to the listing file when "SAVE BUDGET" or a nonzero
#' value for ICBCFL is specified in Output Control}
#' \item{Option}{is an optional list of character values.
#' “AUXILIARY abc” or “AUX abc”—defines an auxiliary variable, named "abc", which will be read for each
#' well as part of Items 4 and 6. Up to 20 variables can be specified, each of which must be preceded by
#' "AUXILIARY" or "AUX." These variables will not be used by the Ground-Water Flow Process, but they
#' will be available for use by other processes. The auxiliary variable values will be read after the Q variable.
#' “NOPRINT”—specifies that lists of wells will not be written to the Listing File.}
#' \item{WELL}{A dataframe consisting of columns of Stress-Period (SP), Layer (LAY), Row (ROW), Column (COL), Pumping Rate (Q), and
#' auxilliary variable (xyz) for each well cell and each stress-period}
#' }
#' @param rootname This is the root name of the dis file
#' @param NSP This is the number of stress periods in the model simulation that will be listed in the well file
#' @export
#' @examples
#' readwl("F10")
#' $TEXT
#' [1] "# MODFLOW2000 Well Package"
#'
#' $PARAMETER
#' [1] "PARAMETER"
#'
#' $NPWEL
#' [1] 0
#'
#' $MXL
#' [1] 0
#'
#' $Option
#' [1] "   AUX IFACE"
#'
#' $MXACTW
#' [1] 105
#'
#' $IWELCB
#' [1] 50
#'
#' $WELL
#' # A tibble: 13,965 × 6
#'       SP   LAY   ROW   COL          Q       xyz
#'    <int> <int> <int> <int>      <dbl>     <chr>
#' 1      1    11   142   135 -13378.750         0
#' 2      1    12   142   135 -13378.750         0
#' 3      1     7   127   243 -10683.750         0
#' 4      1     8   127   243 -10683.750         0
#' 5      1    11    27    46  -9624.999         0
#' 6      1    12    27    46  -9624.999         0
#' 7      1    11    27    47  -7699.999         0
#' 8      1    12    27    47  -7699.999         0
#' 9      1     1   232    39  -2310.000         0
#' 10     1     7   230    94  -9239.999         0
#' # ... with 13,955 more rows
readwel <- function(rootname = NA, NSP = 1){
       if(is.na(rootname)){
               rootname <- MFtools::getroot()
       }
       infl                   <- paste(rootname, ".wel", sep = "")
       fl                     <- readr::read_file(infl) %>% gsub("\r", "", x = .) %>% strsplit("\n") %>% unlist()
       TEXT                   <- fl[grep("#", fl)]
       INDX                   <- ifelse(length(grep("#", fl)) == 0, 0,
                                        max(grep("#", fl), na.rm = TRUE)) + 1
       PARAMETER              <- NULL
       NPWEL                  <- NULL
       MXL                    <- NULL
       Option                 <- NULL
       if(fl[INDX] %>% grepl("PARAMETER", .)){
           PARAMETER          <- fl[INDX] %>% strsplit("\\s+") %>% unlist() %>% subset(. != "") %>% .[[1]]
           NPWEL              <- fl[INDX] %>% strsplit("\\s+") %>% unlist() %>% subset(. != "") %>% .[[2]] %>% as.integer()
           MXL                <- fl[INDX] %>% strsplit("\\s+") %>% unlist() %>% subset(. != "") %>% .[[3]] %>% as.integer()
           INDX               <- INDX + 1
       }
       LNGTH                  <- fl[INDX] %>% strsplit("\\s+") %>% unlist() %>% subset(. != "") %>% length()
       MXACTW                 <- fl[INDX] %>% strsplit("\\s+") %>% unlist() %>% subset(. != "") %>% .[[1]] %>% as.integer()
       IWELCB                 <- fl[INDX] %>% strsplit("\\s+") %>% unlist() %>% subset(. != "") %>% .[[2]] %>% as.integer()
       if(LNGTH > 2){
           Option             <- fl[INDX] %>% substr(start = 21, stop = nchar(fl[INDX]))
       }
       INDX                   <- INDX + 1
       # WRITE A FUNCTION FOR READING PARNAM (ITEMS 3 AND 4)
       STARTS                 <- INDX + (seq(1, NSP) - 1) * (MXACTW + 1)
       BLOCKS                 <- setdiff(INDX + seq(1, NSP * (MXACTW + 1) - 1), STARTS)
       ITMP                   <- fl[STARTS] %>% substr(start = 1, stop = 10) %>% as.integer()
       NP                     <- fl[STARTS] %>% substr(start = 11, stop = 20) %>% as.integer()
       SP                     <- seq(1, NSP) %>% rep(each = MXACTW)
       INSTANCES              <- fl[STARTS] %>% substr(start = 21, stop = nchar(fl[INDX + STARTS]))
       # WELL                   <- fl[BLOCKS] %>%
       #                           stringr::str_split_fixed("\\s+", n = 6) %>%
       #                           tibble::as_tibble() %>%
       #                           dplyr::mutate(V1 = SP,
       #                                         V2 = as.integer(V2),
       #                                         V3 = as.integer(V3),
       #                                         V4 = as.integer(V4),
       #                                         V5 = as.numeric(V5)) %>%
       #                           rename(SP = V1, LAY = V2, ROW = V3, COL = V4, Q = V5, xyz = V6)
       Layer                  <- fl[BLOCKS] %>% substr(start = 1, stop = 10) %>% as.integer()
       Row                    <- fl[BLOCKS] %>% substr(start = 11, stop = 20) %>% as.integer()
       Col                    <- fl[BLOCKS] %>% substr(start = 21, stop = 30) %>% as.integer()
       Qfact                  <- fl[BLOCKS] %>% substr(start = 31, stop = 41) %>% as.numeric()
       xyz                    <- fl[BLOCKS] %>% substr(start = 42, nchar(fl[INDX + 1]))

       WELL      <- tibble::data_frame(SP = SP,
                                       LAY = Layer,
                                       ROW = Row,
                                       COL = Col,
                                       Q   = Qfact,
                                       xyz = xyz)
       WELFL     <- list(TEXT = TEXT,
                         PARAMETER = PARAMETER,
                         NPWEL     = NPWEL,
                         MXL       = MXL,
                         Option    = Option,
                         MXACTW    = MXACTW,
                         IWELCB    = IWELCB,
                         WELL      = WELL)
       return(WELFL)
       }