# This script handles outputs from running `cellranger count` on fastq files.
# Load required packages
library(Seurat) # Package version v3.0.2
library(plyr)
library(dplyr) # for mutate, "%>%"
library(Matrix)
library(RColorBrewer) # colorRampPalette(), brewer.pal
library("pheatmap") # for pheatmap()
library(ggplot2)
library(slingshot) # pseudotime calculation

#### Individual data object constructions ####
# Below is the process of preparing 1dpa1 dataset. Use the same process for all datasets
data_1dpa1 <- Read10X(data.dir = <raw_cellranger_output_path>) # Replace <> part with actual path
# Set up 1dpa1 object
colnames(x =  data_1dpa1) <- paste('1dpa1', colnames(x =  data_1dpa1), sep = '-')

# Create Seurat object. Set threshold to include only gene features that are detected in at least 5 cells.
obj_1dpa1 <- CreateSeuratObject(data_1dpa1, project = "1dpa1", min.cells = 5)
obj_1dpa1@meta.data$Stage <- "1dpa"

# Estimate mitochondiral contaminations
mito.genes <- grep(pattern = "^mt-", x = rownames(obj_1dpa1), value = TRUE)
percent.mito <- Matrix::colSums(x = GetAssayData(object = obj_1dpa1, slot = 'counts')[mito.genes, ]) / Matrix::colSums(x = GetAssayData(object = obj_1dpa1, slot = 'counts'))
## The [[ operator can add columns to object metadata, and is a great place to stash QC stats
obj_1dpa1[['percent.mito']] <- percent.mito

# Filter cells based on number of features captured, number of counts and percentage of mitochondrial reads.
obj_1dpa1 <- subset(x = obj_1dpa1, subset = nFeature_RNA > 500 & nCount_RNA < 40000 & percent.mito < 0.05)

# Normalization and variable gene selection
## sctransform replaces NormalizeData, ScaleData, and FindVariableFeatures.
## Transformed data will be available in the SCT assay, which is set as the default after running sctransform
obj_1dpa1 <- SCTransform(obj_1dpa1, vars.to.regress = c("nCount_RNA", "percent.mito"), verbose = FALSE)

# Regress out cell cycle effect. Cell cycle gene list is converted from regev_lab_cell_cycle_genes.txt
obj_1dpa1 <- CellCycleScoring(obj_1dpa1, s.features = s.genes, g2m.features = g2m.genes)
obj_1dpa1$CC.Difference <- obj_1dpa1$S.Score - obj_1dpa1$G2M.Score
obj_1dpa1 <- ScaleData(obj_1dpa1, vars.to.regress = "CC.Difference", features = rownames(obj_1dpa1))

#### Data integration ####
# Set up list for all data objects for integration
obj.list <- list(obj_1dpa1,
                  obj_1dpa2,
                  obj_2dpa1,
                  obj_2dpa2,
                  obj_4dpa1,
                  obj_4dpa2,
                  obj_samp1,
                  obj_samp2)
# Data integration
obj.features <- SelectIntegrationFeatures(object.list = obj.list, nfeatures = 3000)
obj.list <- PrepSCTIntegration(object.list = obj.list, anchor.features = obj.features, verbose = FALSE)
obj.anchors <- FindIntegrationAnchors(object.list = obj.list, normalization.method = "SCT", anchor.features = obj.features, verbose = FALSE)
# include all common genes for downstream analysis (integrate for all required genes)
GenesT0Integrate <- Reduce(intersect, lapply(obj.list, rownames))
fin.integrated <- IntegrateData(anchorset = obj.anchors, normalization.method = "SCT",
                                features.to.integrate = GenesT0Integrate ,verbose = T)

#### Dimensional reduction and clustering ####
# Non-linear dim reduction for visualization
## default assay is "integrated" post integration
fin.integrated <- RunPCA(fin.integrated, verbose = T)
fin.integrated <- RunUMAP(fin.integrated, dims = 1:20)

# Linear dim reduction for clustering
fin.integrated <- FindNeighbors(fin.integrated, reduction = "pca", dims = 1:20)
fin.integrated <- FindClusters(fin.integrated, resolution = 0.1)

# Differential analysis
## Find markers using RNA or SCT data slot
fin.cl.mk.sct <- FindAllMarkers(fin.integrated, assay = "SCT", only.pos = T, logfc.threshold = 0.25, min.pct = 0.25)
## Take top 30 DEGs for heatmap
fin.cl.mk.sct.top <- fin.cl.mk.sct %>% group_by(cluster) %>% top_n(n = 30, wt = avg_logFC)

# Assign cell identity
fin.integrated[["major.cl"]] <- mapvalues(fin.integrated$integrated_snn_res.0.1,
	from = c("2","5","1","0","4","3"), to = c("Superficial Epithelial","Mucosal-like","Intermediate Epithelial","Basal Epithelial","Hematopoietic","Mesenchymal"))
## Reset levels to match the order from outer to inner layer
fin.integrated[["major.cl"]] <- factor(fin.integrated$major.cl, levels = c("Superficial Epithelial","Mucosal-like","Intermediate Epithelial","Basal Epithelial","Hematopoietic","Mesenchymal"))
## Merge epithelial identities in to Epithelial
fin.integrated[["merged.cl"]] <- mapvalues(fin.integrated$integrated_snn_res.0.1,
	from = c("0","1","2","3","4","5"), to = c("Epithelial","Epithelial","Epithelial","Mesenchymal","Hematopoietic","Epithelial"))
## Reset levels to match the order from outer to inner layer
fin.integrated[["merged.cl"]] <- factor(fin.integrated$merged.cl, levels = c("Epithelial","Hematopoietic","Mesenchymal"))
## Merge regenerating stages as regenerating
fin.integrated[["preReg"]] <- mapvalues(fin.integrated$Stage,
                                         from = c("Preinjury","1dpa","2dpa","4dpa"),
                                         to = c("Preinjury","Regenerating","Regenerating","Regenerating"))
## Manual set stringent G1/G2M/S phase separations
Idents(fin.integrated, cells = colnames(fin.integrated)[fin.integrated$CC.Diff >= 0.1 & fin.integrated$S.Score > 0 & fin.integrated$G2M.Score > 0]) <- "S"
Idents(fin.integrated, cells = colnames(fin.integrated)[fin.integrated$CC.Diff <= -0.1 & fin.integrated$S.Score > 0 & fin.integrated$G2M.Score > 0]) <- "G2M"
## stringent cut off for G1. Use both score below zero (as what used in seurat by default)
Idents(fin.integrated, cells = colnames(fin.integrated)[fin.integrated$S.Score <= 0 & fin.integrated$G2M.Score <= 0]) <- "G1"
## Assign the rest as unselected
Idents(fin.integrated, cells = colnames(fin.integrated)[Idents(fin.integrated) != "S" & Idents(fin.integrated) != "G2M" & Idents(fin.integrated) != "G1"]) <- "Unselected"
fin.integrated[["manualPhase"]] <- Idents(object = fin.integrated)
fin.integrated[["manualPhase"]] <- factor(fin.integrated$manualPhase, levels = c("G1","S","G2M","Unselected"))

# Plot major cell cluster on UMAP axes and split by group. Other metadata options could be used for grouping/splitting.
DimPlot(fin.integrated,
	group.by = "major.cl",
	split.by = "Stage",
	cols = brewer.pal(7, "Set1")[c(1:5,7)])
# Plot gene expression distribution
FeaturePlot(object = fin.integrated,
              features = c("epcam","cdh1","mpeg1.1","cxcr3.2","msx1b","msx3"),
              min.cutoff = "q5", max.cutoff = "q95",
              cols = c("lightgrey", "blue"),
              pt.size = 0.1,
              ncol = 2)
DoHeatmap(fin.integrated, features = fin.cl.mk.sct.top$gene)
DotPlot(fin.integrated, assay = "SCT",
        features = rev(c("epcam","cdh1","krt4","agr2","foxp1b","foxp4","tp63","krtt1c19e","mpeg1.1","cxcr3.2","msx1b","twist1a")),
        cols = c("lightgrey","black"),
        dot.scale = 8) + RotatedAxis()

#### Cell cycle analysis ####
Idents(fin.integrated) <- "manualPhase"
# Subset S phase
S.subset <- subset(x = fin.integrated, idents = "S")

S.subset <- RunPCA(S.subset, npcs = 50, verbose = F)
S.subset <- FindNeighbors(S.subset, reduction = "pca", dims = 1:10) # PC number could change
S.subset <- FindClusters(S.subset, resolution = 0.3)
S.subset <- RunUMAP(S.subset, reduction = "pca", dims = 1:10, n.neighbors = 50, min.dist = 0.5)
DimPlot(S.subset, reduction = "umap") + NoAxes()

#### Major cell population sub-clustering ####
# Hematopoietic
## Subset H cells
Idents(fin.integrated) <- "merged.cl"
H.subset <- subset(fin.integrated, idents = "Hematopoietic")
DefaultAssay(H.subset) <- "integrated"
H.subset <- RunPCA(H.subset, npcs = 50, verbose = F)
H.subset <- FindNeighbors(H.subset, reduction = "pca", dims = 1:10)
H.subset <- FindClusters(H.subset, resolution = 0.3)
H.subset <- RunUMAP(H.subset, reduction = "pca", dims = 1:10, n.neighbors = 50, min.dist = 0.2)
DimPlot(H.subset, reduction = "umap", cols = brewer.pal(4,"Dark2")) + NoAxes()
## FindAllMarkers
H.subset.markers <- FindAllMarkers(H.subset, assay = "SCT", only.pos = TRUE, min.pct = 0.25, logfc.threshold = 0.25)
H.subset.markers.top <- H.subset.markers %>% group_by(cluster) %>% top_n(n = 30, wt = avg_logFC)
H.subset <- ScaleData(H.subset,assay = "SCT", vars.to.regress = c("percent.mito", "nCount_RNA"))
DoHeatmap(H.subset, features = H.subset.markers.top$gene, assay = "SCT") + FontSize(y.text = 0, x.text = 0, main = 0) + NoLegend()

# Epithelial
Epi.subset <- subset(fin.integrated, idents = "Epithelial")
Epi.subset <- SCTransform(Epi.subset, vars.to.regress = c("percent.mito", "nCount_RNA","CC.Diff"), verbose = F, return.only.var.genes = F)
Epi.subset <- RunPCA(Epi.subset, npcs = 50, verbose = F)
Epi.subset <- FindNeighbors(Epi.subset, reduction = "pca", dims = 1:10)
Epi.subset <- FindClusters(Epi.subset, resolution = 0.2)
Epi.subset <- RunUMAP(Epi.subset, reduction = "pca", dims = 1:10, n.neighbors = 50, min.dist = 0.2)
DimPlot(Epi.subset, reduction = "umap") + NoAxes()
## Plot expression distribution of krt and cldn family genes, and known epithelial marker
DotPlot(Epi.subset, assay = "RNA",split.by = "preReg",
        features = rev(c("cldne", "cldnf", "krt1-19d","krt17","cldnh","cldna", "krt93", "krt94", "cldn1", "cldni","krt4","fn1b","tp63","krtt1c19e")),
        cols = c("red","blue"),
        dot.scale = 8) + RotatedAxis()
## Subset regenerating basal epithelial cells
WE.subset <- subset(Epi.subset, cells = rownames(Epi.subset@meta.data)[Epi.subset$major.cl == "Basal Epithelial" & Epi.subset$preReg == "Regenerating" ])
DefaultAssay(WE.subset) <- "integrated"
WE.subset <- RunPCA(WE.subset, npcs = 50, verbose = F)
WE.subset <- FindNeighbors(WE.subset, reduction = "pca", dims = 1:10)
WE.subset <- FindClusters(WE.subset, resolution = 0.1)
WE.subset <- RunUMAP(WE.subset, reduction = "pca", dims = 1:10, n.neighbors = 50, min.dist = 0.2)
DimPlot(WE.subset, reduction = "umap") + NoAxes()

# Mesenchymal
Mes.subset <- subset(fin.integrated, idents = "Mesenchymal")
Mes.subset <- SCTransform(Mes.subset, vars.to.regress = c("percent.mito", "nCount_RNA","CC.Diff"), verbose = F, return.only.var.genes = F)
Mes.subset <- RunPCA(Mes.subset, npcs = 50, verbose = F)
Mes.subset <- FindNeighbors(Mes.subset, reduction = "pca", dims = 1:30) # PC number could change
Mes.subset <- FindClusters(Mes.subset, resolution = 0.4)
Mes.subset <- RunUMAP(Mes.subset, reduction = "pca", dims = 1:30, n.neighbors = 50, min.dist = 0.2)
## PC30 + res 0.4 revealed cluster 4 and 8 as epithelial populations. Remove and redo clustering and UMAP calc
Mes.epiRm.subset <- subset(Mes.subset, idents = c("0","1","2","3","5","6","7"))
## Redo clustering and non-linear dimensional reductions.
Mes.epiRm.subset <- FindNeighbors(Mes.epiRm.subset, reduction = "pca", dims = 1:25) # PC number could change
Mes.epiRm.subset <- FindClusters(Mes.epiRm.subset, resolution = 0.6)
Mes.epiRm.subset <- RunUMAP(Mes.epiRm.subset, reduction = "pca", dims = 1:25, n.neighbors = 20, min.dist = 0.2)
DimPlot(Mes.epiRm.subset, group.by = "Stage") + NoAxes()
## Slingshot pseudotime reconstructions
rd <- Mes.epiRm.subset@reductions$umap@cell.embeddings
cl <- Mes.epiRm.subset@active.ident
## Number of clusters
numCl <- length(unique(cl))
sds <- slingshot(rd, cl)
## Number of curves
numCurves <- length(sds@curves)
png("Mesenchymal_withSlingShotPT.png",
    width = 3*300,        # 5 x 300 pixels
    height = 3*300,
    res = 300,            # 300 pixels per inch
    pointsize = 5)
plot(rd, col = brewer.pal(numCl,"Paired")[as.factor(cl)], asp = 1, pch = 16)
# For fixed 4 colorful lines
lines(slingCurves(sds)$curve1, lwd = 2, col = "black")
lines(slingCurves(sds)$curve2, lwd = 2, col = "blue")
lines(slingCurves(sds)$curve3, lwd = 2, col = "red")
lines(slingCurves(sds)$curve4, lwd = 2, col = "brown")
dev.off()


read_xgc_mesh = function(file) {
    ## read mesh in parallel and allgather a full copy to everyone
    ##          this allows multiple plots in parallel
    if(endsWith(file, ".bp")) {
        mesh = bp.read(file, c("n_n", "n_t"))
        iopair_t = comm.chunk(mesh$n_t, form = "iopair")
        iopair_n = comm.chunk(mesh$n_n, form = "iopair")
        buffer =
            bp.read(file, c("nd_connect_list", "rz"),
                    start=list(c(iopair_t[1], 0), c(iopair_n[1], 0)),
                    count=list(c(iopair_t[2], 3), c(iopair_n[2], 2)))

        nd_connect_list = do.call(c, allgather(buffer[[1]]))
        dim(nd_connect_list) = c(3, mesh$n_n)
        rz = do.call(c, allgather(unlist(buffer[[2]])))
        dim(rz) = c(2, mesh$n_n)
    } else if(endsWith(file, ".h5")) {
        mesh = list(n_n=NULL, n_t=NULL)
        buffer = vector("list", 2)
        mesh$n_n = h5read(file, "n_n")

        iopair_n = comm.chunk(mesh$n_n, form = "iopair")
        ## rhdf5 needs to add 1 to C/Python written data!
        buffer = h5read(file, "coordinates/values",
                        start=c(0 + 1, iopair_n[1] + 1),
                        count=c(2, iopair_n[2]))
        rz = do.call(c, allgather(unlist(buffer)))
        dim(rz) = c(2, mesh$n_n)
        nd_connect_list = NULL
    } else {
        comm.print("Don't know file type")
        stop(11)
    }
    list(rz = t(rz), nd_connect_list = nd_connect_list)
}

read_xgc = function(file, var) {
    ## reads a 2-d array: a set of ploidal planes
    ## TODO make generic with a parameter on which dimension to split
    if(endsWith(file, ".bp")) {
        ## TODO not generic! needs to get dimensions from varname!
        par = bp.read(file, c("nnode", "nphi"))
        iopair = comm.chunk(par$nnode, form = "iopair")

        buffer = bp.read(file, var, start = c(iopair[1], 0),
                         count = c(iopair[2], par$nphi))[[1]]
    } else if(endsWith(file, ".h5")) {
        ## hdf5 file
        gd = h5ls(file) # TODO There has to be a better way to get dims!!
        par = as.numeric(strsplit(gd[gd$name == var, ]$dim, "x")[[1]])
        iopair = comm.chunk(par[2], form = "iopair")
        buffer = h5read(file, var,
                        start=c(0 + 1, iopair[1] + 1),
                        count=c(par[1], iopair[2]))
    } else {
        comm.print("Don't know file type")
        stop(11)
    }

    dim(buffer) = c(par[1], iopair[2])
    buffer
}

read_xgc_window = function(file, var, time, window, subset) {
    ## read time window
    ## TODO needs to be generic with indicators of what to do with which
    ## dimensions.

    rex = "#+" # get length of rex in file name to replace with time
    rl = attr(regexpr(rex, file), "match.length")

    start = time - window %/% 2  # center the window on time

    ## construct file name for each window element and read the file
    wdat = vector("list", window)
    for(w in 1:window) {
        file_t = sub(rex, sprintf(paste0("%0.", rl, "d"), start + w - 1), file)
        wdat[[w]] = read_xgc(file_t, var, subset)
    }
    ## wdat is a list with each element a time step in the window
    ## column dimension is the mesh
    ## row dimension is the poloidal slice

    ## TODO convert this to S4 (with a tensor package?)
    tdim = c(dim(wdat[[1]])[1], window, dim(wdat[[1]])[2]) # dims of tensor
    tdist = c(FALSE, FALSE, TRUE) # which dimensions are distributed
    tdimname = c("toro", "time", "mesh")
    umat = do.call(rbind, wdat) # final unfolded distributed matrix
    dim(umat) = tdim # this should make it a 3d array or a tensor
    class(umat) = "array"
    list(Data=umat, tdist=tdist, tdimname=tdimname)
}

byrow_to_bycol_gather = function(dat) {
    rcols = comm.chunk(ncol(dat), form="vector", all.rank=TRUE)
    for(r in 1:comm.size()) {
        if(comm.rank() == r - 1L) {
            Vc = do.call(rbind, gather(dat[, rcols[[r]]], rank.dest = r - 1L))
        } else {
            Vtemp = gather(dat[, rcols[[r]]], rank.dest = r - 1L)
        }
    }
    Vc
}

screePlot = function(d, file, which=1:length(d), cumvar=FALSE,
                     log10=FALSE, percent=FALSE, ylims=NULL,
                     width=5, height=4, sizeL=0.3, sizeP=0.4) {
    ## scree plot with options
    pdf(paste0(file, ".pdf"), width, height)
    df = data.frame(component = which, var = d[which],
                    cumvar = cumsum(d[which]))
    if(percent) {
        df$var = 100*df$var/sum(d)
        df$cumvar = 100*df$cumvar/sum(d)
    }
    myplot = ggplot(df, aes(component, var)) + geom_line(size = sizeL) +
        geom_point(size = sizeP, color = "blue")
    if(cumvar) myplot = myplot +
                   geom_line(aes(component, cumvar), size = sizeL) +
                   geom_point(aes(component, cumvar), size = sizeP,
                              color = "red")
    if(log10) myplot = myplot + scale_y_log10()
    if(!is.null(ylims[1])) myplot = myplot + expand_limits(y = ylims)
    ggplot2:::print.ggplot(myplot + theme_bw())
    dev.off()
}

scree_plots = function(d, ttag, myrank) {
    ## need a ease of use concept for if-elses below? list with lapply?
    ##    current version only works with 5+ ranks!!
    if(myrank == 0) {
        screePlot(d^2, paste0(screedir, "scree", ttag))
    } else if(myrank == 1) {
       screePlot(d^2, paste0(screedir, "scree100Log", ttag), 1:100, log10=TRUE)
    } else if(myrank == 2) {
        screePlot(d^2, paste0(screedir, "screeLog", ttag), log10=TRUE)
    } else if(myrank == 3) {
        screePlot(d^2, paste0(screedir, "screeCumm", ttag), cumvar=TRUE)
    } else if(myrank == 4) {
        screePlot(d^2, paste0(screedir, "screeCummP", ttag), cumvar=TRUE,
                  percent=TRUE)
    }
}

spacePlot = function(mesh, vals, file = "spacePlot", tagImage=FALSE) {
    ## plots vals on mesh to pdf file
    pdata = data.frame(x = mesh[, 1], y = mesh[, 2], val= vals)
    pdf(paste0(file, ".pdf"), 10, 8)
    myplot = ggplot(pdata, aes(x, y, color = val)) + geom_point(size=0.5) +
        scale_color_gradient2(low="blue", mid="green", high="red") +
        theme_void()
    if(tagImage) myplot = myplot + ggtitle(file)
    ggplot2:::print.ggplot(myplot)
    dev.off()
}

space_plots = function(mesh, d, Vr, maxplots, myrank, tag="") {
    ## Plot the poloidal slice coherent structures
    Vc = byrow_to_bycol_gather(Vr)
    nplots = min(maxplots, length(d))
    myPCs = comm.chunk(nplots, form="vector", type="balance")
    my.d = d[myPCs]
    PCdigits = floor(log10(length(d)) + 1)
    ftag = paste0(plotdir, tag, "pc%0.", PCdigits, "d")
    for(i in seq_along(myPCs)) {
       spacePlot(mesh, Vc[, i]*my.d[i], sprintf(ftag, myPCs[i]), tagImage=TRUE)
     }
}
## End function definition


#!/usr/local/bin/env Rscript --vanilla
args <- commandArgs(TRUE)
if (!is.null(args[1])) {
    df <- read.csv(args[1], sep = "\t", row.names = 1,check.names=FALSE)
    if (max(df, na.rm = TRUE) < 50) {
        df <- 2^df
    }
} else {
    stop("No expression matrix provided!")
}

library(matrixStats)
library(MCPcounter)

if (length(args) > 1) {
    ref <- read.csv(args[2], sep = "\t", row.names = 1,check.names=FALSE,header=T) ### Need to change later
    cellTypeNames <- colnames(ref)
   # print(cellTypeNames)
    markerGenes <- c()
    cellTypes <- c()
    for (s in colnames(ref)) {
        tempMarkers <- rownames(ref[ref[,s] > quantile(ref[,s], prob=0.75),])
        markers <- c()
        if (length(args) > 2) {
            if (tolower(args[3]) == "pairwise") {
                tempTb = 2 * ref[,cellTypeNames[cellTypeNames != s]] - ref[,s]
                markers <- tempMarkers[tempMarkers %in% rownames(ref[rowSums(tempTb < 0) == (length(cellTypeNames) - 1), ])]
            } else {
                markers <- tempMarkers[tempMarkers %in% rownames(ref)[ref[,s] > 2 * rowMedians(as.matrix(ref))]]
            }
        } else {
            markers <- tempMarkers[tempMarkers %in% rownames(ref)[ref[,s] > 2 * rowMedians(as.matrix(ref))]]
        }
        if (length(markers) == 0) {
            # tempMarkers <- rownames(ref[ref[,s] > quantile(ref[,s], prob=0.5),])
            deOverMedians <- (ref[tempMarkers,s] - rowMedians(as.matrix(ref[tempMarkers,])))/rowMedians(as.matrix(ref[tempMarkers,]))
            markers <- tempMarkers[deOverMedians > quantile(deOverMedians, prob=0.9)]
        }
        genesTemp <- markers
        markerGenes <- c(markerGenes, genesTemp)
        cellTypes <- c(cellTypes, rep(s, length(genesTemp)))
    }
    sigList <- data.frame("HUGO symbols" = markerGenes, "Cell population" = cellTypes)
    colnames(sigList) <- c("HUGO symbols", "Cell population")
    tryCatch(
        expr = {
            mcp <- MCPcounter.estimate(df, featuresType = "HUGO_symbols", genes = sigList)
            write.table(mcp, file="deconvoluted.tsv", quote = FALSE, col.names = NA, sep = "\t")
        },
        error = function(e){
            # (Optional)
            # Do this if an error is caught...
            print(e)
            X <- read.csv(args[2], sep = "\t", row.names = 1)
            Y <- read.csv(args[1], sep = "\t")
            mcp <- matrix(0, ncol = length(colnames(Y)) - 1, nrow = length(colnames(X)), dimnames = list(colnames(X), colnames(Y)[2:length(colnames(Y))]))
            write.table(mcp, file="deconvoluted.tsv", quote = FALSE, col.names = NA, sep = "\t")
        }
    )
} else {
    mcp <- MCPcounter.estimate(df, featuresType = "HUGO_symbols")
    write.table(mcp, file="deconvoluted.tsv", quote = FALSE, col.names = NA, sep = "\t")
}


###########################################
# set directory
path <- "D:/Desktop/108112_Source"

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

##### (1) Importing packages
suppressMessages(suppressWarnings(library(tidyverse)))
suppressMessages(suppressWarnings(library(rio)))        # export()
suppressMessages(suppressWarnings(library(dtwclust)))   # dtw_lb()
suppressMessages(suppressWarnings(library(caret)))      # createFolds()
suppressMessages(suppressWarnings(library(parallel)))   # Parlapply()

##### (2) Loading data
### (2-1)Training data
# Retrieve Training data label
setwd(path)
training_data <- read.csv("Merged_data.csv")
fold_index <- training_data[,"fold"]
True_label <- as.character(fold_index)

# Format Training data into list
list_training_data <- function(){
  #Data directory
  root <- paste0(path, "/comp_data_csv/")
  setwd(root)
  fold_name <- list.files(pattern="G*")
  working_directory <- paste(root,fold_name,"/", sep ="")
  # Retrive datasets into list
  data_list <- list()
  for( i in seq_len(length(working_directory))){
    wdsep <- working_directory[i]
    setwd(wdsep)
    fold_name <- list.files(pattern="G*")
    #file
    for ( j in seq_len(length(fold_name))){
      file <- fold_name[j]
      file_read <-  read.csv(file)
      data_list[[file]] <- file_read
    }
  }
  # Treatment
  settle <- function(df){
    df <- df[-1]
    names(df) <- NULL
    data_list_tidy <- as.list(df)
    return(data_list_tidy)
  }
  data_list_tidy <- sapply(data_list, settle)
  # Organize
  training_data_list <- list()
  for( i in seq_len(length(data_list_tidy))){
    item_num <- length(data_list_tidy[[i]])
    for( j in seq_len(item_num)){
      training_data_list <- c(training_data_list, data_list_tidy[[i]][j])
    }
  }
  cat("process completed - training dataset \n")
  return(training_data_list)
}
training_data_list <- list_training_data()

# Reinterpolate training data list  to same length
training_data_list_new <- reinterpolate(training_data_list, new.length = max(lengths(training_data_list)))

### (2-2) Testing data
# Format Testing data into list
list_testing_data <- function(){
  #Data directory
  root <- paste0(path, "/testing_csv/")
  setwd(root)
  file_name <- list.files(pattern=".csv")
  file_dire <- paste(root,file_name, sep ="")
  name_list <- unlist(strsplit(file_name, ".csv"))
  # Retrive datasets into list
  data_list <- list()
  for( i in seq_len(length(file_dire))){
    file <- file_dire[i]
    file_read <-  read.csv(file)
    data_list[[name_list[i]]] <- file_read
  }
  # Treatment
  settle <- function(df){
    df <- df[-1]
    names(df) <- NULL
    data_list_tidy <- as.list(df)
    return(data_list_tidy)
  }
  data_list_tidy <- sapply(data_list, settle)
  # Organize
  testing_data_list <- list()
  for( i in seq_len(length(data_list_tidy))){
    item_num <- length(data_list_tidy[[i]])
    for( j in seq_len(item_num)){
      testing_data_list <- c(testing_data_list, data_list_tidy[[i]][j])
    }
    name_index <- sapply(data_list, function(x) (dim(x)[2]-1))
    file_name <- rep(name_list, name_index)
  }
  cat("process completed - testing dataset \n")
  return(list(testing_data_list = testing_data_list, file_name = file_name) )
}
testing_data <-  list_testing_data()
testing_data_list <- testing_data$testing_data_list
testing_data_file_name <- testing_data$file_name

### Reinterpolate testig data to same length(equal to training data length)
testing_data_list_new <- reinterpolate(testing_data_list, new.length = max(lengths(training_data_list)))

##### (3) Main function
### (3-1) KNN
classify_series <- function(query, database, NN = 1, Filter = T, window_size = 30L) {
  # Similarity
  similarity <- dtw_lb(database, query, window.size = window_size,nn.margin = 2L)
  similarity_sorted_index <- order(similarity)
  # Nearest neighbor
  Nearest_index <-similarity_sorted_index[1:NN]
  index <- as.character(fold_index)
  Nearest_Nei_label <- index[Nearest_index]
  # Find the Nearest element
  Nearest_label <- sort(table(Nearest_Nei_label), decreasing = T)[1]
  niche <- ceiling(NN/2)
  Check <- Nearest_label >= niche
  if(Check){
    final_label <- names(Nearest_label)
  }else{
    final_label <- "pending"
  }

  if(Filter){
    return(final_label)
  }else{
    return( list(Nearest_Neighbor_set = Nearest_Nei_label,  Nearest_element = final_label) )
  }

}

##### (4)Model
# Model 1
NN <- 1; window_size <- 30L
formals(classify_series)[c("NN", "window_size")] <- list(NN = NN, window_size = window_size)
Model1 <- classify_series

# Model 2
NN <- 5; window_size <- 10L
formals(classify_series)[c("NN", "window_size")] <- list(NN = NN, window_size = window_size)
Model2 <- classify_series

# Model 3
NN <- 3; window_size <- 0L
formals(classify_series)[c("NN", "window_size")] <- list(NN = NN, window_size = window_size)
Model3 <- classify_series

##### (5) Prediction
# Variable
Model <- list(Model1, Model2, Model3)
Prediction_func <- function(func,data){
  Result <- rep(NA, length(data))
  for( i in seq_len(length(Result))){
    Result[i] <- func(query = data[[i]], database =  training_data_list_new)
  }
  return(Result)
}
Prediction_list <- lapply(Model, function(x) Prediction_func(func = x, data = testing_data_list_new) )

Prediction_df <- data.frame(matrix(unlist(Prediction_list), nrow = length(Prediction_list[[1]])))
colnames(Prediction_df) <-c("Model1", "Model2", "Model3")
cat("process completed - prediction \n")

Result_df <- cbind(Prediction_df, file = testing_data_file_name)

# Votting
vote <- apply(Prediction_df, 1, function(x) names(which.max(table(x))) )
vote_df <- data.frame(file = as.numeric(testing_data_file_name), Prediction = vote)

# Non-concord index
nc_index <- Prediction_df[which(apply(Prediction_df, 1, function(x) length(table(x)) >1 )),] %>% rownames() %>%as.numeric()
nc_index_file <- Result_df[nc_index,] %>% pull(file)

##### Final decision
Split_df <- split(vote_df, vote_df$file)

#Decision function
Prediction_result <- sapply(Split_df, function(x) names(which.max(table(x[,"Prediction"]))))

##### Export result
result_data <- data.frame(file_name = names(Prediction_result),
                          Prediction = Prediction_result)
# export location
export(x = result_data,
       file = paste0(path, "/108112_TestResult.xlsx"))
cat("process completed - output to xlsx \n")


# Copyright © 2017-2019 Jon Gjengset <jon@thesquareplanet.com>.
# SPDX-License-Identifier: Apache-2.0 OR MIT

v = read.table(file("results.log"))
t <- data.frame(readers=v[,1], writers=v[,2], distribution=v[,3], variant=v[,4], opss=v[,5], op=v[,7])

library(plyr)
t$writers = as.factor(t$writers)
t$readers = as.numeric(t$readers)

# split the data into tx/readers and tx/refresh
compare_impl = t[grep("evmap-refresh", t$variant, invert = TRUE),]
compare_rate = t[grep("evmap-refresh", t$variant, invert = FALSE),]
compare_rate = rbind(compare_rate, compare_impl[compare_impl$variant == "evmap",])

r = compare_impl[compare_impl$op == "read",]
r <- ddply(r, c("readers", "writers", "distribution", "variant", "op"), summarise, opss = sum(opss))
w = compare_impl[compare_impl$op == "write",]
w <- ddply(w, c("readers", "writers", "distribution", "variant", "op"), summarise, opss = sum(opss))

library(ggplot2)

r$opss = r$opss / 1000000.0
p <- ggplot(data=r, aes(x=readers, y=opss, color=variant))
#p <- p + ylim(c(0, 2500))
p <- p + xlim(c(0, NA))
p <- p + facet_grid(distribution ~ writers, labeller = labeller(writers = label_both))
p <- p + geom_point(size = .4, alpha = .1)
p <- p + geom_line(size = .5)
#p <- p + stat_smooth(size = .5, se = FALSE)
p <- p + xlab("readers") + ylab("M reads/s") + ggtitle("Total reads/s with increasing # of readers")
ggsave('read-throughput.png',plot=p,width=10,height=6)

w$opss = w$opss / 1000000.0
p <- ggplot(data=w, aes(x=readers, y=opss, color=variant))
#p <- p + scale_y_log10(lim=c(1, NA))#5000))
p <- p + facet_grid(distribution ~ writers, labeller = labeller(writers = label_both))
p <- p + geom_point(size = 1, alpha = .2)
p <- p + geom_line(size = .5)
#p <- p + stat_smooth(size = .5, se = FALSE)
#p <- p + coord_cartesian(ylim=c(0,250))
p <- p + xlim(c(0, NA))
p <- p + xlab("readers") + ylab("M writes/s") + ggtitle("Total writes/s with increasing # of readers")
ggsave('write-throughput.png',plot=p,width=10,height=6)


REP_OECD.LFS_ANNUAL_input_ANNUAL_EMP_SEX_ECO_ISIC3 <- function()  { # Employment and Employees by Eco Activity, ISIC3

	### STEP 1 Loading local data obtained from link described above

	X 	<-	read_csv(paste0(getwd(),'/input/ANNUAL_EMP_SEX_ECO_ISIC3.csv'), col_type = cols_only(
  LOCATION = col_character(),
  SUBJECT = col_character(),
  Subject = col_character(),
  SEX = col_character(),
  Time = col_integer(),
  Value = col_double(),
  `Flag Codes` = col_character()
)
)

	X <- X %>% select(	ref_area = LOCATION,	SUBJECT,	subject = Subject,	sex = SEX ,	time  = Time,	obs_value = Value ,	obs_status = `Flag Codes`)   %>% filter(time <2009 ) %>%
			mutate(	sex = sex %>%
				plyr::mapvalues(	from = c("MA", 'FE', 'TT', "MW", "MEN", "WOMEN"),
                         to = c('SEX_M','SEX_F','SEX_T','SEX_T','SEX_M','SEX_F'), warn_missing = FALSE),
				time = as.numeric(time))

	### STEP 2 Extract and Separate Information of the indicators
  #Old version
	if (TRUE==FALSE) {
	Xp <- X %>% mutate( ISIC= str_extract(X$subject, "\\([^()]+\\)") ,
						ISIC=str_sub(ISIC, 2, -2),
						ISIC=str_replace(ISIC, "ISIC rev.3, A-X", "TOTAL"),
						indicator= if_else(str_detect(SUBJECT,"YA99"),"EMP_TEMP_SEX_ECO_NB",""),
						indicator2= if_else(str_detect(SUBJECT,"YW99"),"EES_TEES_SEX_ECO_NB",""),
						indicator=if_else(indicator!="",indicator,indicator2)) %>%
				select(	-indicator2, -subject,-SUBJECT)
	}

	#New version, to account for changes
	Xp <- X %>% mutate( ISIC= str_extract(X$subject, "\\([:alpha:]\\)") ,
	                    ISIC=str_sub(ISIC, 2, -2),
	                    ISIC= if_else( str_detect(subject,"ISIC rev.3, A-X"),"TOTAL",ISIC),
	                    indicator= if_else(str_detect(SUBJECT,"YA99"),"EMP_TEMP_SEX_ECO_NB",""),
	                    indicator2= if_else(str_detect(SUBJECT,"YW99"),"EES_TEES_SEX_ECO_NB",""),
	                    indicator=if_else(indicator!="",indicator,indicator2)) %>%
	          filter( !is.na(ISIC)  ) %>%
	  select(	-indicator2, -subject,-SUBJECT)

  ### STEP 3 Target dataset consistent with ILOSTAT format (changing observations names)

  # Observations
  Xpp <- Xp %>% mutate(	classif1=paste0("ECO_ISIC3_",ISIC),
						sex= sex %>% recode("All persons"="SEX_T",
						                    "Males"="SEX_M",
						                    "Females"="SEX_F"))%>%
				select(-ISIC)

  Xpp	<-	REP_OECD.LFS_ANNUAL_mapping_source(Xpp)

  ### STEP 4 - Working with wide format - consistency check + aggregates

  ##Seeing which categories are missing
  Y	<-	Xpp %>% spread(classif1, obs_value) %>% select(ECO_ISIC3_TOTAL, everything())
  Y <- Y %>% mutate(TOT=rowSums(.[13:(length(Y))],na.rm=TRUE))
  z_name <- colnames(Y[,14:(length(Y))-1])

  #this collects each missing category per observation and concatenates it
 Y <- Y %>% mutate(Miss="")
  for(var in z_name) {
    print(var)
    Y$Miss[is.na(Y[,var])] <- paste0(Y$Miss[is.na(Y[,var])],str_sub(var,-1,-1),"_")
  }

  # this command obtains descriptive data, it turns out not many missing
  #Y %>% group_by(Miss) %>% count() %>% save_ilo()
  # Only X category is allowed to be missing, the rest will be flagged (flag==1->I will discard them)
  Y <- Y %>% mutate(flag=if_else(Miss==""|Miss=="X_",0,1 )) %>% filter(flag==0)

  ## Cheching the totals, not more than a 3 thousand deviation, also Total existant
  Y <- Y %>% mutate(flag2=abs(Y$TOT-Y$ECO_ISIC3_TOTAL)>3) %>% filter(flag2==FALSE)

  ## aggregates
  #sector aggregate
  Y <- Y %>% mutate(ECO_AGGREGATE_AGR=ECO_ISIC3_A+ECO_ISIC3_B,
               ECO_AGGREGATE_CON=ECO_ISIC3_F,
               ECO_AGGREGATE_MAN=ECO_ISIC3_D,
               ECO_AGGREGATE_MEL=ECO_ISIC3_C+ECO_ISIC3_E,
               ECO_AGGREGATE_MKT=ECO_ISIC3_G+ECO_ISIC3_H+ECO_ISIC3_I+ECO_ISIC3_J+ECO_ISIC3_K,
               ECO_AGGREGATE_PUB=ECO_ISIC3_L+ECO_ISIC3_M+ECO_ISIC3_N+ECO_ISIC3_O+ECO_ISIC3_P+ECO_ISIC3_Q,
               ECO_AGGREGATE_X=ECO_ISIC3_X,
               ECO_AGGREGATE_TOTAL=ECO_ISIC3_TOTAL) %>%
  #broad sector
        mutate(ECO_SECTOR_AGR=ECO_AGGREGATE_AGR,
               ECO_SECTOR_IND=ECO_AGGREGATE_CON+ECO_AGGREGATE_MAN+ECO_AGGREGATE_MEL,
               ECO_SECTOR_SER=ECO_AGGREGATE_MKT+ECO_AGGREGATE_PUB,
               ECO_SECTOR_X=ECO_AGGREGATE_X,
               ECO_SECTOR_TOTAL=ECO_AGGREGATE_TOTAL)%>%
	# Remove manually computed total
	select(-TOT)

  ### STEP 5 Reshape
  Xpp <- Y %>% 	select(-flag, -flag2, -Miss) %>%
				gather(classif1, obs_value,  -ref_area, -source, -note_source, -sex, -sex_version, -time, -obs_status, -indicator,-classif1_version,  -classif2, -classif2_version) %>%
				filter(!obs_value %in% c(NA, ''), !(classif1 %in% c('ECO_AGGREGATE_X', 'ECO_SECTOR_X', 'ECO_ISIC3_X') & obs_value %in% 0))

  ### STEP 6 Exporting

saveRDS(Xpp,file = './input/ANNUAL_EMP_SEX_ECO_ISIC3.rds' )

#ensure only one object

}

REP_OECD.LFS_ANNUAL_input_ANNUAL_EMP_SEX_ECO_ISIC4 <- function() { # Employment and Employees by Eco Activity, ISIC4

  ### STEP 1 Loading local data obtained from link described above

  X<- read_csv(paste0(getwd(),'/input/ANNUAL_EMP_SEX_ECO_ISIC4.csv'), col_type = cols_only(
  LOCATION = col_character(),
  SUBJECT = col_character(),
  Subject = col_character(),
  SEX = col_character(),
  Time = col_integer(),
  Value = col_double(),
  `Flag Codes` = col_character()
)
)

	X <- X %>% select(	ref_area = LOCATION,	SUBJECT,	subject = Subject,	sex = SEX ,	time  = Time,	obs_value = Value ,	obs_status = `Flag Codes`)   %>% filter(as.numeric(time) >2008 )	%>%
			mutate(	sex = sex %>%
				plyr::mapvalues(	from = c("MA", 'FE', 'TT', "MW", "MEN", "WOMEN"),
                         to = c('SEX_M','SEX_F','SEX_T','SEX_T','SEX_M','SEX_F'), warn_missing = FALSE),
				time = as.numeric(time))

  ### STEP 2 Extract and Separate Information of the indicators
  #Old version
  if (TRUE==FALSE){
  Xp <- X %>% mutate( ISIC= str_extract(X$subject, "\\([^()]+\\)") ,
					  ISIC=str_replace(ISIC, "\\(C \\)", "\\(C\\)"),
					  ISIC=str_replace(ISIC, "\\( R\\)", "\\(R\\)"),
                      ISIC=str_sub(ISIC, 2, -2),
                      ISIC=str_replace(ISIC, "ISIC rev.4, A-U", "TOTAL"),
                      indicator= if_else(str_detect(SUBJECT,"YA99"),"EMP_TEMP_SEX_ECO_NB",""),
                      indicator2= if_else(str_detect(SUBJECT,"YW99"),"EES_TEES_SEX_ECO_NB",""),
                      indicator=if_else(indicator!="",indicator,indicator2)) %>%
        select(	-indicator2, -subject,-SUBJECT)
  }
  #New version, to account for changes

  Xp <- X %>% mutate(
    subject=str_replace(subject, "\\(C \\)", "\\(C\\)"),
    subject=str_replace(subject, "\\( R\\)", "\\(R\\)"),
    ISIC= str_extract(subject, "\\([:alpha:]\\)") ,
                      ISIC=str_sub(ISIC, 2, -2),
                      ISIC= if_else( str_detect(subject,"ISIC rev.4, A-U"),"TOTAL",ISIC),
                      indicator= if_else(str_detect(SUBJECT,"YA99"),"EMP_TEMP_SEX_ECO_NB",""),
                      indicator2= if_else(str_detect(SUBJECT,"YW99"),"EES_TEES_SEX_ECO_NB",""),
                      indicator=if_else(indicator!="",indicator,indicator2)) %>%
    filter( !is.na(ISIC)  ) %>%
    select(	-indicator2, -subject,-SUBJECT)

  ### STEP 3 Target dataset consistent with ILOSTAT format () observations names)

  # Observations
  Xpp <- Xp %>% mutate(	classif1=paste0("ECO_ISIC4_",ISIC),
                        sex= sex %>% recode("All persons"="SEX_T","Males"="SEX_M","Females"="SEX_F"))%>%
    select(-ISIC)

  Xpp<-REP_OECD.LFS_ANNUAL_mapping_source(Xpp)

  ### STEP 4 - Working with wide format - consistency check + aggregates

  ##Seeing which categories are missing
  Y<-Xpp %>% spread(classif1, obs_value) %>% select(ECO_ISIC4_TOTAL, everything())
  Y %>% mutate(TOT=rowSums(.[13:(length(Y))],na.rm=TRUE))->Y
  z_name <- colnames(Y[,14:(length(Y))-1])

  #this collects each missing category per observation and concatenates it
  Y <- Y %>% mutate(Miss="")
  for(var in z_name) {
    print(var)
    Y$Miss[is.na(Y[,var])] <- paste0(Y$Miss[is.na(Y[,var])],str_sub(var,-1,-1),"_")
  }

  # this command obtains descriptive data, it turns out a bit more of missing (I discard all but maybe it should be changed)
  #Y %>% group_by(Miss) %>% count() %>% save_ilo()
  # Only X category is allowed to be missing, the rest will be flagged
  Y <- Y %>% mutate(flag=if_else(Miss=="",0,1 )) %>% filter(flag==0)

  ## Cheching the totals, not more than a 3 thousand deviation, also Total existant
  Y <- Y %>% mutate(flag2=abs(Y$TOT-Y$ECO_ISIC4_TOTAL)>3) %>% filter(flag2==FALSE)

  ## aggregates
  #sector aggregate
  Y <- Y %>% mutate(ECO_AGGREGATE_AGR=ECO_ISIC4_A,
                    ECO_AGGREGATE_CON=ECO_ISIC4_F,
                    ECO_AGGREGATE_MAN=ECO_ISIC4_C,
                    ECO_AGGREGATE_MEL=ECO_ISIC4_B+ECO_ISIC4_D+ECO_ISIC4_E,
                    ECO_AGGREGATE_MKT=ECO_ISIC4_G+ECO_ISIC4_H+ECO_ISIC4_I+ECO_ISIC4_J+ECO_ISIC4_K+ECO_ISIC4_L+ECO_ISIC4_M+ECO_ISIC4_N,
                    ECO_AGGREGATE_PUB=ECO_ISIC4_O+ECO_ISIC4_P+ECO_ISIC4_Q+ECO_ISIC4_R+ECO_ISIC4_S+ECO_ISIC4_T+ECO_ISIC4_U,

                    ECO_AGGREGATE_TOTAL=ECO_ISIC4_TOTAL) %>%
    #broad sector
    mutate(ECO_SECTOR_AGR=ECO_AGGREGATE_AGR,
           ECO_SECTOR_IND=ECO_AGGREGATE_CON+ECO_AGGREGATE_MAN+ECO_AGGREGATE_MEL,
           ECO_SECTOR_SER=ECO_AGGREGATE_MKT+ECO_AGGREGATE_PUB,

           ECO_SECTOR_TOTAL=ECO_AGGREGATE_TOTAL) %>%
	# Remove manually computed total
	select(-TOT)

  ### STEP 5 Reshape
  Xpp <- Y %>% 	select(-flag, -flag2, -Miss) %>%
				gather(classif1, obs_value,  -ref_area, -source, -note_source, -sex, -sex_version, -time, -obs_status, -indicator,-classif1_version,  -classif2, -classif2_version) %>%
				filter(!obs_value %in% c(NA, ''), !(classif1 %in% c('ECO_AGGREGATE_X', 'ECO_SECTOR_X', 'ECO_ISIC3_X') & obs_value %in% 0))

  ### STEP 6 Exporting

saveRDS(Xpp,file = './input/ANNUAL_EMP_SEX_ECO_ISIC4.rds' )

#ensure only one object
}

REP_OECD.LFS_ANNUAL_input_ANNUAL_AGE_5YRBANDS <- function(){ # open oecd by 5 yrbands data

  X <- readr::read_csv("./input/ANNUAL_AGE_5YRBANDS.csv", col_type = cols(
  COUNTRY = col_character(),
  Age = col_character(),
  Time = col_integer(),
  SEX = col_character(),
  Value = col_double(),
  Series = col_character()
	)
) %>% select(ref_area = COUNTRY, classif1 = Age, sex = SEX, time = Time, obs_value = Value ,	obs_status = `Flag Codes`, indicator = Series) %>%
			mutate(	sex = sex %>%
				plyr::mapvalues(	from = c("MA", 'FE', 'TT', "MW", "MEN", "WOMEN"),
                         to = c('SEX_M','SEX_F','SEX_T','SEX_T','SEX_M','SEX_F'), warn_missing = FALSE),
				time = as.numeric(time))

  X <- X %>%
    filter(!ref_area %in% 'FTFR') %>%
    mutate(obs_value = as.numeric(obs_value))

  # test if age classification is complete and total is accurate
  Y <- X %>%
    mutate(obs_value = as.numeric(obs_value)) %>% spread(classif1, obs_value)  %>% mutate(TOT = rowSums(.[6:16], na.rm = TRUE))

  # remove inaccurate data
  Y <- Y %>% 	mutate(check = round(as.numeric(Total),1) / round(as.numeric(TOT),1) * 100, test = ifelse(check < 101 | check > 99, TRUE, FALSE)) %>% filter(test %in% FALSE, Unknown %in% NA, !ref_area %in% c('GBR', 'RUS'))  %>%
				distinct(ref_area, sex, indicator, time) %>% mutate(delete = TRUE)
  X <- X %>%
    left_join(Y, by = c("ref_area", "sex", "indicator", "time")) %>%
    filter(!delete %in% TRUE) %>%
    select( - delete)

  rm(Y)

   Y <- X %>%
    mutate(obs_value = as.numeric(obs_value)) %>% spread(classif1, obs_value)  %>% mutate(TOT = rowSums(.[6:16], na.rm = TRUE)) %>% mutate(Total = ifelse(!Unknown %in% NA, TOT, Total)) %>%
		select(ref_area, sex,    time,  indicator, obs_value = Total) %>% mutate(classif1 = 'Total') %>% filter(!obs_value %in% c(0, NA))

  # create the Total AGE
  X <- X %>%
   filter(!classif1 %in% c("Total", "Unknown")) %>% filter(!obs_value %in% c(0, NA)) %>% bind_rows(Y)

   rm(Y)

  AGE_5 <- X %>%    mutate(classif1 = classif1 %>%
             plyr::mapvalues(
               from = 	c("15 to 19", "20 to 24", "25 to 29", "30 to 34", "35 to 39", "40 to 44", "45 to 49", "50 to 54", "55 to 59", "60 to 64", "65+", "Total"),
               to = 	c("AGE_5YRBANDS_Y15-19", "AGE_5YRBANDS_Y20-24", "AGE_5YRBANDS_Y25-29", "AGE_5YRBANDS_Y30-34", "AGE_5YRBANDS_Y35-39", "AGE_5YRBANDS_Y40-44", "AGE_5YRBANDS_Y45-49", "AGE_5YRBANDS_Y50-54", "AGE_5YRBANDS_Y55-59", "AGE_5YRBANDS_Y60-64", "AGE_5YRBANDS_YGE65", "AGE_5YRBANDS_TOTAL")
             )	) %>%
				filter(!obs_value %in% c(NA, ''))

  saveRDS(AGE_5,file = './input/ANNUAL_AGE_5YRBANDS.rds' )
	rm( X, AGE_5)
  invisible(gc(reset = TRUE))
}

REP_OECD.LFS_ANNUAL_input_ANNUAL_AGE_10YRBANDS <- function(){ # open oecd by 10 yrbands data

  X <- readr::read_csv("./input/ANNUAL_AGE_10YRBANDS.csv", col_type = cols(
  COUNTRY = col_character(),
  Age = col_character(),
  Time = col_integer(),
  SEX = col_character(),
  Value = col_double(),
  Series = col_character()
	)
) %>% select(ref_area = COUNTRY, classif1 = Age, sex = SEX, time = Time, obs_value = Value ,	obs_status = `Flag Codes`, indicator = Series) %>%
			mutate(	sex = sex %>%
				plyr::mapvalues(	from = c("MA", 'FE', 'TT', "MW", "MEN", "WOMEN"),
                         to = c('SEX_M','SEX_F','SEX_T','SEX_T','SEX_M','SEX_F'), warn_missing = FALSE),
				time = as.numeric(time))

  X <- X %>% filter(!ref_area %in% 'FTFR') %>%
    mutate(obs_value = as.numeric(obs_value))

  # test if age classification is complete and total is accurate
  Y <- X %>%
    mutate(obs_value = as.numeric(obs_value)) %>% spread(classif1, obs_value)  %>% mutate(TOT = rowSums(.[6:11], na.rm = TRUE))

  # remove inaccurate data
  Y <- Y %>% 	mutate(check = round(as.numeric(Total),1) / round(as.numeric(TOT),1) * 100, test = ifelse(check < 101 | check > 99, TRUE, FALSE))  %>% filter(test %in% FALSE, Unknown %in% NA, !ref_area %in% c('GBR', 'RUS'))  %>%
				distinct(ref_area, sex, indicator, time) %>% mutate(delete = TRUE)
  X <- X %>%
    left_join(Y, by = c("ref_area", "sex", "indicator", "time")) %>%
    filter(!delete %in% TRUE) %>%
    select( - delete)

  rm(Y)

   Y <- X %>%
    mutate(obs_value = as.numeric(obs_value)) %>% spread(classif1, obs_value)  %>% mutate(TOT = rowSums(.[6:11], na.rm = TRUE)) %>% mutate(Total = ifelse(!Unknown %in% NA, TOT, Total)) %>%
		select(ref_area, sex,    time,  indicator, obs_value = Total) %>% mutate(classif1 = 'Total') %>% filter(!obs_value %in% c(0, NA))

  # create the Total AGE
  X <- X %>%
   filter(!classif1 %in% c("Total", "Unknown")) %>% filter(!obs_value %in% c(0, NA)) %>% bind_rows(Y)

   rm(Y)

  AGE_10 <- X %>%
    mutate(classif1 = classif1 %>% plyr::mapvalues(	from = 	c("15 to 24", "25 to 34", "35 to 44", "45 to 54", "55 to 64", "65+", "Total"),
                                                    to = 	c("AGE_10YRBANDS_Y15-24", "AGE_10YRBANDS_Y25-34", "AGE_10YRBANDS_Y35-44", "AGE_10YRBANDS_Y45-54", "AGE_10YRBANDS_Y55-64", "AGE_10YRBANDS_YGE65", "AGE_10YRBANDS_TOTAL")))%>%
				filter(!obs_value %in% c(NA, ''))

  saveRDS(AGE_10,file = './input/ANNUAL_AGE_10YRBANDS.rds' )
  #	X <- readRDS('./input/ANNUAL_AGE_10YRBANDS.rds')

  rm( X, AGE_10)
  invisible(gc(reset = TRUE))

}

REP_OECD.LFS_ANNUAL_input_ANNUAL_AGE_AGGREGATE <- function(){ # open oecd by AGGREGATE and YTHADULT AGE data

 X <- readr::read_csv("./input/ANNUAL_AGE_AGGREGATE.csv", col_type = cols(
  COUNTRY = col_character(),
  Age = col_character(),
  Time = col_integer(),
  SEX = col_character(),
  Value = col_double(),
  Series = col_character()
	)
) %>% select(ref_area = COUNTRY, classif1 = Age, sex = SEX, time = Time, obs_value = Value ,	obs_status = `Flag Codes`, indicator = Series) %>%
			mutate(	sex = sex %>%
				plyr::mapvalues(	from = c("MA", 'FE', 'TT', "MW", "MEN", "WOMEN"),
                         to = c('SEX_M','SEX_F','SEX_T','SEX_T','SEX_M','SEX_F'), warn_missing = FALSE),
				time = as.numeric(time))

  X <- X %>% filter(!ref_area %in% 'FTFR') %>%
    mutate(obs_value = as.numeric(obs_value))

  # test if age classification is complete and total is accurate
  Y <- X %>%
    mutate(obs_value = as.numeric(obs_value)) %>% spread(classif1, obs_value)  %>% mutate(TOT = rowSums(.[6:9], na.rm = TRUE))

  # remove inaccurate data
  Y <- Y %>% 	mutate(check = round(as.numeric(Total),1) / round(as.numeric(TOT),1) * 100, test = ifelse(check < 101 | check > 99, TRUE, FALSE))  %>% filter(test %in% FALSE, Unknown %in% NA, !ref_area %in% c('GBR', 'RUS'))  %>%
				distinct(ref_area, sex, indicator, time) %>% mutate(delete = TRUE)
  X <- X %>%
    left_join(Y, by = c("ref_area", "sex", "indicator", "time")) %>%
    filter(!delete %in% TRUE) %>%
    select( - delete)

  rm(Y)

   Y <- X %>%
    mutate(obs_value = as.numeric(obs_value)) %>% spread(classif1, obs_value)  %>% mutate(TOT = rowSums(.[6:9], na.rm = TRUE)) %>% mutate(Total = ifelse(!Unknown %in% NA, TOT, Total)) %>%
		select(ref_area, sex,    time,  indicator, obs_value = Total) %>% mutate(classif1 = 'Total') %>% filter(!obs_value %in% c(0, NA))

  # create the Total AGE
  X <- X %>%
   filter(!classif1 %in% c("Total", "Unknown")) %>% filter(!obs_value %in% c(0, NA)) %>% bind_rows(Y)

   rm(Y)

  AGE_AGGREGATE <- X %>%
    mutate(classif1 = classif1 %>% plyr::mapvalues(	from = 	c("15 to 24", "25 to 54", "55 to 64", "65+", "Total"),
                                                    to = 	c("AGE_AGGREGATE_Y15-24", "AGE_AGGREGATE_Y25-54", "AGE_AGGREGATE_Y55-64", "AGE_AGGREGATE_YGE65", "AGE_AGGREGATE_TOTAL")))

  AGE_YTHADULT <- AGE_AGGREGATE %>% mutate(classif1 = classif1 %>% plyr::mapvalues(
    from= c("AGE_AGGREGATE_Y15-24", "AGE_AGGREGATE_Y25-54", "AGE_AGGREGATE_Y55-64", "AGE_AGGREGATE_YGE65", "AGE_AGGREGATE_TOTAL"),
    to = c("AGE_YTHADULT_Y15-24", "AGE_YTHADULT_YGE25", "AGE_YTHADULT_YGE25", "AGE_YTHADULT_YGE25", "AGE_YTHADULT_YGE15")
  )) %>%
    group_by(ref_area, indicator, sex, classif1, time) %>%
    summarise(	obs_value = sum(obs_value, na.rm = TRUE)) %>%
    ungroup %>%
				filter(!obs_value %in% c(NA, ''))

  AGE_YTHADULT_15_64 <- AGE_AGGREGATE %>% mutate(classif1 = classif1 %>% plyr::mapvalues(
    from= c("AGE_AGGREGATE_Y15-24", "AGE_AGGREGATE_Y25-54", "AGE_AGGREGATE_Y55-64", "AGE_AGGREGATE_YGE65", "AGE_AGGREGATE_TOTAL"),
    to = c("AGE_YTHADULT_Y15-64", "AGE_YTHADULT_Y15-64", "AGE_YTHADULT_Y15-64", NA, NA)
  )) %>%
	group_by(ref_area, indicator, sex, classif1, time) %>%
    summarise(	obs_value = sum(obs_value, na.rm = TRUE)) %>%
    ungroup %>%
				filter(!obs_value %in% c(NA, ''), !classif1 %in% NA)

  saveRDS(bind_rows(AGE_AGGREGATE, AGE_YTHADULT, AGE_YTHADULT_15_64),file = './input/ANNUAL_AGE_AGGREGATE.rds' )
  #	X <- readRDS('./input/ANNUAL_AGE_AGGREGATE.rds')

  rm( X, AGE_YTHADULT, AGE_AGGREGATE)
  invisible(gc(reset = TRUE))

}

REP_OECD.LFS_ANNUAL_input_ANNUAL_AGE <- function(){ # back AGE with result combine and add notes create emp_rt, eap_rt, une_rt

  X <- bind_rows( readRDS('./input/ANNUAL_AGE_5YRBANDS.rds'),
                  readRDS('./input/ANNUAL_AGE_10YRBANDS.rds'),
                  readRDS('./input/ANNUAL_AGE_AGGREGATE.rds')) %>%
    mutate(	     indicator = indicator %>% plyr::mapvalues(	from = 	c("Employment", "Labour Force", "Population", "Unemployment"),
                                                       to = c("EMP_TEMP_SEX_AGE_NB", "EAP_TEAP_SEX_AGE_NB", "POP_XWAP_SEX_AGE_NB", "UNE_TUNE_SEX_AGE_NB")	))

  # test total all equal
  X %>% filter(classif1 %in% c('AGE_5YRBANDS_TOTAL', 'AGE_10YRBANDS_TOTAL', 'AGE_AGGREGATE_TOTAL')) %>%
  spread(classif1, obs_value)

  # add source

  ReadMeSource <- readxl::read_excel(paste0("./ReadME_OECD_LFS_ANNUAL.xlsx"), sheet="MappingSource") %>%
    mutate(ID = substr(ID,1,3)) %>% rename(ref_area = ID, source = REF)

  X <- X %>% left_join(ReadMeSource, by = "ref_area")

  ########## backup formaer mapping from ODR done by YZ in 2013
  # require(ilo)
  # init_ilo()
  # Y <- get_ilo(collection = 'ODR')
  # Y <- Y %>% filter(indicator %in% c("EMP_TEMP_SEX_AGE_NB", "EAP_TEAP_SEX_AGE_NB", "POP_XWAP_SEX_AGE_NB", "UNE_TUNE_SEX_AGE_NB"))
  # Y <- Y %>% group_by(ref_area, indicator, time) %>% summarise(note_source = first(note_source))	%>% ungroup

  # Y %>% readr::write_csv(paste0("./input\\backupnote.csv"))

  Y <- readr::read_csv(paste0("./help/backupnote.csv"))
  # cleaning unuseful notes
  Y <- Y %>% mutate(
    note_source = gsub('R1:2383_','',note_source,fixed = TRUE),
    note_source = gsub('S3:5_','',note_source,fixed = TRUE),
    note_source = gsub('S3:9_','',note_source,fixed = TRUE),
    note_source = gsub('S3:14_','',note_source,fixed = TRUE),
    note_source = gsub('S3:1490_','',note_source,fixed = TRUE),
    note_source = gsub('S3:19_','',note_source,fixed = TRUE),
    note_source = gsub('S3:20_','',note_source,fixed = TRUE),
    note_source = gsub('S3:16_','',note_source,fixed = TRUE),
    note_source = gsub('S3:2882_','',note_source,fixed = TRUE),
    note_source = gsub('S3:2883_','',note_source,fixed = TRUE),
    note_source = gsub('S3:2885_','',note_source,fixed = TRUE),
    note_source = gsub('S4:29_','',note_source,fixed = TRUE),
    note_source = gsub('S4:34_','',note_source,fixed = TRUE),
    note_source = gsub('S5:37_','',note_source,fixed = TRUE),
    note_source = gsub('S5:38_','',note_source,fixed = TRUE),
    note_source = gsub('S5:39_','',note_source,fixed = TRUE),
    note_source = gsub('S5:40_','',note_source,fixed = TRUE),
    note_source = gsub('S5:41_','',note_source,fixed = TRUE),
    note_source = gsub('S5:352_','',note_source,fixed = TRUE),
    note_source = gsub('S5:356_','',note_source,fixed = TRUE)
  )

  Y <- Y %>% distinct(ref_area, indicator, .keep_all = TRUE)
  LAST_NOTE <- Y %>% arrange(time) %>% group_by(ref_area, indicator) %>% summarise(time = first(time), note_source = first(note_source)) %>% ungroup

  X <- left_join(X, Y, by = c("ref_area", "indicator", "time")) %>% mutate(note_source = ifelse(note_source %in% NA, 'R1:2382_T2:84_T3:89', note_source),
                                                                          note_source = ifelse(ref_area %in% 'RUS','R1:2382_T2:84_T3:102',note_source ),
                                                                          note_source = ifelse(ref_area %in% 'JPN' & time %in% '2011','R1:2382_S4:34_T2:84_T3:102',note_source )
  )

  ANNUAL_AGE <- X  %>% mutate(classif2 = NA) %>% ilo:::switch_ilo(version)

  #calculate indicator rate

  UNE_DEAP_SEX_AGE_RT  <- 	bind_rows(
    ANNUAL_AGE %>%
      filter(	indicator%in%"UNE_TUNE_SEX_AGE_NB"),
    ANNUAL_AGE %>%
      filter(	indicator%in%"EAP_TEAP_SEX_AGE_NB")  %>% select(-contains('notes'))
  ) %>% spread (indicator, obs_value) %>%
    mutate(obs_value = round(UNE_TUNE_SEX_AGE_NB / EAP_TEAP_SEX_AGE_NB * 100,3)) %>%
    filter(!obs_value %in% NA) %>%
    select(-UNE_TUNE_SEX_AGE_NB, -EAP_TEAP_SEX_AGE_NB) %>%
    mutate(indicator = 'UNE_DEAP_SEX_AGE_RT')

  EAP_DWAP_SEX_AGE_RT  <- 	bind_rows(
    ANNUAL_AGE %>%
      filter(	indicator%in%"EAP_TEAP_SEX_AGE_NB"),
    ANNUAL_AGE %>%
      filter(	indicator%in%"POP_XWAP_SEX_AGE_NB")  %>% select(-contains('notes'))
  ) %>% spread (indicator, obs_value) %>%
    mutate(obs_value = round(EAP_TEAP_SEX_AGE_NB / POP_XWAP_SEX_AGE_NB * 100,3)) %>%
    filter(!obs_value %in% NA) %>%
    select(-EAP_TEAP_SEX_AGE_NB, -POP_XWAP_SEX_AGE_NB) %>%
    mutate(indicator = 'EAP_DWAP_SEX_AGE_RT')

  EMP_DWAP_SEX_AGE_RT  <- 	bind_rows(
    ANNUAL_AGE %>%
      filter(	indicator%in%"EMP_TEMP_SEX_AGE_NB"),
    ANNUAL_AGE %>%
      filter(	indicator%in%"POP_XWAP_SEX_AGE_NB")  %>% select(-contains('notes'))
  ) %>% spread (indicator, obs_value) %>%
    mutate(obs_value = round(EMP_TEMP_SEX_AGE_NB / POP_XWAP_SEX_AGE_NB * 100,3)) %>%
    filter(!obs_value %in% NA) %>%
    select(-EMP_TEMP_SEX_AGE_NB, -POP_XWAP_SEX_AGE_NB) %>%
    mutate(indicator = 'EMP_DWAP_SEX_AGE_RT')

    EIP_TEIP_SEX_AGE_NB  <- 	bind_rows(
    ANNUAL_AGE %>%
      filter(	indicator%in%"EAP_TEAP_SEX_AGE_NB"),
    ANNUAL_AGE %>%
      filter(	indicator%in%"POP_XWAP_SEX_AGE_NB")  %>% select(-contains('notes'))
  ) %>% spread (indicator, obs_value) %>%
    mutate(obs_value = round(POP_XWAP_SEX_AGE_NB - EAP_TEAP_SEX_AGE_NB , 3)) %>%
    filter(!obs_value %in% NA) %>%
    select(-EAP_TEAP_SEX_AGE_NB, -POP_XWAP_SEX_AGE_NB) %>%
    mutate(indicator = 'EIP_TEIP_SEX_AGE_NB')

  EIP_DWAP_SEX_AGE_RT  <- 	bind_rows(EIP_TEIP_SEX_AGE_NB,
    ANNUAL_AGE %>%
      filter(	indicator%in%"POP_XWAP_SEX_AGE_NB")  %>% select(-contains('notes'))
  ) %>% spread (indicator, obs_value) %>%
    mutate(obs_value = round(EIP_TEIP_SEX_AGE_NB / POP_XWAP_SEX_AGE_NB * 100,3)) %>%
    filter(!obs_value %in% NA) %>%
    select(-EIP_TEIP_SEX_AGE_NB, -POP_XWAP_SEX_AGE_NB) %>%
    mutate(indicator = 'EIP_DWAP_SEX_AGE_RT')

  saveRDS(
			bind_rows(ANNUAL_AGE,EAP_DWAP_SEX_AGE_RT, UNE_DEAP_SEX_AGE_RT, EMP_DWAP_SEX_AGE_RT, EIP_TEIP_SEX_AGE_NB,EIP_DWAP_SEX_AGE_RT ) %>%
				select(-contains('_version')) %>%
				filter(!obs_value %in% c(NA, ''))
				,file = './input/ANNUAL_AGE.rds' )
  #	X <- readRDS('./input/ANNUAL_AGE.rds')

  rm(EAP_DWAP_SEX_AGE_RT, UNE_DEAP_SEX_AGE_RT, EMP_DWAP_SEX_AGE_RT, X, Y,   ANNUAL_AGE, LAST_NOTE, ReadMeSource)
  invisible(gc(reset = TRUE))
}

REP_OECD.LFS_ANNUAL_input_ANNUAL_ANNUAL_AGE_DUR <- function(){ # processing of "UNE_TUNE_SEX_AGE_DUR_NB
  # open oecd by unemployment by age and duration

  X <- readr::read_csv("./input/ANNUAL_UNE_AGE_DUR.csv", col_type = cols(
  COUNTRY = col_character(),
  Age = col_character(),
  Time = col_integer(),
  SEX = col_character(),
  Value = col_double(),
  Series = col_character()
	)
) %>% select(ref_area = COUNTRY, classif1 = Age, classif2  = Duration, sex = SEX, time = Time, obs_value = Value ,	obs_status = `Flag Codes`) %>%
filter(!ref_area %in% c('FTFR'))  %>%
			mutate(	sex = sex %>%
				plyr::mapvalues(	from = c("MA", 'FE', 'TT', "MW", "MEN", "WOMEN"),
                         to = c('SEX_M','SEX_F','SEX_T','SEX_T','SEX_M','SEX_F'), warn_missing = FALSE),
				time = as.numeric(time))  %>% 		filter(!classif2 %in% 'Total Declared') %>%
        mutate(	indicator = 'UNE_TUNE_SEX_AGE_NB',
            classif1 = classif1 %>% plyr::mapvalues(	from = 	c("15 to 24", "25 to 54", "55+", "Total"),
                                                     to = 	c("AGE_AGGREGATE_Y15-24", "AGE_AGGREGATE_Y25-54", "AGE_AGGREGATE_Y55-64", "AGE_AGGREGATE_TOTAL")))

  DUR_AGGREGATE <- X %>% mutate(classif2 = classif2 %>% plyr::mapvalues(
    from= c("< 1 month", "> 1 month and < 3 months", "> 3 month and < 6 months", "> 6 month and < 1 year", "1 year and over", "Total", "Unknown"),
    to = c("DUR_AGGREGATE_MLT6", "DUR_AGGREGATE_MLT6", "DUR_AGGREGATE_MLT6", "DUR_AGGREGATE_MGE6LT12", "DUR_AGGREGATE_MGE12", "DUR_AGGREGATE_TOTAL", "DUR_AGGREGATE_X")
  ))	%>%
    group_by(ref_area, indicator, sex, classif1, classif2, time) %>%
    summarise(	obs_value = sum(obs_value, na.rm = TRUE)) %>%
    ungroup

  DUR_DETAILS <- X %>% mutate(classif2 = classif2 %>% plyr::mapvalues(
    from= c("< 1 month", "> 1 month and < 3 months", "> 3 month and < 6 months", "> 6 month and < 1 year", "1 year and over", "Total", "Unknown"),
    to = c("DUR_DETAILS_MLT1", "DUR_DETAILS_MGE1LT3", "DUR_DETAILS_MGE3LT6", "DUR_DETAILS_MGE6LT12", "DUR_DETAILS_MGE12LT24", "DUR_DETAILS_TOTAL", "DUR_DETAILS_X")
  ))

  DUR_DETAILS <- DUR_DETAILS %>% mutate(note_classif = ifelse(classif2 %in% 'DUR_DETAILS_MGE12LT24', 'C7:3716',NA ))

  require(ilo)
  init_ilo()

  DUR_AGGREGATE <- DUR_AGGREGATE %>% switch_ilo(version) %>% group_by(ref_area, classif1, sex, time) %>%
			mutate(test = paste0(unique(classif2), collapse = ' / ')) %>% ungroup %>% filter(!test %in% c('DUR_AGGREGATE_TOTAL / DUR_AGGREGATE_X', 'DUR_AGGREGATE_X / DUR_AGGREGATE_TOTAL'))

  DUR_DETAILS <- DUR_DETAILS %>% switch_ilo(version) %>% group_by(ref_area, classif1, sex, time) %>%
			mutate(test = paste0(unique(classif2), collapse = ' / ')) %>% ungroup %>% filter(!test %in% c('DUR_DETAILS_TOTAL / DUR_DETAILS_X', 'DUR_DETAILS_X / DUR_DETAILS_TOTAL'))

  DUR_AGE_AGGREGATE <- bind_rows(DUR_DETAILS, DUR_AGGREGATE)

  # test quality

  DUR_AGE_YTHADULT <- DUR_AGE_AGGREGATE %>%
    mutate(classif1 = classif1 %>% plyr::mapvalues(
      from= c("AGE_AGGREGATE_Y15-24", "AGE_AGGREGATE_Y25-54", "AGE_AGGREGATE_Y55-64", "AGE_AGGREGATE_TOTAL"),
      to = c("AGE_YTHADULT_Y15-24", "AGE_YTHADULT_YGE25", "AGE_YTHADULT_YGE25", "AGE_YTHADULT_YGE15")
    )) %>%
    group_by(ref_area, indicator, sex, classif1, classif2, time) %>%
    summarise(	obs_value = sum(obs_value, na.rm = TRUE),
               note_classif = first(note_classif)) %>%
    ungroup

  DUR_AGE_AGGREGATE <- DUR_AGE_AGGREGATE %>%
    mutate(note_classif = ifelse(classif1 %in% 'AGE_AGGREGATE_Y55-64', paste0(note_classif, '_C6:2343'), note_classif),
           note_classif = gsub('NA_', '', note_classif, fixed = TRUE))

  ANNUAL_UNE_AGE_DUR <- bind_rows(DUR_AGE_YTHADULT, DUR_AGE_AGGREGATE)

  ############ add note and source

  ANNUAL_UNE_AGE_DUR <- left_join(	ANNUAL_UNE_AGE_DUR,
                                   readRDS('./input/ANNUAL_AGE.rds') %>% filter(indicator %in% 'UNE_TUNE_SEX_AGE_NB') %>% distinct(ref_area, indicator, time, source, note_source), by = c('ref_area', 'indicator', 'time')) %>%
    mutate(indicator = 'UNE_TUNE_SEX_AGE_DUR_NB') %>%
				filter(!obs_value %in% c(NA, ''))

  saveRDS(ANNUAL_UNE_AGE_DUR,file = './input/ANNUAL_UNE_AGE_DUR.rds' )
  #	X <- readRDS('./input/ANNUAL_AGE.rds')

  rm(DUR_AGE_YTHADULT, DUR_AGE_AGGREGATE, DUR_DETAILS, DUR_AGGREGATE, X, ANNUAL_UNE_AGE_DUR)
  invisible(gc(reset = TRUE))
}

REP_OECD.LFS_ANNUAL_input_ANNUAL_ANNUAL_EMP_STE <- function(){	# processing of EMP_TEMP_SEX_STE_NB

  X <- readr::read_csv("./input/ANNUAL_EMP_STE.csv", col_type = cols(
  LOCATION = col_character(),
  Subject = col_character(),
  Time = col_integer(),
  SEX = col_character(),
  Value = col_double(),
  Series = col_character()
	)
) %>% select(ref_area = LOCATION, sex = SEX, time = Time, obs_value = Value ,	obs_status = `Flag Codes`, classif1 = Subject) %>%
			mutate(	sex = sex %>%
				plyr::mapvalues(	from = c("MA", 'FE', 'TT', "MW", "MEN", "WOMEN"),
                         to = c('SEX_M','SEX_F','SEX_T','SEX_T','SEX_M','SEX_F'), warn_missing = FALSE),
				time = as.numeric(time)) %>%
    mutate(
      classif1 = classif1 %>%
        plyr::mapvalues(	from = c("Civil Employment all status, all activities", "Employees in all activities", "Employers and persons working on own account all activities",  "Unpaid family workers all activities"),
                         to = c('STE_ICSE93_TOTAL','STE_ICSE93_1','STE_ICSE93_3','STE_ICSE93_5')))

  # remove inaccurate data
  X <- X %>% mutate(obs_value = as.numeric(as.character(obs_value))) %>% filter(!obs_value %in% c(0, '0', NA))

  ######### delete obvious error the recalculate them

  X <- X %>%   filter(
    !(ref_area %in% 'TUR' & as.character(time) %in% c('1960','1961', '1965')),
    !(ref_area %in% 'USA' & as.character(time)%in% c('1955','1956', '1957', '1958', '1959', '1960', '1961', '1962') & sex %in% c('SEX_F','SEX_M')),
    !(ref_area %in% 'NZL' & as.character(time) %in% c('1957','1958', '1959', '1960') & classif1 %in% 'STE_ICSE93_1')
  )

  X <- X %>% arrange(desc(sex)) %>% group_by(ref_area, classif1, time) %>% mutate(test = paste0(sex, collapse = ' ')) %>% ungroup

  unique(X$test)

  ADD1 <- X %>% filter(test %in% 'SEX_T SEX_F') %>% group_by(ref_area, classif1, time) %>% summarise(sex = 'SEX_M', obs_value = first(obs_value) - last(obs_value), obs_status = first(obs_status)) %>% ungroup
  ADD2 <- X %>% filter(test %in% 'SEX_M SEX_F') %>% group_by(ref_area, classif1, time) %>% summarise(sex = 'SEX_T', obs_value = first(obs_value) + last(obs_value), obs_status = first(obs_status)) %>% ungroup

  X <- bind_rows(X, ADD1, ADD2) %>% arrange(ref_area, time)

  X %>% arrange(desc(classif1)) %>% group_by(ref_area, sex, time) %>% mutate(test = paste0(classif1, collapse = ' ')) %>% ungroup -> X

  unique(X$test)

  ADD1 <- X %>% filter(test %in% 'STE_ICSE93_3 STE_ICSE93_1') %>% group_by(ref_area, sex, time) %>% summarise(classif1 = 'STE_ICSE93_TOTAL', obs_value = first(obs_value) + last(obs_value), obs_status = first(obs_status)) %>% ungroup
  ADD2 <- X %>% filter(test %in% 'STE_ICSE93_TOTAL STE_ICSE93_1') %>% group_by(ref_area, sex, time) %>% summarise(classif1 = 'STE_ICSE93_3', obs_value = first(obs_value) - last(obs_value), obs_status = first(obs_status)) %>% ungroup

  X <- bind_rows(X, ADD1) %>% arrange(ref_area, time)

  X %>% arrange(desc(classif1), desc(sex)) %>% mutate(REF = paste0(substr(sex, 5,5), '_', stringr::str_sub(classif1,12,-1))) %>% group_by(ref_area, time) %>% mutate(test = paste0(REF, collapse = ' ')) %>% ungroup %>% select(-REF) -> X

  X %>% filter(!test %in% c(	'T_TOTAL M_TOTAL F_TOTAL',
                             'T_TOTAL',
                             'T_1')) %>% select(-test)-> X

  STE_AGGREGATEPLUS <- X %>%
    mutate(classif1  = classif1 %>% plyr::mapvalues(from = c("STE_ICSE93_TOTAL", "STE_ICSE93_1", "STE_ICSE93_3", 'STE_ICSE93_5'),
                                                    to = c("STE_AGGREGATE_TOTAL", "STE_AGGREGATE_EES", "STE_AGGREGATE_SLF", 'STE_AGGREGATE_SLF'))) %>%
    group_by(ref_area,sex,time, classif1) %>%
    summarise(obs_value = sum(obs_value, na.rm = TRUE), obs_status = first(obs_status)) %>% ungroup

  X %>% arrange(desc(classif1), desc(sex)) %>% mutate(REF = paste0(substr(sex, 5,5), '_', stringr::str_sub(classif1,12,-1))) %>% group_by(ref_area, time) %>% mutate(test = paste0(REF, collapse = ' ')) %>% ungroup %>% select(-REF) -> X

  X %>% filter(!test %in% c(	'T_TOTAL M_TOTAL F_TOTAL T_1 M_1 F_1',
                             'T_TOTAL M_TOTAL F_TOTAL T_1',
                             'T_TOTAL T_1',
                             'T_TOTAL M_TOTAL F_TOTAL T_3 T_1',
                             'T_TOTAL T_3 T_1',
                             'T_TOTAL M_TOTAL F_TOTAL T_3 M_3 F_3 T_1 M_1 F_1',
                             'T_TOTAL M_TOTAL F_TOTAL T_3 T_1 M_1 F_1')) %>% select(-test)-> X

  STE <- bind_rows(X,STE_AGGREGATEPLUS )

  # STE %>%  mutate(test = paste0(substr(sex,5,5), '_', stringr::str_sub(classif1,12,-1))) %>% select(ref_area:obs_value, test) %>% select(-sex, -classif1) %>% spread(test , obs_value) %>% save_ilo()

  STE <- STE %>% arrange(ref_area, time, obs_status) %>% group_by(ref_area, time) %>% mutate(obs_status = first(obs_status)) %>% ungroup() %>%arrange(ref_area, time, desc(sex), classif1)

  # X %>% select(-obs_status) %>% spread(classif1, obs_value) -> Y

  REF <- readRDS('./input/ANNUAL_AGE.rds')  %>% filter(indicator %in% 'EMP_TEMP_SEX_AGE_NB') %>% distinct(ref_area, source,note_source) %>% group_by(ref_area, source ) %>% summarise(note_source = last(note_source)) %>% ungroup

  STE <- STE %>% left_join( REF, by = "ref_area")

  STE <- STE %>% mutate(indicator = 'EMP_TEMP_SEX_STE_NB') %>%
  mutate(
    obs_status = ifelse(obs_status %in% 'Break', 'B', NA),
    note_source = ifelse(obs_status %in% 'B' & note_source %in% NA, 'I11:264', note_source),
    note_source = ifelse(obs_status %in% 'B' & !note_source %in% NA, paste0(note_source, '_I11:264'), note_source)
  )	%>%
				filter(!obs_value %in% c(NA, ''))

  saveRDS(STE,file = './input/ANNUAL_STE.rds' )
  #	X <- readRDS('./input/ANNUAL_STE.rds')

  # STE %>% select(ref_area:obs_value) %>% mutate(test  = paste0(substr(sex, 5,5), '_', stringr::str_sub(classif1,12,-1))) %>% select(-sex, -classif1) %>% spread(test, obs_value)

  # test with emp by age and add missing on age

  # Y %>% left_join(
  # ANNUAL_AGE %>% filter(indicator %in% 'EMP_TEMP_SEX_AGE_NB', classif1 %in% 'AGE_AGGREGATE_TOTAL') %>% select(ref_area, sex, time, obs_value) %>% rename(AGE = obs_value)
  # ) %>% 	filter(AGE %in% NA) %>%
  # select(ref_area, sex,  time, STE_ICSE93_TOTAL) %>%
  # rename(obs_value = STE_ICSE93_TOTAL) %>%
  # mutate(classif1 = 'AGE_AGGREGATE_TOTAL', indicator = 'EMP_TEMP_SEX_AGE_NB') %>%
  # left_join(LAST_NOTE %>% filter(indicator %in% 'EMP_TEMP_SEX_AGE_NB') %>% distinct(ref_area, note_source)) %>%
  # left_join(ANNUAL_AGE %>% distinct(ref_area, source)) -> NEW

  # ANNUAL_AGE <- bind_rows(ANNUAL_AGE, NEW) %>% filter(!note_source %in% NA) %>% filter(!obs_value %in% NA)
  # rm(NEW)

  # TEST <- Y %>% filter((STE_ICSE93_3 %in% NA & STE_ICSE93_5 %in% NA) | (STE_ICSE93_3 %in% 0 & STE_ICSE93_5 %in% 0) | STE_ICSE93_3 %in% c(0, NA) | STE_ICSE93_TOTAL %in% NA) %>% select(ref_area, sex, time) %>% mutate(delete = TRUE)

  # X <- X %>% left_join(TEST) %>% filter(!delete %in% TRUE) %>% select( -delete) %>% filter(!obs_value %in% 0)

  # rm(TEST)

  # X  %>% select(-obs_status) %>% spread(classif1, obs_value) -> Y

  # TEST <- Y %>% filter(STE_ICSE93_5 %in% NA) %>% distinct(ref_area,   sex,  time) %>% mutate(keep = TRUE)

  # STE_AGGREGATE <- X %>% left_join(TEST) %>% filter(keep %in% TRUE) %>% select(-keep) %>%
  # mutate(classif1  = classif1 %>% plyr::mapvalues(from = c("STE_ICSE93_TOTAL", "STE_ICSE93_1", "STE_ICSE93_3"),
  # to = c("STE_AGGREGATE_TOTAL", "STE_AGGREGATE_EES", "STE_AGGREGATE_SLF")))

  # STE_ISCE93 <- X %>% left_join(TEST) %>% filter(!keep %in% TRUE) %>% select(-keep)

  # STE_AGGREGATEPLUS <- STE_ISCE93 %>%
  # mutate(classif1  = classif1 %>% plyr::mapvalues(from = c("STE_ICSE93_TOTAL", "STE_ICSE93_1", "STE_ICSE93_3", 'STE_ICSE93_5'),
  # to = c("STE_AGGREGATE_TOTAL", "STE_AGGREGATE_EES", "STE_AGGREGATE_SLF", 'STE_AGGREGATE_SLF'))) %>%
  # group_by(ref_area,sex,time, classif1) %>%
  # summarise(obs_value = sum(obs_value), obs_status = first(obs_status)) %>% ungroup

  # STE_ISCE93 <- STE_ISCE93 %>% mutate(note_classif = ifelse(classif1 %in% 'STE_ICSE93_3', 'C2:975', NA))

  # STE <- bind_rows(STE_ISCE93, STE_AGGREGATEPLUS, STE_AGGREGATE) %>% left_join(
  # ANNUAL_AGE %>% filter(indicator %in% 'EMP_TEMP_SEX_AGE_NB', classif1 %in% 'AGE_AGGREGATE_TOTAL') %>% distinct(ref_area, time, source, note_source)
  # ) %>% filter(!note_source %in% NA) %>%
  # mutate(indicator = 'EMP_TEMP_SEX_STE_NB')

  rm( STE_AGGREGATEPLUS)
  invisible(gc(reset = TRUE))

}

REP_OECD.LFS_ANNUAL_mapping_source <- function (DataWithoutSource) {  # Utility to get source and note_source- with cleaning (Specific to OECD data)

  ReadMeSource <- readxl::read_excel(paste0("./ReadME_OECD_LFS_ANNUAL.xlsx"), sheet="MappingSource") %>%
    mutate(ID = substr(ID,1,3)) %>% rename(ref_area = ID, source = REF)

  X <- DataWithoutSource %>% left_join(ReadMeSource)

  Y <- readr::read_csv(paste0("./help/backupnote.csv"))

  # cleaning unuseful notes
  Y <- Y %>% mutate(
    note_source = gsub('R1:2383_','',note_source,fixed = TRUE),
    note_source = gsub('S3:5_','',note_source,fixed = TRUE),
    note_source = gsub('S3:9_','',note_source,fixed = TRUE),
    note_source = gsub('S3:14_','',note_source,fixed = TRUE),
    note_source = gsub('S3:1490_','',note_source,fixed = TRUE),
    note_source = gsub('S3:19_','',note_source,fixed = TRUE),
    note_source = gsub('S3:20_','',note_source,fixed = TRUE),
    note_source = gsub('S3:16_','',note_source,fixed = TRUE),
    note_source = gsub('S3:2882_','',note_source,fixed = TRUE),
    note_source = gsub('S3:2883_','',note_source,fixed = TRUE),
    note_source = gsub('S3:2885_','',note_source,fixed = TRUE),
    note_source = gsub('S4:29_','',note_source,fixed = TRUE),
    note_source = gsub('S4:34_','',note_source,fixed = TRUE),
    note_source = gsub('S5:37_','',note_source,fixed = TRUE),
    note_source = gsub('S5:38_','',note_source,fixed = TRUE),
    note_source = gsub('S5:39_','',note_source,fixed = TRUE),
    note_source = gsub('S5:40_','',note_source,fixed = TRUE),
    note_source = gsub('S5:41_','',note_source,fixed = TRUE),
    note_source = gsub('S5:352_','',note_source,fixed = TRUE),
    note_source = gsub('S5:356_','',note_source,fixed = TRUE)
  )

  Y <- Y %>% distinct(ref_area, indicator, .keep_all = TRUE)
  LAST_NOTE <- Y %>% arrange(time) %>% group_by(ref_area, indicator) %>% summarise(time = first(time), note_source = first(note_source)) %>% ungroup

  X <- left_join(X, Y, by = c("ref_area", "indicator", "time")) %>% mutate(note_source = ifelse(note_source %in% NA, 'R1:2382_T2:84_T3:89', note_source),
                                                                           note_source = ifelse(ref_area %in% 'RUS','R1:2382_T2:84_T3:102',note_source ),
                                                                           note_source = ifelse(ref_area %in% 'JPN' & time %in% '2011','R1:2382_S4:34_T2:84_T3:102',note_source )
  )

  DataWithSource <- X %>% select(ref_area, source, sex:note_source) %>% mutate(classif2 = NA) %>% ilo:::switch_ilo(version)
  DataWithSource}

REP_OECD_LFS_ANNUAL_download <- function(REF){
# REF <- Mapping_File %>% slice(1)

cleanTemp <- list.files('C:\\temp\\') %>% as_data_frame %>% filter(value %>% str_detect('\\.'))
if(nrow(cleanTemp) > 0) {for (i in 1:nrow(cleanTemp)){unlink(paste0('C:\\temp\\', cleanTemp$value[i]))} }; rm(cleanTemp)

require(RSelenium)
shell('java -jar  C:/R/library/RSelenium/bin/selenium-server-standalone.jar', wait   = FALSE)
	Sys.sleep(10)

# startServer(dir = 'C://R//library//RSelenium//bin/', args = NULL, log = FALSE)

fprof <- makeFirefoxProfile(list( browser.download.dir = "C:\\temp"
                                , browser.download.folderList = 2L
                                , browser.download.autohideButton = TRUE
                                , browser.download.animateNotification = TRUE
								, network.proxy.autoconfig_url = 'http://proxyos.ilo.org:8080'
								, network.proxy.http = 'proxyos.ilo.org'
								, network.proxy.http_port = 8080L
								, network.proxy.ftp = 'proxyos.ilo.org'
								, network.proxy.ftp_port = 8080L
								, network.proxy.socks = 'proxyos.ilo.org'
								, network.proxy.socks_port = 8080L
								, network.proxy.ssl = 'proxyos.ilo.org'
								, network.proxy.ssl_port = 8080L
								, network.proxy.type = 4L
								, browser.download.manager.showWhenStarting = FALSE
                                , browser.helperApps.alwaysAsk.force = FALSE
								, browser.download.manager.alertOnEXEOpen = FALSE
								, browser.download.manager.focusWhenStarting = FALSE
								, browser.download.manager.useWindow = FALSE
								, browser.download.manager.showWhenStarting = FALSE
								, browser.download.manager.showAlertOnComplete = FALSE
                                , browser.helperApps.neverAsk.saveToDisk = "application/text/csv"))
#RSelenium::startServer()
remDr <- remoteDriver(extraCapabilities = fprof)
remDr$open()

remDr$navigate(REF$URL) # go to query webpage

	Sys.sleep(10)

remDr$executeScript("redirectToSurvey('csv');") # open csv download pop up

remDr$switchToFrame('DialogFrame')

	Sys.sleep(10)

remDr$findElement('id', 'divExportToCSV2')$findChildElement('id' , '_ctl12_rbCustomLayout')$clickElement()
	Sys.sleep(3)
#remDr$findElement('id', 'divExportToCSV2')$findChildElement('id' , '_ctl12_cbLabel')$clickElement() ########## keep label
# 	Sys.sleep(3)
remDr$findElement('id', 'divExportToCSV2')$findChildElement('id' , '_ctl12_btnExportCSV')$clickElement()
	Sys.sleep(100)

try(remDr$close(), silent = TRUE)
remDr$closeServer()

test <- list.files("C:\\temp\\")
test <- test[substr(test, nchar(test)-3, nchar(test)) %in% '.csv']
file.rename(paste0("C:\\temp\\",test),paste0(INPUT, REF$NAME,'.csv'))
invisible(gc(reset = TRUE))

}

REP_OECD_LFS_ANNUAL_download_SDMX <- function(REF){

	require(OECD)
	dstruc <- get_data_structure(REF$dataset)
	startdate <- 1920
	enddate <- str_sub(Sys.time(),1,4 ) %>% as.numeric

	X <- NULL
	for (j in startdate:enddate){
		y <- NULL
		test <- try(y <- get_dataset(	dataset = REF$dataset, filter = REF$query, start_time = j, end_time = j, pre_formatted = TRUE), silent =TRUE)
		if(!class(test)[1] %in% "try-error") X <- bind_rows(X, y)
		rm(y)
	}
	colnames(X) <- tolower(colnames(X))

	test_loc <- paste0(colnames(X), collapse = '') %>% str_detect('location')
	if(test_loc) X <- X %>% rename(ref_area = location)
	test_cou <- paste0(colnames(X), collapse = '') %>% str_detect('country')
	if(test_cou) X <- X %>% rename(ref_area = country)

	X <- X %>% rename(time = obstime, obs_value = obsvalue) %>%
				mutate(	sex = sex %>%
				plyr::mapvalues(	from = c("MA", 'FE', 'TT', "MW", "MEN", "WOMEN"),
                         to = c('SEX_M','SEX_F','SEX_T','SEX_T','SEX_M','SEX_F'), warn_missing = FALSE),
				time = as.numeric(time))

	test_sub <- paste0(colnames(X), collapse = '') %>% str_detect('subject')
	if(test_sub) {
			X <- X %>% rename(SUBJECT = subject) %>%
		left_join(dstruc$SUBJECT %>% rename(SUBJECT = id, subject = label), by = 'SUBJECT') %>%
		mutate(subject = str_trim(subject))
	}
	test_ser <- paste0(colnames(X), collapse = '') %>% str_detect('series')
	if(test_ser) {
			X <- X %>% rename(test = series) %>%
		left_join(dstruc$SERIES %>% rename(test = id, series = label), by = 'test') %>% select(-test) %>%
		mutate(series = str_trim(series))
	}
	test_age <- paste0(colnames(X), collapse = '') %>% str_detect('age')
	if(test_age) {
			X <- X %>% rename(test = age) %>% mutate(test = as.character(test) ) %>%
		left_join(dstruc$AGE %>% rename(test = id, age = label), by = 'test') %>% select(-test) %>%
		mutate(age = str_trim(age))
	}
	test_dur <- paste0(colnames(X), collapse = '') %>% str_detect('duration')
	if(test_dur) {
			X <- X %>% rename(test = duration) %>% mutate(test = as.character(test) ) %>%
		left_join(dstruc$DURATION %>% rename(test = id, duration = label), by = 'test') %>% select(-test) %>%
		mutate(duration = str_trim(duration))
	}

X %>% data.table:::fwrite(paste0(INPUT, REF$NAME,'.csv'), na = "")
invisible(gc(reset = TRUE))

}

OECD_SDMX <- function(dsd){

require(xml2)

Sys.setenv(http_proxy="proxyos.ilo.org:8080")
Sys.setenv(https_proxy="proxyos.ilo.org:8080")
Sys.setenv(ftp_proxy="proxyos.ilo.org:8080")

		'http://www.ilo.org/ilostat/sdmx/ws/rest/data/ILO,DF_STI_ALB_EMP_TEMP_SEX_AGE_NB?format=compact_2_1'

dsd <- 	'https://stats.oecd.org/restsdmx/sdmx.ashx/GetData/ALFS_EMP/AUS.YS99TTL1_ST+YS99TTL2_ST+YS99TTL3_ST+YS99TTL4_ST.MA+FE+TT.A/all'

X <- read_xml('http://stats.oecd.org/restsdmx/sdmx.ashx/GetData/ALFS_EMP/AUS.YS99TTL1_ST+YS99TTL2_ST+YS99TTL3_ST+YS99TTL4_ST.MA+FE+TT.A?format=SDMX-ML', verbose = TRUE)

json_file <-   "https://stats.oecd.org/sdmx-json/data/ALFS_EMP/AUS.YS99TTL1_ST+YS99TTL2_ST+YS99TTL3_ST+YS99TTL4_ST.MA+FE+TT.A"

X %>%

ns <- xml_ns(X)

	# test dataset exist
	len_x <- length(xml_find_all(X, ".//DataSet", ns))

 len_x <- length(xml_find_all(X, ".//KeyFamilyRef", ns))

 X <- xml_child(X, 2) %>% xml_child(., './/Series')

 X %>%
  html_nodes("Series")

 y <-  llply(

			  xml_find_all(X, ".//Series", ns),

			  function(y){

				left_join(

				xml_attrs(y) %>% as.list %>% as_data_frame %>% mutate("tmpvars" = 1),

				xml_attrs(xml_find_all(y, ".//Obs", ns)) %>% lapply(as.list) %>% bind_rows %>% mutate("tmpvars" = 1)  ,

				by = "tmpvars"

				) %>%

				select(-contains("tmpvars"))

			  }

			) %>%

			bind_rows

}


library(IRkernel)
library(IRdisplay)
library(repr)
library(base64enc)

suppressPackageStartupMessages({
    library(xlsx)
    library(destiny)
    library(Biobase)
})

options(device = function(...) png('/dev/null', 7, 6, 'in', res = 120))
options(repr.plot.width = 7, repr.plot.height = 6)
options(jupyter.plot_mimetypes = c('application/pdf', 'image/png'))

setHook('on.rgl.close', function(...) {
    name <- tempfile()
    par3d(windowRect = c(0, 0, 1200, 1200))
    Sys.sleep(1)

    rgl.snapshot(  filename = paste0(name, '.png'))
   #rgl.postscript(filename = paste0(name, '.pdf'), fmt='pdf')  # doesn’t work with spheres

    res <- getOption('repr.plot.res')

    publish_mimebundle(list(
        'image/png'       = base64encode(paste0(name, '.png'))
     #, 'application/pdf' = base64encode(paste0(name, '.pdf'))
    ), list(
        width  = res * getOption('repr.plot.width'),
        height = res * getOption('repr.plot.height')
    ))
}, 'replace')

library(xlsx)
raw_ct <- read.xlsx('mmc4.xls', sheetName = 'Sheet1')

raw_ct[1:9, 1:9]  #preview of a few rows and columns

library(destiny)
library(Biobase)

ct <- as.ExpressionSet(raw_ct)
ct

num_cells <- gsub('^(\\d+)C.*$', '\\1', ct$Cell)
ct$num_cells <- as.integer(num_cells)

# cells from 2+ cell embryos
have_duplications <- ct$num_cells > 1
# cells with values ≤ 28
normal_vals <- apply(exprs(ct), 2, function(smp) all(smp <= 28))

cleaned_ct <- ct[, have_duplications & normal_vals]

housekeepers <- c('Actb', 'Gapdh')  # houskeeper gene names

normalizations <- colMeans(exprs(cleaned_ct)[housekeepers, ])

guo_norm <- cleaned_ct
exprs(guo_norm) <- exprs(guo_norm) - normalizations

library(destiny)
#data(guo_norm)
dm <- DiffusionMap(guo_norm)

plot(dm)

palette(cube_helix(6)) # configure color palette

plot(dm, pch = 20,         # pch for prettier points
     col_by = 'num_cells', # or “col” with a vector or one color
     legend_main = 'Cell stage')

plot(dm, 1:2, pch = 20, col_by = 'num_cells',
     legend_main = 'Cell stage')

library(rgl)
plot3d(eigenvectors(dm)[, 1:3],
       col = log2(guo_norm$num_cells),
       type = 's', radius = .01)
view3d(theta = 10, phi = 30, zoom = .8)
# now use your mouse to rotate the plot in the window
rgl.close()

library(ggplot2)
qplot(DC1, DC2, data = dm, colour = factor(num_cells)) +
    scale_color_cube_helix()
# or alternatively:
#ggplot(dif, aes(DC1, DC2, colour = factor(num.cells))) + ...

plot(eigenvalues(dm), ylim = 0:1, pch = 20,
     xlab = 'Diffusion component (DC)', ylab = 'Eigenvalue')

oh <- options('repr.plot.height')
options(repr.plot.height = 3)

par(mfrow = c(1, 2), mar = c(2,2,2,2), pch = 20)

plot(dm, 3:4,   col_by = 'num_cells', draw_legend = FALSE)
plot(dm, 19:20, col_by = 'num_cells', draw_legend = FALSE)

options(oh)

hist(exprs(cleaned_ct)['Aqp3', ], breaks = 20,
     xlab = 'Ct of Aqp3', main = 'Histogram of Aqp3 Ct',
     col = palette()[[4]], border = 'white')

dilutions <- read.xlsx('mmc6.xls', 1L)
dilutions$Cell <- NULL  # remove annotation column

get_lod <- function(gene) gene[[max(which(gene != 28))]]

lods <- apply(dilutions, 2, get_lod)
lod <- ceiling(median(lods))
lod

lod_norm <- ceiling(median(lods) - mean(normalizations))
max_cycles_norm <- ceiling(40 - mean(normalizations))

list(lod_norm = lod_norm, max_cycles_norm = max_cycles_norm)

guo <- guo_norm
exprs(guo)[exprs(cleaned_ct) >= 28] <- lod_norm

thresh_dm <- DiffusionMap(guo,
                          censor_val = lod_norm,
                          censor_range = c(lod_norm,
                                           max_cycles_norm),
                          verbose = FALSE)

plot(thresh_dm, 1:2, col_by = 'num_cells', pch = 20,
     legend_main = 'Cell stage')

# remove rows with divisionless cells
ct_w_missing <- ct[, ct$num_cells > 1L]
# and replace values larger than the baseline
exprs(ct_w_missing)[exprs(ct_w_missing) > 28] <- NA

housekeep <- colMeans(exprs(ct_w_missing)[housekeepers, ],
                      na.rm = TRUE)

w_missing <- ct_w_missing
exprs(w_missing) <- exprs(w_missing) - housekeep

exprs(w_missing)[is.na(exprs(ct_w_missing))] <- lod_norm

dif_w_missing <- DiffusionMap(w_missing,
                              censor_val = lod_norm,
                              censor_range = c(lod_norm,
                                               max_cycles_norm),
                              missing_range = c(1, 40),
                              verbose = FALSE)

plot(dif_w_missing, 1:2, col_by = 'num_cells', pch = 20,
     legend_main = 'Cell stage')

ct64 <- guo[, guo$num_cells == 64]

dm64 <- DiffusionMap(ct64)

ct32 <- guo[, guo$num_cells == 32]
pred32 <- dm_predict(dm64, ct32)

par(mar = c(2,2,1,5), pch = 20)
plot(dm64,    1:2,     col     = palette()[[6]],
     new_dcs = pred32, col_new = palette()[[4]])
colorlegend(c(32L, 64L), palette()[c(4,6)])


#' @param CognitiveModelFileName the filename of the cognitive models
#' @param RegressionModelFileName the filename of the regression models
#' @param AdjustedTestFileName the filename of the imputed test dataset
#' @param ImputedTestFileName the filename of the imputed test dataset
#' @param submissionTemplateFileName the filename of the submission template
#' @return
#  filename of the RDATA object with forecast data
#'
#' @examples
ForecastAll <- function(CognitiveModelFileName,
						RegressionModelFileName,
						AdjustedTestFileName,
						ImputedTestFileName,
						submissionTemplateFileName
						)
{
	suppressMessages(library("FRESA.CAD"))
	suppressMessages(library(readxl))
	source('R_scripts/predictCognitiveStatus.R')
	source('R_scripts/predictTADPOLERegresions.R')
	source('R_scripts/FiveYearForecast.R')

	submissionTemplate <- as.data.frame(read_excel(submissionTemplateFileName))
	submissionTemplate$`Forecast Date` <- as.Date(paste(submissionTemplate$`Forecast Date`,"-01",sep=""))
	submissionTemplate$`CN relative probability` <- as.numeric(nrow(submissionTemplate))
	submissionTemplate$`MCI relative probability` <-  as.numeric(nrow(submissionTemplate))
	submissionTemplate$`AD relative probability` <-  as.numeric(nrow(submissionTemplate))
	submissionTemplate$ADAS13 <-  as.numeric(nrow(submissionTemplate))
	submissionTemplate$`ADAS13 50% CI lower` <-  as.numeric(nrow(submissionTemplate))
	submissionTemplate$`ADAS13 50% CI upper` <-  as.numeric(nrow(submissionTemplate))
	submissionTemplate$Ventricles_ICV <-  as.numeric(nrow(submissionTemplate))
	submissionTemplate$`Ventricles_ICV 50% CI lower` <-  as.numeric(nrow(submissionTemplate))
	submissionTemplate$`Ventricles_ICV 50% CI upper` <-  as.numeric(nrow(submissionTemplate))
	submissionTemplate <- submissionTemplate[order(submissionTemplate$`Forecast Month`),]

	AdjustedTestFrame <- read.csv(AdjustedTestFileName, na.strings=c("NA",-4,"-4.0",""," ","NaN"))
	if (!is.null(AdjustedTestFrame$X))
	{
		AdjustedTestFrame$X <- NULL
	}
	rownames(AdjustedTestFrame) <- paste(AdjustedTestFrame$RID,AdjustedTestFrame$VISCODE,sep="_")

	ImputedTestFrame <- read.csv(ImputedTestFileName, na.strings=c("NA",-4,"-4.0",""," ","NaN"))
	if (!is.null(ImputedTestFrame$X))
	{
		ImputedTestFrame$X <- NULL
	}
	rownames(ImputedTestFrame) <- paste(ImputedTestFrame$RID,ImputedTestFrame$VISCODE,sep="_")

	load(file=CognitiveModelFileName)
	predictADNI <- forecastCognitiveStatus(CognitiveClassModels,AdjustedTestFrame)

	AdjustedTestFrame$Ventricles <- ImputedTestFrame[rownames(AdjustedTestFrame),"Ventricles"]/ImputedTestFrame[rownames(AdjustedTestFrame),"ICV"]
	AdjustedTestFrame$ADAS13 <- ImputedTestFrame[rownames(AdjustedTestFrame),"ADAS13"]

	## THe last time point required for forecasting ADAS13 and Ventricles
	ltptf <- AdjustedTestFrame
	ltptf <- ltptf[order(ltptf$EXAMDATE),]
	ltptf <- ltptf[order(as.numeric(ltptf$RID)),]
	rids <- ltptf$RID
	ltptf <- ltptf[c(rids[1:(length(rids)-1)] != rids[-1],TRUE),]
	rownames(ltptf) <- ltptf$RID

	 ### Forecasting

	load(file=RegressionModelFileName)
	forecast <- FiveYearForeCast(predictADNI,
								   testDataset=ltptf,
								   ADAS_Ventricle_Models=RegressionModels,
								   Subject_datestoPredict=submissionTemplate)

	ForeCastingFileName <- c("data/_ForecastFRESACAD.csv")
	write.csv(forecast,file=ForeCastingFileName)

	return(ForeCastingFileName)
}


library(tidyverse)

df <- read_csv("Top2000_extra_columns_spotify_genre.csv")
df$...1 <- NULL
colnames(df) <- tolower(colnames(df))

audio_features <- c("tempo","danceability","energy","valence","loudness","instrumentalness")
col_years <- colnames(df)[grepl("[0-9]{4}", colnames(df))]
non_col_years <- colnames(df)[!grepl("[0-9]{4}", colnames(df))]

get_legend<-function(a.gplot){
  tmp <- ggplot_gtable(ggplot_build(a.gplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  return(legend)}

df[df$artist == 'Pearl Jam',c('genre_groups')] <- "rock"

df_unique_genres <- df %>%
  count(artist, genre_groups) %>%
  mutate(n = ifelse(genre_groups == 'unknown', 0, n)) %>%
  arrange(artist, desc(n)) %>%
  distinct(artist, .keep_all = TRUE) %>%
  select(artist,genre_groups)

df$genre_groups <- NULL

df <- df %>% left_join(df_unique_genres, by = 'artist')


#!/usr/local/bin/Rscript
library(raster)
library(tidyverse)
library(tidync)
library(glue)

dates<-Sys.Date() - 2
dnow <- format(dates,"%Y%m%d")
dyear <- format(dates,"%Y")

precip_list <- glue("http://opendap.bom.gov.au:8080/thredds/dodsC/agcd/precip/total/r005/01day/{dyear}/precip_total_r005_{dnow}_{dnow}.nc")
vp_list <- glue("http://opendap.bom.gov.au:8080/thredds/dodsC/agcd/vapourpres_h15/mean/r005/01day/{dyear}/vapourpres_h15_mean_r005_{dnow}_{dnow}.nc")
tmax_list <- glue("http://opendap.bom.gov.au:8080/thredds/dodsC/agcd/tmax/mean/r005/01day/{dyear}/tmax_mean_r005_{dnow}_{dnow}.nc")

proc_ncdf_1 <- function(x){
  tidync(x[1]) %>% hyper_tibble
}

precip_df <- map_df(precip_list,proc_ncdf_1)
vp_df <- map_df(vp_list,proc_ncdf_1)
tmax_df <- map_df(tmax_list,proc_ncdf_1)

precip_df <- precip_df %>% group_by(time) %>% nest()
vp_df <- vp_df %>% group_by(time) %>% nest()
tmax_df <- tmax_df %>% group_by(time) %>% nest()

precip_df <- precip_df %>% mutate(time = as.Date(time,origin="1850-01-01"))
vp_df <- vp_df %>% mutate(time = as.Date(time,origin="1850-01-01"))
tmax_df <- tmax_df %>% mutate(time = as.Date(time,origin="1850-01-01"))

list_to_raster <- function(x){
  ext_1 <- extent(min(x$lon)-0.025,max(x$lon)+0.025,min(x$lat)-0.025,max(x$lat)+0.025)
  temp_raster <- raster(ext_1,res=0.05,crs=CRS("EPSG:4326"))
  values(temp_raster)<-unlist(x[,1])
  temp_raster
}

precip_df <- precip_df %>% mutate(rast = map(data,list_to_raster))
vp_df <- vp_df %>% mutate(rast = map(data,list_to_raster))
tmax_df <- tmax_df %>% mutate(rast = map(data,list_to_raster))

for(i in 1:nrow(vp_df)){
  this_date <- vp_df$time[i]
  writeRaster(vp_df$rast[[i]],glue("VP3pm/VP3pm_{this_date}.tif"),overwrite=TRUE)
}
for(i in 1:nrow(precip_df)){
  this_date <- precip_df$time[i]
  writeRaster(precip_df$rast[[i]],glue("pcp/pcp_{this_date}.tif"),overwrite=TRUE)
}
for(i in 1:nrow(tmax_df)){
  this_date <- tmax_df$time[i]
  writeRaster(tmax_df$rast[[i]],glue("Tmx/Tmx_{this_date}.tif"),overwrite=TRUE)
}

rm(precip_df,vp_df,tmax_df)

Tmx.tmp.r<-raster(glue("Tmx/Tmx_{this_date}.tif"))
ea.tmp.r<-raster(glue("VP3pm/VP3pm_{this_date}.tif"))   # in hPa from AWAP, so multiply by 0.1 to convert to KPa
pcp.tmp.r<-raster(glue("pcp/pcp_{this_date}.tif"))

DFMCfun <- function(x) {
  y <- 6.79+27.43*exp(-1.05*x)
  return(y)}

# Make precipitation mask
pcp.tmp.r[pcp.tmp.r>2] = NA
pcp.tmp.r[!is.na(pcp.tmp.r)] = 0

ea.tmp2.r<-ea.tmp.r*0.1
# From daily mean temperature (T) we can compute saturation vapour pressure:
es.tmp.r<-0.6108*exp(17.27*Tmx.tmp.r/(Tmx.tmp.r + 237.3)) # In KPa!!
# ...and VPD in KPa, constrain to 0 when calculated RH >100%
D.tmp.r<-ea.tmp2.r-es.tmp.r
D.tmp.r[D.tmp.r>0]<-0
D.tmp.r <- D.tmp.r*-1
print(summary(getValues(D.tmp.r)))
# compute DFMC (%)
DFMC.tmp.r<-calc(x=D.tmp.r, fun=DFMCfun)
print(summary(getValues(DFMC.tmp.r)))

mask_r <- raster("aus_mask.tif")
D.tmp.r = D.tmp.r + mask_r

VPD_outlist <- glue("VPD/VPD_{dnow}.tif")
writeRaster(D.tmp.r,VPD_outlist, overwrite=TRUE)

DFMC_outlist <- glue("DFMC/DFMC_{dnow}.tif")
DFMC.tmp.r = DFMC.tmp.r + pcp.tmp.r
DFMC.tmp.r = DFMC.tmp.r + mask_r
writeRaster(DFMC.tmp.r,DFMC_outlist, overwrite=TRUE)

# Trend Analysis
file_list = list.files("VPD",full.names=TRUE)
lfl <- length(file_list)
file_list = file_list[(lfl-10):lfl]
VPD_stack <- stack(file_list)

modl <- function(x){
  if(is.na(x[1])){return(c(NA,NA))}
  day <- 1:length(x)
  md <- lm(x~day)
  slp <- md$coefficients[2]
  r2 <- summary(md)$r.squared
  as.numeric(c(slp,r2))
}

test <- calc(VPD_stack,fun=modl)

mask_r = test[[2]]
mask_r[mask_r<0.3]=NA
mask_r[!is.na(mask_r)]=0
test[[1]]=test[[1]] + mask_r

writeRaster(test[[1]],"VPD_trend.tif",overwrite=TRUE)