#iv fastplm boot
ivfastplm.boot <- function(seed,
                           y = NULL,
                           x = NULL,
                           z = NULL,
                           ind = NULL,
                           sfe.index = NULL,
                           cfe.index = NULL,
                           cluster = NULL,
                           robust = FALSE,
                           parallel = FALSE,
                           wild = FALSE,
                           jackknife = FALSE,
                           refinement = FALSE,
                           pos = NULL,
                           test.value = NULL,
                           nboots = 200,
                           bootcluster = NULL, #2-way clusters in wild (refinement)
                           core.num = 1){
    p <- dim(x)[2]
    if(is.null(z)){
        stop("No exogenous variables.\n")
    }

    if(is.null(colnames(x))){
        colnames(x) <- paste0("x.",c(1:dim(x)[2]))
    }

    if(is.null(colnames(z))){
        colnames(z) <- paste0("z.",c(1:dim(z)[2]))
    }

    if(is.null(colnames(y))){
        colnames(y) <- 'y'
    }

    if (jackknife == 1) {
        wild <- 0
    }

    # get
    model.iv <- ivfastplm.core(y = y, x = x, z = z,
                               ind = ind, se = 1,
                               robust = robust,
                               sfe.index = sfe.index,
                               cfe.index = cfe.index,
                               cl = cluster,
                               core.num = core.num,
                               need.fe = TRUE,
                               iv.test = FALSE)

    dy <- model.iv$demeaned$dy
    dx <- model.iv$demeaned$dx
    dz <- model.iv$demeaned$dz

    y.fit <- fitted.y <- model.iv$fitted.values
    res <- residual.y <- model.iv$residuals

    iv.name <- model.iv$names
    en.var.x <- iv.name$en.var.x
    ex.var.x <- iv.name$ex.var.x
    include.iv <- iv.name$include.iv
    exclude.iv <- iv.name$exclude.iv

    iv.matrix <- model.iv$matrix
    inv.z <- iv.matrix$inv.z # inv(z'z)
    inv.xPzx <- iv.matrix$inv.xPzx

    #save df.original & df.cl for wild bootstrap(only)
    df.use <- df.original <- model.iv$df.original
    df.cl.use <- df.cl <- model.iv$df.cl

    ## function to get two-sided p-values
    get.pvalue <- function(vec,to_test=0) {
        if (NaN%in%vec|NA%in%vec) {
            nan.pos <- is.nan(vec)
            na.pos <- is.na(vec)
            pos <- c(which(nan.pos),which(na.pos))
            vec.a <- vec[-pos]
            a <- sum(vec.a >= to_test)/(length(vec)-sum(nan.pos|na.pos)) * 2
            b <- sum(vec.a <= to_test)/(length(vec)-sum(nan.pos|na.pos)) * 2
        } else {
            a <- sum(vec >= to_test)/length(vec) * 2
            b <- sum(vec <= to_test)/length(vec) * 2
        }
        return(min(as.numeric(min(a, b)),1))
    }

    if(parallel==TRUE){
        core.num <- 1
        requireNamespace("doParallel")
		## require(iterators)
		maxcores <- detectCores()
		cores <- min(maxcores, 4)
		pcl<-makeCluster(cores)
		doParallel::registerDoParallel(pcl)
	    cat("Parallel computing with", cores,"cores...\n")
        use.fun <- c("SEQ","name.fe.model","ivfastplm.core","get.dof","iv.cluster.se","fastplm.core")
    }

    if(wild==TRUE){
        raw.cluster <- level.cluster <- level.count <- NULL
        if (!is.null(cluster)) {
            if(dim(cluster)[2]==1){
                ## one-way cluster
                raw.cluster <- as.numeric(as.factor(cluster))
                level.cluster <- unique(raw.cluster)
                level.count <- table(raw.cluster)
            }
            if(dim(cluster)[2]==2){
                if(is.null(bootcluster)){
                    level.cluster.1 <- unique(as.numeric(as.factor(cluster[,1])))
                    level.cluster.2 <- unique(as.numeric(as.factor(cluster[,2])))
                    if(length(level.cluster.1)<=length(level.cluster.2)){
                        raw.cluster <- as.numeric(as.factor(cluster[,1]))
                        bootcluster <- colnames(cluster)[1]
                    }else{
                        raw.cluster <- as.numeric(as.factor(cluster[,2]))
                        bootcluster <- colnames(cluster)[2]
                    }
                    level.cluster <- unique(raw.cluster)
                    level.count <- table(raw.cluster)
                }else{
                    raw.cluster <- as.numeric(as.factor(cluster[,bootcluster]))
                    level.cluster <- unique(raw.cluster)
                    level.count <- table(raw.cluster)
                }
                cat(paste0("Mutiple Clustered Wild Bootstrap: (Boot)Clustered at ",bootcluster," level.\n"))
            }
        }

        if(length(en.var.x)>0){
           en.var.x.matrix <- matrix(dx[,en.var.x],ncol=length(en.var.x))
            sub.lm <- simpleols(Y=en.var.x.matrix,X=dz)
            en.var.x.coef <- sub.lm[['coef']]
            colnames(en.var.x.coef) <- en.var.x
            en.var.x.hat <- sub.lm[['Y_hat']]
            colnames(en.var.x.hat) <- en.var.x
            res.en.x <- en.var.x.res <- sub.lm[["u_hat"]]
            en.var.x.fitted <- matrix(x[,en.var.x],ncol=length(en.var.x)) - en.var.x.res
            colnames(en.var.x.fitted) <- colnames(en.var.x.res) <- colnames(en.var.x.hat) <- en.var.x
        }
        ####

        if (refinement == 0) {
                ## wild bootstrap
                cat("Wild Bootstrap without Percentile-t Refinement.\n")
                boot.coef <- matrix(NA, p, nboots)

                one.boot <- function(num = NULL) {
                    if (!is.null(cluster)) {
                        ## wild boot by cluster
                        res.p <- rep(0,dim(cluster)[1])
                        for (j in 1:length(level.cluster)) {
                            temp.level <- sample(c(-1,1), 1)
                            res.p[which(raw.cluster==level.cluster[j])] <- temp.level
                        }
                        res.p <- as.matrix(res.p)
                    } else {
                        res.p <- as.matrix(sample(c(-1, 1), dim(y)[1], replace = TRUE))
                    }

                    y.boot <- y.fit + res.p * res

                    if(length(en.var.x)>0){
                       x.boot.en <- matrix(en.var.x.fitted + sweep(en.var.x.res, MARGIN=1, res.p, `*`),ncol=length(en.var.x))
                       colnames(x.boot.en) <- en.var.x
                    }else{
                        x.boot.en <- matrix(NA,ncol=0,nrow=dim(dy)[1])
                    }

                    if(length(ex.var.x)>0){
                        x.boot.ex <- matrix(x[,ex.var.x],ncol=length(ex.var.x))
                        colnames(x.boot.ex) <- ex.var.x
                    }else{
                        x.boot.ex <- matrix(NA,ncol=0,nrow=dim(dy)[1])
                    }

                    x.boot <- cbind(x.boot.en,x.boot.ex)
                    x.boot <- x.boot[,colnames(x)]
                    #only need coefficients, don't need se
                    boot.model.iv <- try(ivfastplm.core(y = y.boot, x = x.boot,z=z, ind = ind,
                                                   sfe.index = sfe.index, cfe.index = cfe.index,
                                                   se = 0, cl = NULL, core.num = core.num,
                                                   df.use = df.use, df.cl.use = df.cl.use, need.fe = FALSE, iv.test = FALSE
                                                   ))

                    if ('try-error' %in% class(boot.model.iv)) {
                        return(rep(NA, p))
                    } else {
                        return(c(boot.model.iv$coefficients))
                    }
                }

                if (parallel == TRUE) {
                    boot.out <- foreach(j = 1:nboots,
                                    .inorder = FALSE,
                                    .export = use.fun,
                                    .packages = c("fastplm")
                                    ) %dopar% {
                                        return(one.boot())
                                    }
                    for (j in 1:nboots) {
                        boot.coef[, j] <- c(boot.out[[j]])
                    }
                } else {
                    for (i in 1:nboots) {
                        boot.coef[, i] <- one.boot()
                        if (i%%50==0) cat(i) else cat(".")
                    }
                }

                P_x <- as.matrix(apply(boot.coef, 1, get.pvalue))
                stderror <- as.matrix(apply(boot.coef, 1, sd, na.rm = TRUE))

                CI <- t(apply(boot.coef, 1, quantile, c(0.025, 0.975), na.rm = TRUE))
                ## rewrite uncertainty estimates
                est.coefficients <- cbind(model.iv$coefficients, stderror,model.iv$coefficients/stderror, P_x, CI)
                colnames(est.coefficients) <- c("Coef", "Std. Error","Z Value", "P Value", "CI_lower", "CI_upper")
                rownames(est.coefficients) <- colnames(dx)
                model.iv$est.coefficients <- est.coefficients

                vcov <- as.matrix(cov(t(boot.coef),use="na.or.complete"))
                colnames(vcov) <- colnames(dx)
                rownames(vcov) <- colnames(dx)
                model.iv$vcov <- vcov
        }

        if(refinement==1){
            if(is.null(pos)==TRUE){
                cat("Unrestricted Wild Bootstrap with Percentile-t Refinement.\n")
                boot.coef <- matrix(NA, p, nboots)
                boot.wald <- rep(NA, nboots)
                one.boot <- function(num = NULL) {
                    if (!is.null(cluster)) {
                        ## wild boot by cluster
                        res.p <- rep(0,dim(cluster)[1])
                        for (j in 1:length(level.cluster)) {
                            temp.level <- sample(c(-1,1), 1)
                            res.p[which(raw.cluster==level.cluster[j])] <- temp.level
                        }
                        res.p <- as.matrix(res.p)
                    } else {
                        res.p <- as.matrix(sample(c(-1, 1), dim(y)[1], replace = TRUE))
                    }
                    y.boot <- y.fit + res.p * res

                    if(length(en.var.x)>0){
                       x.boot.en <- matrix(en.var.x.fitted + sweep(en.var.x.res, MARGIN=1, res.p, `*`),ncol=length(en.var.x))
                       colnames(x.boot.en) <- en.var.x
                    }else{
                        x.boot.en <- matrix(NA,ncol=0,nrow=dim(dy)[1])
                    }

                    if(length(ex.var.x)>0){
                        x.boot.ex <- matrix(x[,ex.var.x],ncol=length(ex.var.x))
                        colnames(x.boot.ex) <- ex.var.x
                    }else{
                        x.boot.ex <- matrix(NA,ncol=0,nrow=dim(dy)[1])
                    }
                    x.boot <- cbind(x.boot.en,x.boot.ex)
                    x.boot <- x.boot[,colnames(x)]

                    boot.model <- try(ivfastplm.core(y = y.boot, x = x.boot, z = z, ind = ind, robust = robust,
                                                sfe.index = sfe.index, cfe.index = cfe.index,
                                                se = 1, cl = cluster, core.num = core.num,
                                                df.use = df.use,
                                                df.cl.use = df.cl.use))
                    if ('try-error' %in% class(boot.model)) {
                        return(NA)
                    } else {
                        boot.use <- (boot.model$est.coefficients[, "Coef"]-model.iv$est.coefficients[, "Coef"])/boot.model$est.coefficients[, "Std. Error"]
                        return(c(boot.use))
                    }
                }
                if (parallel == TRUE) {
                    boot.out <- foreach(j = 1:nboots,
                                        .inorder = FALSE,
                                        .export = use.fun,
                                        .packages = c("fastplm")
                                        ) %dopar% {
                                            return(one.boot())
                                        }
                    for (j in 1:nboots) {
                        boot.coef[, j] <- c(boot.out[[j]])
                    }
                } else {
                    for (i in 1:nboots) {
                        boot.coef[, i] <- one.boot()
                        if (i%%50==0) cat(i) else cat(".")
                    }
                }
                wald.refinement <- matrix(NA,nrow=0,ncol=6)
                null.totest <- model.iv$est.coefficients[,'t value']
                for(k in 1:length(null.totest)){
                    p.refine <- get.pvalue(boot.coef[k,],to_test=null.totest[k])
                    CI.refine <- quantile(boot.coef[k,], probs = c(0.025,0.975), na.rm = TRUE)*model.iv$est.coefficients[k,'Std. Error'] + model.iv$est.coefficients[k,'Coef']
                    refine.sub <- c(model.iv$est.coefficients[k,'Coef'],
                                    model.iv$est.coefficients[k,'Std. Error'],
                                    model.iv$est.coefficients[k,'t value'],
                                    p.refine,
                                    CI.refine[1],
                                    CI.refine[2])
                    wald.refinement <- rbind(wald.refinement,refine.sub)
                }
                colnames(wald.refinement) <- c("Coef","Std Error","t value",
                                            "Refined P value","Refined CI_lower",
                                            "Refined CI_upper")
                rownames(wald.refinement) <- colnames(dx)
                model.iv$refinement <- list(wald.refinement = wald.refinement, boot.wald = boot.coef)
            }

            if(is.null(pos)==FALSE){

                if(is.null(test.value)==TRUE){
                    test.value <- 0
                }

                if(pos %in% en.var.x){
                    cat("Restricted Wild Efficient Residual Bootstrap with Percentile-t Refinement.\n")
                    if(length(en.var.x)==1){
                        dy.restricted <- dy - test.value*dx[,en.var.x]
                        dx1 <- matrix(dx[,ex.var.x],ncol=length(ex.var.x))
                        inv.dx1 <- solve(t(dx1)%*%dx1)
                        reg1.coef <- inv.dx1%*%t(dx1)%*%dy.restricted
                        u.hat1 <- dy.restricted - dx1%*%reg1.coef

                        dy2 <- dx[,en.var.x]
                        dx2 <- cbind(dz,u.hat1)
                        inv.dx2 <- solve(t(dx2)%*%dx2)
                        reg2.coef <- inv.dx2%*%t(dx2)%*%dy2
                        u.hat2 <- dy2 - dx2%*%reg2.coef + reg2.coef[dim(dz)[2]+1,1]*u.hat1

                        one.boot <- function(num = NULL) {
                            if (!is.null(cluster)) {
                                ## wild boot by cluster
                                res.p <- rep(0,dim(cluster)[1])
                                for (j in 1:length(level.cluster)) {
                                    temp.level <- sample(c(-1,1), 1)
                                    res.p[which(raw.cluster==level.cluster[j])] <- temp.level
                                }
                                res.p <- as.matrix(res.p)
                            } else {
                                res.p <- as.matrix(sample(c(-1, 1), dim(y)[1], replace = TRUE))
                            }

                            y.boot <- y-u.hat1+res.p * u.hat1
                            en.x.boot <- x[,en.var.x] - u.hat2 + res.p * u.hat2

                            if(length(ex.var.x)>0){
                                x.boot.ex <- matrix(x[,ex.var.x],ncol=length(ex.var.x))
                                colnames(x.boot.ex) <- ex.var.x
                            }else{
                                x.boot.ex <- matrix(NA,ncol=0,nrow=dim(dy)[1])
                            }

                            x.boot <- cbind(en.x.boot,x.boot.ex)
                            colnames(x.boot) <- c(en.var.x,ex.var.x)
                            x.boot <- x.boot[,colnames(x)]

                            boot.model <- try(ivfastplm.core(y = y.boot, x = x.boot, z = z, ind = ind, robust = robust,
                                                             sfe.index = sfe.index, cfe.index = cfe.index,
                                                             se = 1, cl = cluster, core.num = core.num,
                                                             df.use = df.use,
                                                             df.cl.use = df.cl.use))
                            if ('try-error' %in% class(boot.model)) {
                                return(NA)
                            } else {
                                boot.use <- (boot.model$est.coefficients[pos, "Coef"]-test.value)/boot.model$est.coefficients[pos, "Std. Error"]
                                return(c(boot.use))
                            }
                        }
                    }

                    if(length(en.var.x)>1){
                        dy.restricted <- dy - test.value*dx[,pos]
                        en.dx <- dx[,en.var.x]
                        pos.index <- which(colnames(en.dx)==pos)
                        en.dx.other <- matrix(en.dx[,-pos.index],ncol=dim(en.dx)[2]-1)

                        #a simple 2sls
                        dx1 <- cbind(en.dx.other,dx[,ex.var.x])
                        inv.dx1 <- solve(t(dx1)%*%dx1)
                        dz1 <- dz
                        inv.dz1 <- inv.z
                        Pdz1 <- dz1%*%inv.dz1%*%t(dz1)
                        inv.dxPzdx1 <- solve(t(dx1)%*%Pdz1%*%dx1)
                        reg1.coef <- matrix(inv.dxPzdx1%*%t(dx1)%*%Pdz1%*%dy.restricted,ncol=1)
                        u.hat1 <- matrix(dy.restricted-dx1%*%reg1.coef,ncol=1)

                        dy2 <- dx[,en.var.x]
                        dx2 <- cbind(dz,u.hat1)
                        inv.dx2 <- solve(t(dx2)%*%dx2)
                        reg2.coef <- inv.dx2%*%t(dx2)%*%dy2

                        reg2.coef.slice <- matrix(reg2.coef[(dim(dz)[2]+1),],ncol=dim(reg2.coef)[2])
                        u.hat2 <- dy2 - dx2%*%reg2.coef + kronecker(reg2.coef.slice,u.hat1)

                        one.boot <- function(num = NULL) {
                            if (!is.null(cluster)) {
                                ## wild boot by cluster
                                res.p <- rep(0,dim(cluster)[1])
                                for (j in 1:length(level.cluster)) {
                                    temp.level <- sample(c(-1,1), 1)
                                    res.p[which(raw.cluster==level.cluster[j])] <- temp.level
                                }
                                res.p <- as.matrix(res.p)
                            } else {
                                res.p <- as.matrix(sample(c(-1, 1), dim(y)[1], replace = TRUE))
                            }

                            y.boot <- y-u.hat1+res.p * u.hat1
                            en.x.boot <- matrix(x[,en.var.x] - u.hat2 + sweep(u.hat2, MARGIN=1, res.p, `*`),ncol=length(en.var.x))
                            if(length(ex.var.x)>0){
                                x.boot.ex <- matrix(x[,ex.var.x],ncol=length(ex.var.x))
                                colnames(x.boot.ex) <- ex.var.x
                            }else{
                                x.boot.ex <- matrix(NA,ncol=0,nrow=dim(dy)[1])
                            }

                            x.boot <- cbind(en.x.boot,x.boot.ex)
                            colnames(x.boot) <- c(en.var.x,ex.var.x)
                            x.boot <- x.boot[,colnames(x)]

                            boot.model <- try(ivfastplm.core(y = y.boot, x = x.boot, z = z, ind = ind, robust = robust,
                                                             sfe.index = sfe.index, cfe.index = cfe.index,
                                                             se = 1, cl = cluster, core.num = core.num,
                                                             df.use = df.use,
                                                             df.cl.use = df.cl.use))
                            if ('try-error' %in% class(boot.model)) {
                                return(NA)
                            } else {
                                boot.use <- (boot.model$est.coefficients[pos, "Coef"]-test.value)/boot.model$est.coefficients[pos, "Std. Error"]
                                return(c(boot.use))
                            }
                        }
                    }

                    boot.wald <- rep(NA, nboots)
                    if (parallel == TRUE) {
                        boot.out <- foreach(j = 1:nboots,
                                            .inorder = FALSE,
                                            .export = use.fun,
                                            .packages = c("fastplm")
                                            ) %dopar% {
                                                return(one.boot())
                                            }
                        boot.wald <- c(unlist(boot.out))
                    } else {
                        for (i in 1:nboots) {
                            boot.wald[i] <- one.boot()
                            if (i%%50==0) cat(i) else cat(".")
                        }
                    }

                    p.refine <- get.pvalue(boot.wald,to_test=(model.iv$est.coefficients[pos, "Coef"]-test.value)/model.iv$est.coefficients[pos, "Std. Error"])
                    CI.refine <- quantile(boot.wald, probs = c(0.025,0.975), na.rm = TRUE)*model.iv$est.coefficients[pos,'Std. Error'] + model.iv$est.coefficients[pos, "Coef"]

                    refine.sub <- c(model.iv$est.coefficients[pos,'Coef'],
                                    model.iv$est.coefficients[pos,'Std. Error'],
                                    (model.iv$est.coefficients[pos, "Coef"]-test.value)/model.iv$est.coefficients[pos, "Std. Error"],
                                    p.refine,
                                    #paste0(pos,"=",test.value),
                                    CI.refine[1],
                                    CI.refine[2])

                    refine.sub <- matrix(refine.sub,nrow=1)
                    #refine.sub <- as.data.frame(refine.sub)
                    rownames(refine.sub) <- pos
                    colnames(refine.sub) <- c("Coef","Std Error","t value(H0)",
                                              "Refined P value","Refined CI_lower","Refined CI_upper")
                    model.iv$refinement <- list(wald.refinement = refine.sub, boot.wald = boot.wald)
                }

                if(pos %in% ex.var.x){
                    # wild restricted residual bootstrap
                    cat("Wild Restricted Bootstrap with Percentile-t Refinement.\n")
                    boot.wald <- rep(NA, nboots)

                    dy.restricted <- dy - test.value*dx[,pos]
                    pos.index <- which(colnames(dx)==pos)
                    dx.other <- matrix(dx[,-pos.index],ncol=dim(dx)[2]-1)

                    #a simple 2sls
                    dx1 <- dx.other
                    inv.dx1 <- solve(t(dx1)%*%dx1)
                    dz1 <- dz
                    inv.dz1 <- inv.z
                    Pdz1 <- dz1%*%inv.dz1%*%t(dz1)
                    inv.dxPzdx1 <- solve(t(dx1)%*%Pdz1%*%dx1)
                    reg1.coef <- matrix(inv.dxPzdx1%*%t(dx1)%*%Pdz1%*%dy.restricted,ncol=1)
                    u.hat1 <- matrix(dy.restricted-dx1%*%reg1.coef,ncol=1)

                    boot.wald <- rep(NA, nboots)
                    one.boot <- function(num = NULL) {
                        if (!is.null(cluster)) {
                            ## wild boot by cluster
                            res.p <- rep(0,dim(cluster)[1])
                            for (j in 1:length(level.cluster)) {
                                temp.level <- sample(c(-1,1), 1)
                                res.p[which(raw.cluster==level.cluster[j])] <- temp.level
                            }
                            res.p <- as.matrix(res.p)
                        } else {
                            res.p <- as.matrix(sample(c(-1, 1), dim(y)[1], replace = TRUE))
                        }
                        y.boot <- y - u.hat1 + res.p * u.hat1
                        x.boot.en <- matrix(en.var.x.fitted + sweep(en.var.x.res, MARGIN=1, res.p, `*`),ncol=length(en.var.x))
                        colnames(x.boot.en) <- en.var.x

                        if(length(ex.var.x)>0){
                            x.boot.ex <- matrix(x[,ex.var.x],ncol=length(ex.var.x))
                            colnames(x.boot.ex) <- ex.var.x
                        }else{
                            x.boot.ex <- matrix(NA,ncol=0,nrow=dim(dy)[1])
                        }

                        x.boot <- cbind(x.boot.en,x.boot.ex)
                        colnames(x.boot) <- c(en.var.x,ex.var.x)
                        x.boot <- x.boot[,colnames(x)]

                        boot.model <- try(ivfastplm.core(y = y.boot, x = x.boot, z = z, ind = ind, robust = robust,
                                                         sfe.index = sfe.index, cfe.index = cfe.index,
                                                         se = 1, cl = cluster, core.num = core.num,
                                                         df.use = df.use,
                                                         df.cl.use = df.cl.use))
                        if ('try-error' %in% class(boot.model)) {
                            return(NA)
                        } else {
                            boot.use <- (boot.model$est.coefficients[pos, "Coef"]-test.value)/boot.model$est.coefficients[pos, "Std. Error"]
                            return(c(boot.use))
                        }
                    }

                    if (parallel == TRUE) {
                        boot.out <- foreach(j = 1:nboots,
                                            .inorder = FALSE,
                                            .export = use.fun,
                                            .packages = c("fastplm")
                                            ) %dopar% {
                                                return(one.boot())
                                            }
                        for (j in 1:nboots) {
                            boot.wald[j] <- c(unlist(boot.out[[j]]))
                        }
                    } else {
                        for (i in 1:nboots) {
                            boot.wald[i] <- one.boot()
                            if (i%%50==0) cat(i) else cat(".")
                        }
                    }

                    p.refine <- get.pvalue(boot.wald,to_test=(model.iv$est.coefficients[pos, "Coef"]-test.value)/model.iv$est.coefficients[pos, "Std. Error"])
                    CI.refine <- quantile(boot.wald, probs = c(0.025,0.975), na.rm = TRUE)*model.iv$est.coefficients[pos,'Std. Error'] + model.iv$est.coefficients[pos, "Coef"]

                   refine.sub <- c(model.iv$est.coefficients[pos,'Coef'],
                                    model.iv$est.coefficients[pos,'Std. Error'],
                                    (model.iv$est.coefficients[pos, "Coef"]-test.value)/model.iv$est.coefficients[pos, "Std. Error"],
                                    p.refine,
                                    #paste0(pos,"=",test.value),
                                    CI.refine[1],
                                    CI.refine[2])

                    refine.sub <- matrix(refine.sub,nrow=1)
                    #refine.sub <- as.data.frame(refine.sub)
                    rownames(refine.sub) <- pos
                    colnames(refine.sub) <- c("Coef","Std Error","t value(H0)",
                                              "Refined P value","Refined CI_lower","Refined CI_upper")
                    model.iv$refinement <- list(wald.refinement = refine.sub, boot.wald = boot.wald)
                }
            }
        }
    }
    else{

        if (jackknife ==1 || is.null(cluster)) {
                jack.pos <- 1
                if (jackknife == 1) {
                    nboots <- length(unique(ind[,1]))
                    jack.pos <- as.numeric(as.factor(ind[,1]))
                }
                boot.coef <- matrix(NA, p, nboots)

        if(refinement==0){
            if (jackknife == 1){
                cat("Jackknife without Percentile-t Refinement.\n")
            }else{
                cat("Pairs Bootstrap without Percentile-t Refinement.\n")
            }

            one.boot <- function(num = NULL) {
                if (is.null(num)) {
                    boot.id <- sample(1:dim(y)[1], dim(y)[1], replace = TRUE)
                } else {
                    boot.id <- (1:dim(y)[1])[which(jack.pos != num)]
                }

                boot.model <- try(ivfastplm.core(y = as.matrix(y[boot.id,]),
                                                 x = as.matrix(x[boot.id,]),
                                                 z = as.matrix(z[boot.id,]),
                                                 ind = as.matrix(ind[boot.id,]),
                                                 sfe.index = sfe.index, cfe.index = cfe.index,
                                                 se = 0, cl = NULL, core.num = core.num))

                if ('try-error' %in% class(boot.model)) {
                    return(rep(NA, p))
                } else {
                    return(c(boot.model$coefficients))
                }
            }

            boot.seq <- NULL
            if (jackknife == 1) {
                boot.seq <- unique(jack.pos)
            }

            if (parallel == TRUE) {
                boot.out <- foreach(j = 1:nboots,
                                    .inorder = FALSE,
                                    .export = use.fun,
                                    .packages = c("fastplm")
                                    ) %dopar% {
                                        return(one.boot(boot.seq[j]))
                                    }
                for (j in 1:nboots) {
                    boot.coef[, j] <- c(boot.out[[j]])
                }
            } else {
                for (i in 1:nboots) {
                    boot.coef[, i] <- one.boot(boot.seq[i])
                    if (i%%50==0) cat(i) else cat(".")
                }
            }

            if (jackknife == 0) {
                P_x <- as.matrix(apply(boot.coef, 1, get.pvalue))
                stderror <- as.matrix(apply(boot.coef, 1, sd, na.rm = TRUE))
                CI <- t(apply(boot.coef, 1, quantile, c(0.025, 0.975), na.rm = TRUE))
                ## rewrite uncertainty estimates
                est.coefficients <- cbind(model.iv$coefficients, stderror,model.iv$coefficients/stderror, P_x, CI)
                vcov <- as.matrix(cov(t(boot.coef),use="na.or.complete"))
            } else {
                beta.j <- jackknifed(model.iv$coefficients, boot.coef, 0.05)
                est.coefficients <- cbind(model.iv$coefficients, beta.j$se,model.iv$coefficients/beta.j$se, beta.j$P, beta.j$CI.l, beta.j$CI.u)
                vcov <- beta.j$Yvcov
            }
            colnames(est.coefficients) <- c("Coef", "Std. Error","Z Value", "P Value", "CI_lower", "CI_upper")
            rownames(est.coefficients) <- colnames(dx)
            model.iv$est.coefficients <- est.coefficients

            colnames(vcov) <- colnames(dx)
            rownames(vcov) <- colnames(dx)
            model.iv$vcov <- vcov
        }

        if(refinement==1){
            if (jackknife == 1){
                stop("Can't refine a Jackknife P-Value,\n")
                #cat("Jackknife with Percentile-t Refinement.\n")
            }else{
                cat("Pairs Bootstrap with Percentile-t Refinement.\n")
            }

            one.boot <- function(num = NULL) {
                boot.id <- sample(1:dim(y)[1], dim(y)[1], replace = TRUE)
                boot.model <- try(ivfastplm.core(y = as.matrix(y[boot.id,]),
                                               x = as.matrix(x[boot.id,]),
                                               z = as.matrix(z[boot.id,]),
                                               ind = as.matrix(ind[boot.id,]),
                                               robust = robust,
                                               sfe.index = sfe.index, cfe.index = cfe.index,
                                               se = 1, cl = NULL, core.num = core.num))

                if ('try-error' %in% class(boot.model)) {
                    return(rep(NA, p))
                } else {
                    boot.use <- (boot.model$est.coefficients[, "Coef"]-model.iv$est.coefficients[, "Coef"])/boot.model$est.coefficients[, "Std. Error"]
                    return(c(boot.use))
                }
            }

            if (parallel == TRUE) {
                boot.out <- foreach(j = 1:nboots,
                                        .inorder = FALSE,
                                        .export = use.fun,
                                        .packages = c("fastplm")
                                        ) %dopar% {
                                            return(one.boot())
                                        }
                for (j in 1:nboots) {
                    boot.coef[, j] <- c(boot.out[[j]])
                }
            } else {
                for (i in 1:nboots) {
                    boot.coef[, i] <- one.boot()
                    if (i%%50==0) cat(i) else cat(".")
                }
            }

            wald.refinement <- matrix(NA,nrow=0,ncol=6)
            null.totest <- model.iv$est.coefficients[,'t value']
            for(k in 1:length(null.totest)){
                p.refine <- get.pvalue(boot.coef[k,],to_test=null.totest[k])
                CI.refine <- quantile(boot.coef[k,], probs = c(0.025,0.975), na.rm = TRUE)*model.iv$est.coefficients[k,'Std. Error'] + model.iv$est.coefficients[k,'Coef']
                refine.sub <- c(model.iv$est.coefficients[k,'Coef'],
                                model.iv$est.coefficients[k,'Std. Error'],
                                model.iv$est.coefficients[k,'t value'],
                                p.refine,
                                CI.refine[1],
                                CI.refine[2])
                wald.refinement <- rbind(wald.refinement,refine.sub)
            }
            colnames(wald.refinement) <- c("Coef","Std Error","t value",
                                               "Refined P value","Refined CI_lower",
                                               "Refined CI_upper")
            rownames(wald.refinement) <- colnames(dx)
            model.iv$refinement <- list(wald.refinement = wald.refinement, boot.wald = boot.coef)
        }
        }
        else{ #clustered
            if (refinement == 0) {
                cat("Pairs Bootstrap without Percentile-t Refinement.\n")
                boot.coef <- matrix(NA, p, nboots)
                if (dim(cluster)[2] == 1) {
                    ## one-way cluster
                    raw.cluster <- as.numeric(as.factor(cluster))
                    level.cluster <- unique(raw.cluster)
                    ## level.count <- table(raw.cluster)
                    split.id <- split(1:dim(y)[1], raw.cluster)
                    one.boot <- function(num = NULL) {
                        level.id <- sample(level.cluster, length(level.cluster), replace = TRUE)
                        boot.id <- c()
                        for (j in 1:length(level.id)) {
                            boot.id <- c(boot.id, split.id[[level.id[j]]])
                        }
                        boot.model <- try(ivfastplm.core(y = as.matrix(y[boot.id,]),
                                                         x = as.matrix(x[boot.id,]),
                                                         z = as.matrix(z[boot.id,]),
                                                         ind = as.matrix(ind[boot.id,]),
                                                         sfe.index = sfe.index, cfe.index = cfe.index,
                                                         se = 0, cl = NULL, core.num = core.num))
                        if ('try-error' %in% class(boot.model)) {
                            return(rep(NA, p))
                        } else {
                            return(c(boot.model$coefficients))
                        }
                    }

                    if (parallel == TRUE) {
                        boot.out <- foreach(j = 1:nboots,
                                            .inorder = FALSE,
                                            .export = use.fun,
                                            .packages = c("fastplm")
                                            ) %dopar% {
                                                return(one.boot())
                                            }
                        for (j in 1:nboots) {
                            boot.coef[, j] <- c(boot.out[[j]])
                        }
                    } else {
                        for (i in 1:nboots) {
                            boot.coef[, i] <- one.boot()
                            if (i%%50==0) cat(i) else cat(".")
                        }
                    }

                    P_x <- as.matrix(apply(boot.coef, 1, get.pvalue))
                    stderror <- as.matrix(apply(boot.coef, 1, sd, na.rm = TRUE))
                    CI <- t(apply(boot.coef, 1, quantile, c(0.025, 0.975), na.rm = TRUE))
                    ## rewrite uncertainty estimates
                    est.coefficients <- cbind(model.iv$coefficients, stderror,model.iv$coefficients/stderror, P_x, CI)
                    colnames(est.coefficients) <- c("Coef", "Std. Error","Z Value", "P Value", "CI_lower", "CI_upper")
                    rownames(est.coefficients) <- colnames(dx)
                    model.iv$est.coefficients <- est.coefficients

                    vcov <- as.matrix(cov(t(boot.coef),use="na.or.complete"))
                    colnames(vcov) <- colnames(dx)
                    rownames(vcov) <- colnames(dx)
                    model.iv$vcov <- vcov
                }
                else if (dim(cluster)[2] == 2) {
                    ## two-way cluster
                    boot.coef1 <- boot.coef2 <- boot.coef3 <- matrix(NA, p, nboots)
                    ## level 1
                    raw.cluster1 <- as.numeric(as.factor(cluster[,1]))
                    level.cluster1 <- unique(raw.cluster1)
                    ## level 2
                    raw.cluster2 <- as.numeric(as.factor(cluster[,2]))
                    level.cluster2 <- unique(raw.cluster2)
                    ## intersection
                    raw.cluster3 <- as.numeric(as.factor(paste(cluster[,1], "-:-", cluster[,2], sep = "")))
                    level.cluster3 <- unique(raw.cluster3)

                    split.id1 <- split(1:dim(y)[1], raw.cluster1)
                    split.id2 <- split(1:dim(y)[1], raw.cluster2)
                    split.id3 <- split(1:dim(y)[1], raw.cluster3)

                    one.boot <- function(num = NULL) {
                        ## level 1
                        level.id1 <- sample(level.cluster1, length(level.cluster1), replace = TRUE)
                        boot.id1 <- c()
                        for (j in 1:length(level.id1)) {
                            boot.id1 <- c(boot.id1, split.id1[[level.id1[j]]])
                        }

                        ## level 2
                        level.id2 <- sample(level.cluster2, length(level.cluster2), replace = TRUE)
                        boot.id2 <- c()
                        for (j in 1:length(level.id2)) {
                            boot.id2 <- c(boot.id2, split.id2[[level.id2[j]]])
                        }

                        ## intersection
                        level.id3 <- sample(level.cluster3, length(level.cluster3), replace = TRUE)
                        boot.id3 <- c()
                        for (j in 1:length(level.id3)) {
                            boot.id3 <- c(boot.id3, split.id3[[level.id3[j]]])
                        }

                        ## level 1
                        boot.model1 <- try(ivfastplm.core(y = as.matrix(y[boot.id1,]),
                                                         x = as.matrix(x[boot.id1,]),
                                                         z = as.matrix(z[boot.id1,]),
                                                         ind = as.matrix(ind[boot.id1,]),
                                                         sfe.index = sfe.index, cfe.index = cfe.index,
                                                         se = 0, cl = NULL, core.num = core.num))
                        if ('try-error' %in% class(boot.model1)) {
                            oneboot.coef1 <- rep(NA, p)
                        } else {
                            oneboot.coef1 <- c(boot.model1$coefficients)
                        }

                        ## level 2
                        boot.model2 <- try(ivfastplm.core (y = as.matrix(y[boot.id2,]),
                                                         x = as.matrix(x[boot.id2,]),
                                                         z = as.matrix(z[boot.id2,]),
                                                         ind = as.matrix(ind[boot.id2,]),
                                                         sfe.index = sfe.index, cfe.index = cfe.index,
                                                         se = 0, cl = NULL, core.num = core.num))
                        if ('try-error' %in% class(boot.model2)) {
                            oneboot.coef2 <- rep(NA, p)
                        } else {
                            oneboot.coef2 <- c(boot.model2$coefficients)
                        }

                        ## intersection
                        boot.model3 <- try(ivfastplm.core (y = as.matrix(y[boot.id3,]),
                                                         x = as.matrix(x[boot.id3,]),
                                                         z = as.matrix(z[boot.id3,]),
                                                         ind = as.matrix(ind[boot.id3,]),
                                                         sfe.index = sfe.index, cfe.index = cfe.index,
                                                         se = 0, cl = NULL, core.num = core.num))
                        if ('try-error' %in% class(boot.model3)) {
                            oneboot.coef3 <- rep(NA, p)
                        } else {
                            oneboot.coef3 <- c(boot.model3$coefficients)
                        }

                        return(list(oneboot.coef1 = oneboot.coef1,
                                    oneboot.coef2 = oneboot.coef2,
                                    oneboot.coef3 = oneboot.coef3))

                    }

                    if (parallel == TRUE) {
                        boot.out <- foreach(j = 1:nboots,
                                            .inorder = FALSE,
                                            .export = use.fun,
                                            .packages = c("fastplm")
                                            ) %dopar% {
                                                return(one.boot())
                                            }
                        for (j in 1:nboots) {
                            boot.coef1[, j] <- c(boot.out[[j]]$oneboot.coef1)
                            boot.coef2[, j] <- c(boot.out[[j]]$oneboot.coef2)
                            boot.coef3[, j] <- c(boot.out[[j]]$oneboot.coef3)
                        }
                    } else {
                        for (i in 1:nboots) {
                            boot.sub <- one.boot()
                            boot.coef1[, i] <- c(boot.sub$oneboot.coef1)
                            boot.coef2[, i] <- c(boot.sub$oneboot.coef2)
                            boot.coef3[, i] <- c(boot.sub$oneboot.coef3)
                            if (i%%50==0) cat(i) else cat(".")
                        }
                    }

                    stderror1 <- as.matrix(apply(boot.coef1, 1, sd, na.rm = TRUE))
                    stderror2 <- as.matrix(apply(boot.coef2, 1, sd, na.rm = TRUE))
                    stderror3 <- as.matrix(apply(boot.coef3, 1, sd, na.rm = TRUE))
                    stderror <- stderror1 + stderror2 - stderror3

                    vcov1 <- as.matrix(cov(t(boot.coef1),use="na.or.complete"))
                    vcov2 <- as.matrix(cov(t(boot.coef2),use="na.or.complete"))
                    vcov3 <- as.matrix(cov(t(boot.coef3),use="na.or.complete"))
                    vcov <- vcov1 + vcov2 - vcov3
                    colnames(vcov) <- colnames(dx)
                    rownames(vcov) <- colnames(dx)
                    model.iv$vcov <- vcov

                    CI <- cbind(c(model.iv$coefficients) - qnorm(0.975)*c(stderror), c(model.iv$coefficients) + qnorm(0.975)*c(stderror))
                    Zx <- c(model.iv$coefficients)/c(stderror)
                    P_z <- 2 * min(1 - pnorm(Zx), pnorm(Zx))
                    ## rewrite uncertainty estimates
                    est.coefficients <- cbind(model.iv$coefficients, stderror, Zx, P_z, CI)
                    colnames(est.coefficients) <- c("Coef", "Std. Error", "Z value", "Pr(>|Z|)", "CI_lower", "CI_upper")
                    rownames(est.coefficients) <- colnames(dx)
                    model.iv$est.coefficients <- est.coefficients
                }
            }

            if(refinement==1){
                cat("Pairs Bootstrap with Percentile-t Refinement.\n")
                ## bootstrap refinement
                boot.coef <- matrix(NA, p, nboots)

                if(dim(cluster)[2]==1){
                    ## one-way cluster
                    raw.cluster <- as.numeric(as.factor(cluster))
                    level.cluster <- unique(raw.cluster)
                    level.count <- table(raw.cluster)
                }
                if(dim(cluster)[2]==2){
                    stop("For pairs bootstrap with refinement, please only specify one cluster variable.\n")
                    if(is.null(bootcluster)){
                        level.cluster.1 <- unique(as.numeric(as.factor(cluster[,1])))
                        level.cluster.2 <- unique(as.numeric(as.factor(cluster[,2])))
                        if(length(level.cluster.1)<=length(level.cluster.2)){
                            raw.cluster <- as.numeric(as.factor(cluster[,1]))
                            bootcluster <- colnames(cluster)[1]
                        }else{
                            raw.cluster <- as.numeric(as.factor(cluster[,2]))
                            bootcluster <- colnames(cluster)[2]
                        }
                        level.cluster <- unique(raw.cluster)
                        level.count <- table(raw.cluster)
                    }else{
                        raw.cluster <- as.numeric(as.factor(cluster[,bootcluster]))
                        level.cluster <- unique(raw.cluster)
                        level.count <- table(raw.cluster)
                    }
                    cat(paste0("Mutiple Clustered Pairs Bootstrap with Refinement: (Boot)Clustered at ",bootcluster," level.\n"))
                }

                split.id <- split(1:dim(y)[1], raw.cluster)

                one.boot <- function(num = NULL) {
                    level.id <- sample(level.cluster, length(level.cluster), replace = TRUE)
                    boot.id <- c()
                    boot.cluster <- c()
                    for (j in 1:length(level.id)) {
                        boot.id <- c(boot.id, split.id[[level.id[j]]])
                        boot.cluster <- c(boot.cluster, rep(j, level.count[level.id[j]]))
                    }
                    boot.cluster <- as.matrix(boot.cluster)

                    boot.model <- try(ivfastplm.core (y = as.matrix(y[boot.id,]),
                                                    x = as.matrix(x[boot.id,]),
                                                    z = as.matrix(z[boot.id,]),
                                                    ind = as.matrix(ind[boot.id,]), robust = robust,
                                                    sfe.index = sfe.index, cfe.index = cfe.index,
                                                    se = 1, cl = boot.cluster, core.num = core.num))
                    if ('try-error' %in% class(boot.model)) {
                        return(rep(NA, p))
                    } else {
                        return(c(boot.model$coefficients - model.iv$coefficients)/c(boot.model$est.coefficients[, "Std. Error"]))
                    }
                }

                if (parallel == TRUE) {
                    boot.out <- foreach(j = 1:nboots,
                                        .inorder = FALSE,
                                        .export = use.fun,
                                        .packages = c("fastplm")
                                        ) %dopar% {
                                            return(one.boot())
                                        }
                    for (j in 1:nboots) {
                        boot.coef[, j] <- c(boot.out[[j]])
                    }
                } else {
                    for (i in 1:nboots) {
                        boot.coef[, i] <- one.boot()
                        if (i%%50==0) cat(i) else cat(".")
                    }
                }

                wald.refinement <- matrix(NA,nrow=0,ncol=6)
                null.totest <- model.iv$est.coefficients[,'t value']
                for(k in 1:length(null.totest)){
                    p.refine <- get.pvalue(boot.coef[k,],to_test=null.totest[k])
                    CI.refine <- quantile(boot.coef[k,], probs = c(0.025,0.975), na.rm = TRUE)*model.iv$est.coefficients[k,'Std. Error'] + model.iv$est.coefficients[k,'Coef']
                    refine.sub <- c(model.iv$est.coefficients[k,'Coef'],
                                    model.iv$est.coefficients[k,'Std. Error'],
                                    model.iv$est.coefficients[k,'t value'],
                                    p.refine,
                                    CI.refine[1],
                                    CI.refine[2])
                    wald.refinement <- rbind(wald.refinement,refine.sub)
                }
                colnames(wald.refinement) <- c("Coef","Std Error","t value",
                                               "Refined P value","Refined CI_lower",
                                               "Refined CI_upper")
                rownames(wald.refinement) <- colnames(dx)
                model.iv$refinement <- list(wald.refinement = wald.refinement, boot.wald = boot.coef)
            }
        }
    }
    if(parallel==TRUE){
        suppressWarnings(stopCluster(pcl))
    }

    return(model.iv)

}


####################################################################
#
#        LD-Calculation Chicken Data
#
####################################################################

### NH (Thuy) wrote this script for Chicken and sent it to TB (Tim) on May 17,
### 2017, to modify for maize data

wqsGeno <- read.csv("/home/beissinger/Documents/WQS/DATA/genoWQS_randImp.csv",stringsAsFactors=F,header=T)
wqsMap <- read.csv("/home/beissinger/Documents/WQS/DATA/wqsMap_randImp.csv",stringsAsFactors=FALSE, header=TRUE)
all(order(wqsMap[,2],wqsMap[,3])==1:nrow(wqsMap))
#[1] TRUE    --> Check whether SNPs are already ordered

### Remove chromosome 0
remMap <- which(wqsMap$Chromosome == 0)
remGeno <- remMap+1
wqsGeno<-wqsGeno[,-remGeno]
wqsMap<-wqsMap[-remMap,]

### Subset genotypic data by cycle
C0Gen <- wqsGeno[1:5,]
C1Gen <- wqsGeno[6:16,]
C2Gen <- wqsGeno[17:179,]
C3Gen <- wqsGeno[180:267,]
C4Gen <- wqsGeno[268:437,]
C5Gen <- wqsGeno[438:648,]

### function to calculate correlation pairwise --> more efficient than cor:
cor1 <- function(x1,x2){
  x1 <- as.matrix(x1)
  x2 <- as.matrix(x2)
  sx1 <- t(x1)-colMeans(x1)
  sx2 <- t(x2)-colMeans(x2)
  cc <- (rowSums(sx1*sx2))/(sqrt(rowSums(sx1^2)*rowSums(sx2^2)))
  return(cc)
}

### package for parallelization
library("parallel")

### Max distant between SNPs in #SNPs to calculate
mdiff <- 2000

### Analyze all 10 chromosomes:
alld1 <- matrix(0,nrow=10,ncol=mdiff)

## Set up for loop
amap <- wqsMap ## assign wqsMap to "amap", as needed for loop below.
#a <- C5Gen[,2:ncol(C5Gen)] ## This creates "a", a genotype matrix that matches map (no individual names)
a <- wqsGeno[,2:ncol(wqsGeno)] ## This creates "a", a genotype matrix that matches map (no individual names)
rownames(a) <- C5Gen$x ## Assign individual names as taxa

for(rr in 10:1){      ## loop starts with smallest chromosome
       print(paste("Chromosome",rr))
       af <- a[,amap[,2]==rr,drop=FALSE]
       if(ncol(af)==0) next
       print(dim(af))
       ind <- 1:ncol(af)

       fun <- function(i){  # 1:mdiff; function to calculate r^2 for all SNPs with distance i to each other
           if(i<=ncol(af)){ld1 <- mean(cor1(af[,head(ind,-i)],af[,tail(ind,-i)])^2,na.rm=TRUE)}
            else{ld1 <- 0}
          return(ld1)
        }

       ## calculation of r^2 ; parallelization using 4 cores
       ld1 <- unlist(mclapply(1:2000, FUN=fun,  mc.preschedule = TRUE, mc.cores = 4))

       alld1[rr,] <- ld1
}

#save(alld1,file="Res_maize_Chrwise.RData")

##########################################################################
#
#        Plotting r^2 results
#
##########################################################################

tag <- "Maize"       # Brown or white layer

## loading data
#a <- readRDS(paste("zMat_",tag, ".RDS",sep=""))
#amap <- read.table(paste("markerkarte_",tag,".txt",sep=""),stringsAsFactors=FALSE, header=TRUE)
laeng <- unlist(lapply(by(amap[,3],amap[,2],diff),FUN=median))        ## median distance between snps, chromosomewise

## load r^2 results
#load(file=paste("Res_",tag,"_Chrwise.RData",sep=""))
#alld1 <- alld1[-c(29,30),]                ## chromosome 29 and 30 had no SNPs data

### Make pdf
jpeg("maizeLD_03.jpg",height=800,width=1000)
#pdf("maizeLD_03.pdf",height=8.5,width=11)

## function to get the minimal distance with r^2 < 0.05
f <- function(x){return(min(which(x<0.03)))}
dd <- apply(alld1,1,f)

ltt <- rep(1:5,each=8)   ## to set the line types

## set screens for split.screen
sc <- rbind(c(0,0.8,0,1),c(0.75,1,0,1),c(0.4,0.75,0.5,1))
split.screen(sc)

## Plot LD-curves
screen(1)
plot(alld1[1,],ylab="r^2", xlab="Distance in #SNPs", type="l", xlim=c(0,500),ylim=c(0,0.5),col="white",bty="n",main=paste("Maize",ncol(a),"SNPs and",nrow(a),"Individuals" ))
for(i in 1:nrow(alld1)){
      lines(alld1[i,], lwd=2, col=i,lty=ltt[i])
}
abline(h=0.03,col="red",lwd=2)

## Plot Legends
screen(2)
par(mai=c(0,0,0,0))
plot(1:1000,1:1000, col="white",axes=FALSE,xlab="", ylab="",bty="n")
legend(1,900, legend=c("Chr: #SNPs : Thres.(LD<0.03)",paste(c(1:10),tag,dd,sep="   :   ")),col=0:nrow(alld1),lty=c(0,ltt[1:nrow(alld1)]),lwd=2,bty="n",cex=0.9)

## Plot mean distance versus minima? distance
screen(3)
x <- as.numeric(laeng)
y <- dd
fit <-  lm(y~x)$coefficients
plot(x, y,type="p",xlab="Mean Distance (bp) between SNPs", ylab="Threshold",pch=18,col=1:nrow(alld1))
abline(fit,col="red",lwd=2)

close.screen(all=T)
dev.off()


# Set up data filters:
# Since there are so many possibilities there will be no attempt to parametrize all
# filtering. It is the responsibility of the user to construct any extra filtering.
# Each filter will be passed a 3d matrix
# 1st dim is time; 2nd is variable; 3rd is site.
# A condensed example:
# dimnames(site.data) =
#   $MAIAC.time
#     NULL
#   $data.names
#    [1] "year"                         "month"
#    [3] "day"                          "DOY"
#   $site
#    [1] "EPA_Stockton"       "EPA_Manteca"        "EPA_Modesto"
# The value returned should have the same structure.

# Remove extreme PM2.5 values:
filter.PM2.5 = function(dat) {
  PM2.5.min = 10
  PM2.5.max = 55
  dat.2 = dat[,'PM2.5',]
  dat.2[dat.2<PM2.5.min] = NA
  dat.2[dat.2>PM2.5.max] = NA
  dat[,'PM2.5',] = dat.2
  dat
}
# Delete some sites
# What was the criterion for this?
filter.sites = function(dat) {
  Omit.sites = c(
   "EPA_Roseville", "EPA_Folsom", "EPA_Sacramento", "EPA_Sacramento-DelPasoManor", "EPA_Sacramento-TStreet",
   "EPA_Davis", "EPA_San.Andreas",
   "DRAGON_Madera",  "DRAGON_Parlier",  "DRAGON_Visalia", "EPA_Coarsegold", "EPA_Corcoran", "EPA_Santa.Rosa.Rancheria", "DRAGON_Shafter")
  keep.sites = setdiff(dimnames(dat)[[3]],Omit.sites)
  dat = dat[,,keep.sites]
  dat
}
filter.site.sample = function(dat) {
  w.samp = sample(1:(dim(dat)[3]),.1*(dim(dat)[3]))
  w.samp = sample(1:(dim(dat)[3]),2)
  dat[,,w.samp,drop=F]
}
# Restrict to afternoon hours
filter.localhour = function(dat) {
  lon.mean = mean(dat[1,'lon',])
  local.hour = dat[,'hour',1] + lon.mean / 15
  w.aft = which(local.hour >= 12 & local.hour <= 18)
  dat[w.aft,,]
}
# Remove nonpositive PBL heights
# Remove zero also since using AOT/ML
filter.RAP_PBL_hgt = function(dat) {
  dat.2 = dat[,'PBL_hgt.R',]
  dat.2[dat.2<=0] = NA
  dat[,'PBL_hgt.R',] = dat.2
  dat
}
# Smaller number of days
# Use only days points by another regression
# Works on the data frame instead of the 3d array
filter.df.DOY = function(df) {
  d.r = readRDS('~esswein/science/region/daq/CA2013/StatModel/SJV.PM2.5.Regress.results/Regress.PM2.5.CWV.Bc.rds')
  rows.used = as.integer(rownames(model.frame(d.r$fit)))
  index.used = which(as.integer(rownames(df)) %in% rows.used)
  df = df[index.used,]
  df
}


library(tidyverse)
library(dslabs)
data(murders)

ggplot(data = murders)

murders %>% ggplot

p <- ggplot(data = murders)

murders %>% ggplot() +
    geom_point(aes(x = population/10^6, y = total))

# add points layer to predefined ggplot object
p <- ggplot(data = murders)
p + geom_point(aes(population/10^6, total))

# add text layer to scatterplot
p + geom_point(aes(population/10^6, total)) +
    geom_text(aes(population/10^6, total, label = abb))

#Code: Example of aes behavior

p_test <- p + geom_text(aes(population/10^6, total, label = abb))

# change the size of the points
p + geom_point(aes(population/10^6, total), size = 3) +
    geom_text(aes(population/10^6, total, label = abb))

# move text labels slightly to the right
p + geom_point(aes(population/10^6, total), size = 3) +
    geom_text(aes(population/10^6, total, label = abb), nudge_x = 1)

# simplify code by adding global aesthetic
p <- murders %>% ggplot(aes(population/10^6, total, label = abb))
p + geom_point(size = 3) +
    geom_text(nudge_x = 1.5)

# local aesthetics override global aesthetics
p + geom_point(size = 3) +
    geom_text(aes(x = 10, y = 800, label = "Hello there!"))


# R --slave --args epi tombo prefix < join.r

args<-commandArgs(TRUE)
epi	<- args[1]
tombo	<- args[2]
prefix <- args[3]

a<-read.table(epi, sep="\t", header=FALSE)
b<-read.table(tombo, sep="\t", header=FALSE)

a$V2<-"epinano"
b$V2<-"tombo"

c<-merge(a,b, all=T, by.x="V1", by.y="V1", sort=FALSE)
colnames(c)<-c("positions", "epinano", "tombo")

c[c=="epinano"]<-1
c[c=="tombo"]<-1
c[is.na(c)]<-0

write.table(c, file = "RNA_modifications.txt", sep="\t", row.names = FALSE)

library(VennDiagram)
library(RColorBrewer)
myCol <- c("#B3E2CD","#FDCDAC")

venn.diagram(
    x = list(a$V1, b$V1),
    category.names = c("Epinano", "Tombo"),
    filename = 'venn_diagram.png',
    imagetype = "png",
    output=TRUE,
    height = 1024,
    width = 1024 ,
    resolution = 300,
    compression = "lzw",
    main.pos = c(0.5,0.7),

	# Circles
	lwd = 2,
	lty = 'blank',
	fill = myCol,
	margin = 0.6,
    main = prefix,
    main.fontfamily = "sans",

	# Numbers
	cex = .6,
	fontface = "bold",
	fontfamily = "sans",

    # Set names
    cat.cex = 0.6,
    cat.fontface = "bold",
    cat.default.pos = "outer",
    cat.pos = c(-135, 135),
    cat.fontfamily = "sans"
)


# vim: shiftwidth=2 tabstop=2
##------------------------------------------------------------------------------
#' binR
#'
#' Bin a dataset using a formula and a breaks function
#'
#' Discretize a dataset using a formula.
#'
#' @author Vilhelm von Ehrenheim
#' @import foreach
#' @import rpart
#' @export
##------------------------------------------------------------------------------
binR <- function(fx, data, algorithm=c("quantile", "rpart", "manual"), ...) {
  # Extract additional arguments
  dots <- list(...)

  # Match algorithm and run the respective function w additional args
  out <- switch(match.arg(algorithm, c("quantile", "rpart", "manual")),
                quantile=do.call(binR_quantile, c(list(fx), list(data), dots)),
                rpart=do.call(binR_rpart, c(list(fx), list(data), dots)),
                manual=do.call(binR_manual, c(list(fx), list(data), dots)))
  out
}


#install.packages("magrittr") #uncomment if library function says not installed :)
library("magrittr")

df1 <- read.table("R:/R_WD/Thesis/JustDeserts/WorldValuesSurvey/ESSGSSCombinedDataset1.txt", sep = "|", header = TRUE, stringsAsFactors = FALSE)
str(df1)
df1$income %>% range()
#supposed to be ordinal from [1, 12]
#so oops didn't finish cleaning

df1$paytaxes <- df1$paytaxes %>% as.ordered()
df1$sex <- df1$sex %>% as.factor()
# #just an example of how as.ordered() works
# #uncomment and run if you want to see how it works :)git lol I guess that's where my git command went XD
# x <- c(1,2,1,2,4,3,2,1,2,3,2,3,2,1,1,1,1,1)
# x <- as.ordered(x)
# str(x)

(incomelevels <- df1$income %>% as.ordered() %>% levels())
#the GSS coded income:
# 13  <- refused
# 98  <- Don't Know
# 99  <- no answer
# 0   <- NA
#The ESS coded hinctnt:
#  77  <- Refusal
#  88  <- Don't know
#  99  <- No answer
# So the ESS wasn't completely cleaned. Darnit! lol

df1$income <- ifelse(df1$income > 12, NA, df1$income)
(incomelevels <- df1$income %>% as.ordered() %>% levels())

df2 <- df1[!is.na(df1$income ),]
#This looks messy so I'll explain
# is.na(df1$income) returns a boolean vector the same length as df1$income
# true if na, false if any other value
# the ! operator gives a logical not, so it flips true -> false, false -> true
# [ a, b] is indexing the datastructure
# for a dataframe, a is the row, b is the column
# since the dataframe stores variables as columns, the vector of is.na(df1$income)
# indicates if each row in that column is na
# I don't want NA so I told R to only keep the non na values
str(df1) #2339 obs
str(df2) #2095 obs
df2$income %>% range() # 1 12

df2 %>% write.table(file = "R:/R_WD/Thesis/JustDeserts/WorldValuesSurvey/ESSGSSCombinedDataset2.txt", sep = "|", col.names = TRUE, row.names = FALSE)
# ls()
# rm(list = ls())
# #I ran this but I commented it in case anyone else trys to run my code :)

df3 <- read.table(file = "R:/R_WD/Thesis/JustDeserts/WorldValuesSurvey/ESSGSSCombinedDataset2.txt", sep = "|", header = TRUE )

df3 %>% str()
df3$gssOrEss %>% hist

df3$gssOrEss2 <- -1 * df3$gssOrEss
df3$gssOrEss2 <-  df3$gssOrEss2 + 2
hist(df3$gssOrEss2) #now that it's been swapped, need to reassign to gssOrEss
df3$gssOrEss <- df3$gssOrEss2
hist(df3$gssOrEss)
df3$gssOrEss2 <- NULL #removes variable from df3
#df3$gssOrEss <- df3$gssOrEss - 1 #Realized I needed to swap the ordering and make it a 0/1 dummy
#df3$gssOrEss %>% str()

df3$paytaxes <- df3$paytaxes %>% as.ordered()
#paytaxes is needed to fit the model using polr
#the rest seem to be a good idea but I'll see if it makes sense later

df3$sex <- df3$sex %>% as.factor()
df3$gssOrEss <- df3$gssOrEss %>% as.factor()
df3$income <- df3$income %>% as.ordered()
df3$year <- as.factor(df3$year)
df3 %>% str()

library("MASS")
form <- "paytaxes ~ gssOrEss + year + income + age + sex"
fm1 <- polr(form, data = df3,  method = "logistic")
# dv paytaxes, independant varaible hypothesis testing: gssOrEss
# Gss is all USA respondants
# Ess was subsetted to only have italian respondants
# decided not t use weights.
summary(fm1)

# what happens if I fit the model with weights
# not sure it makes sense to use these weights this way. *shrug*
fm2 <- polr( form, data = df3, weights = weight, method = "logistic")
summary(fm2)


#' ---
#' title: "Prior probabilities in the interpretation of 'some': analysis of model predictions and empirical data"
#' author: "Judith Degen"
#' date: "November 28, 2014"
#' ---

library(ggplot2)
theme_set(theme_bw(18))
#setwd("~/Dropbox/thegricean_sinking-marbles/models/complex_prior/results/")
setwd("/Users/titlis/cogsci/projects/stanford/projects/thegricean_sinking-marbles/models/complex_prior/smoothed_unbinned15/results/")
source("rscripts/helpers.r")

#' get model predictions
load("data/mp.RData")
mp = read.table("data/parsed_nullutterance_results.tsv", quote="", sep="\t", header=T)
nrow(mp)
head(mp)
summary(mp)

# get prior expectations
priorexpectations = read.table(file="~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/experiments/12_sinking-marbles-prior15/results/data/expectations.txt",sep="\t", header=T, quote="")
row.names(priorexpectations) = paste(priorexpectations$effect,priorexpectations$object)
head(priorexpectations)
mp$PriorExpectation = priorexpectations[as.character(mp$Item),]$expectation

priorprobs = read.table(file="~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/experiments/12_sinking-marbles-prior15/results/data/smoothed_15marbles_priors_withnames.txt",sep="\t", header=T, quote="")
head(priorprobs)
row.names(priorprobs) = paste(priorprobs$effect,priorprobs$object)
mpriorprobs = melt(priorprobs, id.vars=c("effect", "object"))
head(mpriorprobs)
row.names(mpriorprobs) = paste(mpriorprobs$effect,mpriorprobs$object,mpriorprobs$variable)
mp$PriorProbability = mpriorprobs[paste(as.character(mp$Item)," X",mp$State,sep=""),]$value
mp$AllPriorProbability = priorprobs[paste(as.character(mp$Item)),]$X15
head(mp)

# get empirical state posteriors:
load("/Users/titlis/cogsci/projects/stanford/projects/thegricean_sinking-marbles/experiments/3_sinking-marbles-nullutterance/results/data/r.RData")
head(r)
r$Item = as.factor(paste(r$effect,r$object))
# because posteriors come in 4 bins, make Bin variable for model prediction dataset:
mp$Proportion = as.factor(ifelse(mp$State == 0, "0", ifelse(mp$State == 15, "100", ifelse(mp$State < 8, "1-50", "51-99"))))

agr = aggregate(normresponse ~ Item + quantifier + Proportion,data=r,FUN=mean)
#agr$CILow = aggregate(normresponse ~ Item + quantifier + Proportion,data=r, FUN=ci.low)$normresponse
#agr$CIHigh = aggregate(normresponse ~ Item + quantifier + Proportion,data=r,FUN=ci.high)$normresponse
#agr$YMin = agr$normresponse - agr$CILow
#agr$YMax = agr$normresponse + agr$CIHigh
agr$Quantifier = as.factor(tolower(agr$quantifier))
row.names(agr) = paste(agr$Item, agr$Proportion, agr$Quantifier)
mp$PosteriorProbability_empirical = agr[paste(mp$Item,mp$Proportion,"some"),]$normresponse

summary(mp)
#plot empirical against predicted distributions for "some"
some = ddply(mp, .(Item, QUD, Alternatives, SpeakerOptimality, PriorExpectation, Proportion, PosteriorProbability_empirical), summarise, PosteriorProbability_predicted=sum(PosteriorProbability), PriorProbability_smoothed=sum(PriorProbability))
#some= subset(some, Quantifier == "some")
nrow(some)
head(some)
msome = melt(some, measure.vars=c("PosteriorProbability_empirical","PosteriorProbability_predicted","PriorProbability_smoothed"))
msome$ptype = as.factor(ifelse(msome$variable == "PosteriorProbability_empirical", "posterior (empirical)",ifelse(msome$variable == "PosteriorProbability_predicted","posterior (model)", "prior")))
head(msome)
nrow(msome)
summary(msome)

toplot = droplevels(subset(msome, QUD == "how-many" & SpeakerOptimality == 2 & Alternatives == "0_basic"))#"0_basic1_lownum2_extra4_twowords5_threewords"))
nrow(toplot)
toplot$Probability = as.factor(ifelse(toplot$ptype == "prior","prior","posterior"))
toplot$Prop = factor(toplot$Proportion, levels=c("1-50","51-99","100"))
ggplot(toplot, aes(x=Prop, y=value,color=ptype, group=ptype, size=Probability)) +
  geom_point() +
  geom_line() +
  scale_size_discrete(range=c(1,2)) +
  scale_color_manual(values=c("red","blue","black")) +
  facet_wrap(~Item)
ggsave("graphs/model-empirical-howmany-2-basic-null.pdf",width=35,height=30)

#plot empirical against predicted allstate-prbabilities for "some"
allstate = droplevels(subset(mp, State == 15))
cors = ddply(allstate, .(Alternatives, QUD, SpeakerOptimality), summarise, r=cor(PosteriorProbability, PosteriorProbability_empirical))
cors = cors[order(cors[,c("r")],decreasing=T),]
head(cors)
# .55 correlation despite being shitty model

ggplot(allstate, aes(x=PosteriorProbability, y=PosteriorProbability_empirical,color=as.factor(SpeakerOptimality))) +
  geom_point() +
  geom_smooth() +
  geom_abline(intercept=0,slope=1,color="gray50") +
  scale_x_continuous(limits=c(0,1)) +
  scale_y_continuous(limits=c(0,1)) +
  #  geom_text(data=cors, aes(label=r)) +
  #scale_size_discrete(range=c(1,2)) +
  #scale_color_manual(values=c("red","blue","black")) +
  facet_grid(QUD~Alternatives)
ggsave("graphs/model-empirical-nullutterance-allstateprobs.pdf",width=30,height=10)

#maybe COGSCI plot basis? plot  predicted allstate-prbabilities for "some" as a function of prior allstate-probabilities

ggplot(allstate, aes(x=PriorProbability, y=PosteriorProbability,color=as.factor(SpeakerOptimality))) +
  geom_point() +
  geom_smooth() +
  geom_abline(intercept=0,slope=1,color="gray50") +
  scale_x_continuous(limits=c(0,1)) +
  scale_y_continuous(limits=c(0,1)) +
  #  geom_text(data=cors, aes(label=r)) +
  #scale_size_discrete(range=c(1,2)) +
  #scale_color_manual(values=c("red","blue","black")) +
  facet_grid(QUD~Alternatives)
ggsave("graphs/model-nullutterance-allstateprobs.pdf",width=30,height=10)

#plot empirical against predicted expectations for "some"
load("/Users/titlis/cogsci/projects/stanford/projects/thegricean_sinking-marbles/experiments/13_sinking-marbles-priordv-15/results/data/r.RData")
summary(r)
r$Item = as.factor(paste(r$effect, r$object))
agr = aggregate(ProportionResponse ~ Item + quantifier, data=r, FUN=mean)
#agr$CILow = aggregate(ProportionResponse ~ Item + quantifier,data=r, FUN=ci.low)$ProportionResponse
#agr$CIHigh = aggregate(ProportionResponse ~ Item + quantifier,data=r,FUN=ci.high)$ProportionResponse
#agr$YMin = agr$ProportionResponse - agr$CILow
#agr$YMax = agr$ProportionResponse + agr$CIHigh
agr$Quantifier = as.factor(tolower(agr$quantifier))
row.names(agr) = paste(agr$Item, agr$Quantifier)
mp$PosteriorExpectation_empirical = agr[paste(mp$Item,"some"),]$ProportionResponse
mp$PriorExpectation_smoothed = mp$PriorExpectation/15

pexpectations = ddply(mp, .(Item, QUD, Alternatives, SpeakerOptimality,PriorExpectation_smoothed, PosteriorExpectation_empirical), summarise, PosteriorExpectation_predicted=sum(State*PosteriorProbability)/15)
head(pexpectations)
summary(pexpectations)
some = pexpectations#droplevels(subset(pexpectations, Quantifier == "some"))

cors = ddply(some, .(Alternatives, QUD, SpeakerOptimality), summarise, r=cor(PosteriorExpectation_predicted, PosteriorExpectation_empirical))
cors = cors[order(cors[,c("r")],decreasing=T),]
head(cors)

ggplot(some, aes(x=PosteriorExpectation_predicted, y=PosteriorExpectation_empirical,color=as.factor(SpeakerOptimality))) +
  geom_point() +
  geom_smooth(method="lm") +
  geom_abline(intercept=0,slope=1,color="gray50") +
  scale_x_continuous(limits=c(0,1)) +
  scale_y_continuous(limits=c(0,1)) +
  #  geom_text(data=cors, aes(label=r)) +
  #scale_size_discrete(range=c(1,2)) +
  #scale_color_manual(values=c("red","blue","black")) +
  facet_grid(QUD~Alternatives)
ggsave("graphs/model-empirical-nullutterance-expectations.pdf",width=30,height=10)

# plot posterior expectation against prior expectation
ggplot(some, aes(x=PriorExpectation_smoothed, y=PosteriorExpectation_predicted,color=as.factor(SpeakerOptimality))) +
  geom_point() +
  geom_smooth(method="lm") +
#  geom_abline(intercept=0,slope=1,color="gray50") +
  scale_x_continuous(limits=c(0,1)) +
  scale_y_continuous(limits=c(0,1)) +
  #  geom_text(data=cors, aes(label=r)) +
  #scale_size_discrete(range=c(1,2)) +
  #scale_color_manual(values=c("red","blue","black")) +
  facet_grid(QUD~Alternatives)
ggsave("graphs/model-nullutterance-expectations.pdf",width=30,height=10)

# plot posterior expectation against prior expectation for basic model with speaker optimality =2 and qud = how-many and alternatives = basic
toplot = droplevels(subset(some, QUD=="how-many" & Alternatives == "0_basic" & SpeakerOptimality == 2))
ggplot(toplot, aes(x=PriorExpectation_smoothed, y=PosteriorExpectation_predicted)) +
  geom_point(color="#00B0F6") + #values=c("#F8766D", "#A3A500", "#00BF7D", "#E76BF3", "#00B0F6")
  geom_smooth(color="#00B0F6") +
  #  geom_abline(intercept=0,slope=1,color="gray50") +
  scale_x_continuous(limits=c(0,1), name="Prior expectation") +
  scale_y_continuous(limits=c(0,1), name="Model predicted posterior expectation")
  #  geom_text(data=cors, aes(label=r)) +
  #scale_size_discrete(range=c(1,2)) +
  #scale_color_manual(values=c("red","blue","black"))
ggsave("graphs/model-nullutterance-expectations.pdf",width=5.5,height=4.5)#,width=30,height=10)
ggsave("~/cogsci/conferences_talks/_2015/2_cogsci_pasadena/wonky_marbles/paper/pics/model-nullutterance-expectations.pdf",width=5.5,height=4.5)
save(toplot, file="data/toplot-nullutterance-expectations.RData")

save(mp, file="data/mp-nullutterance.RData")


#user interface for London Shiny
library(plotly)
library(leaflet)
library(sp)
library(maptools)
library(RColorBrewer)
library(maptools)
library(rgdal)
library(classInt)
library(shiny)

source("dataloader.r")

shinyUI(fluidPage(

  #in this new page, first plot me a nice big map
  leafletOutput("map1", width = "100%", height = 1000),

  #then, create me a nice floaty panel which has all of the options in in, plus
  #a histogram of the variables selected
  absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
                draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
                width = 330, height = "auto",
                #gimme a title
                h2("Social Statistics for Wards in London"),
                #gimme a drop down to select variables from the ward
                #boundaries dataset
                selectInput("variable", "Variable",
                            names(wardBoundaries@data)[11:79]),
                #gimme some colour options from colourbrewer
                selectInput("colourbrewerpalette", "Color Scheme",
                            rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
                ),
                selectInput("classIntStyle", "Interval Style",
                            c("Jenks Natural Breaks" = "jenks",
                              "Quantile" = "quantile",
                              "Equal Interval" = "equal",
                              "Pretty" = "pretty")),
                #plot me a nice plotly histogram
                #plotlyOutput("plot1")
                plotOutput("plot1")
  )
))

#length(names(wardBoundaries@data))


#### HARMONIZING WITH THE COV LOOPS FOR AGGREGATE AND REPLACE

# Load libraries #

library("foreign")
library("dplyr")
library("xlsx")
library("ggplot2")
library("broom")
library("MatchIt")
library("ggrepel")
library("calibrate")
library("plm")
library("gridExtra")
library("tidyr")
library("foreach")

# Code Structure

# 1) Data Construction for Matching
# 2) Matching
# 3) Plot Matching Results - Covariate Balance pre and post matching
# 4) Extract Matched Pairs from matching output
# 5) Data construction for DiD regression using matched pairs
# 6) DiD Regression
# 7) Quantifying Avoided Deforestation
# 8) Fixed Effects Panel Regression

# --------------------- 1) Data Construction for Matching -----------------------------------------#

setwd("c:/Users/desbures/Documents/Sebastien/11_Autres/Katie/Ambatovy/")

# Function to read in input data for each offset, remove unnecessary columns and add column to indicate treatment status
# and offset of origin.

  tidy_data <-function(path, name, number, label){
    name = read.dbf(path)
    name = subset(name, select= -c(1, 16))
    name$treated = number              # Number = 1 for pixels from an offset and 0 for control pixels.
    name$offset = label
    return(name)
  }

  TTF <- tidy_data("Input_data/Final_covariates/Sample_TTF3.dbf", TTF, 1, "TTF")
  ANK <- tidy_data("Input_data/Final_covariates/Sample_ANK3.dbf", ANK, 1, "ANK")
  CFAM <- tidy_data("Input_data/Final_covariates/Sample_CFAM3.dbf", CFAM, 1, "CFAM")
  CZ <- tidy_data("Input_data/Final_covariates/Sample_CZ3.dbf", CZ, 1, "CZ")

  # TTF = Torotorofotsy
  # ANK = Ankerana
  # CFAM = Corridor Forestier Analamay-Mantadia
  # CZ = Conservation Zone

  # Load Control separately because columns are different #

  Control = read.dbf("Input_data/Final_covariates/Final_control.dbf")
  Control$treated = 0
  Control$offset = "Cont"
  Control <- subset(Control, select = -c(4))        # Remove unwanted fire variable
  Control <- Control[,c(2,3,1,4:16)]                # Re-order columns to match offset dataframes

# Rename columns #
cols <- c("X","Y","Tree_loss", "Pop_density", "Dist_sett", "Slope", "Elevation", "Aspect", "Annual_Rain",
          "Dist_track", "Dist_road", "Dist_river", "Dist_edge", "Dist_defor", "treated", "offset")

names(Control) <- paste0(cols)
names(ANK) <- paste0(cols)
names(CZ) <- paste0(cols)
names(CFAM) <- paste0(cols)
names(TTF) <- paste0(cols)

# Merge each offset with the control dataset and create a column with row ID.
# These offset + control datasets will the input for matching #

ANKCONT <- rbind(ANK, Control)
ANKCONT$ID <- seq(nrow(ANKCONT))
CZCONT <- rbind(CZ, Control)
CZCONT$ID <- seq(nrow(CZCONT))
CFAMCONT <- rbind(CFAM, Control)
CFAMCONT$ID <- seq(nrow(CFAMCONT))
TTFCONT <- rbind(TTF, Control)
TTFCONT$ID <- seq(nrow(TTFCONT))

#----------------------------2) Robustness: addition of covariates -----------------------------------------#

# 1 - Load the functions in the separete script

# 2 -  We evaluate the function
the_cov_loop(ANKCONT,11)
write.csv(synthesis_loop_cov,"YOURPATH/loopAnk_cov.csv")

the_cov_loop(CFAMCONT,13)
write.csv(synthesis_loop_cov,"YOURPATH/loopCFAM_cov.csv")

the_cov_loop(CZCONT,9)
write.csv(synthesis_loop_cov,"YOURPATH/loopCZ_cov.csv")

the_cov_loop(TTFCONT,14)
write.csv(synthesis_loop_cov,"YOURPATH/loopTTF_cov.csv")

#----------------------------3) Robustness: different parameters -----------------------------------------#

memory.limit(100000)
the_parameters_loop(ANKCONT,11,
                    caliper_value = c(0.25,0.5,1),
                    replacement = c(T,F),
                    distance = c("mahalanobis","glm","randomforest"),
                    ratio=c(1,5,10))
 write.csv(loop_parameters,"YOURPATH/loopANK_parameters.csv")

the_parameters_loop(CFAMCONT,13,
                    caliper_value = c(0.25,0.5,1),
                    replacement = c(T,F),
                    distance = c("mahalanobis","glm","randomforest"),
                    ratio=c(1,5,10))
write.csv(loop_parameters,"YOURPATH/loopCFAM_parameters.csv")

the_parameters_loop(CZCONT,9,
                    caliper_value = c(0.25,0.5,1),
                    replacement = c(T,F),
                    distance = c("mahalanobis","glm","randomforest"),
                    ratio=c(1,5,10))
 write.csv(loop_parameters,"YOURPATH/loopCZ_parameters.csv")

the_parameters_loop(TTFCONT,14,
                    replacement = c(T,F),
                    distance = c("mahalanobis","glm","randomforest"),
                    caliper_value = c(0.25,0.5,1),
                    ratio=c(1,5,10))
write.csv(loop_parameters,"YOURPATH/loopTTF_parameters.csv")

#----------------------------4) Robustness: different parameters and different covariates -----------------------------------------#

the_cov_parameters_loop(ANKCONT,11,
                    caliper_value = c(0.25,0.5,1),
                    replacement = c(T,F),
                    distance = c("mahalanobis","glm","randomforest"),
                    ratio=c(1,5,10))
write.csv(synthesis_loop_cov_param,"YOURPATH/loopANK_cov_parameters.csv")

the_cov_parameters_loop(CFAMCONT,13,
                    caliper_value = c(0.25,0.5,1),
                    replacement = c(T,F),
                    distance = c("mahalanobis","glm","randomforest"),
                    ratio=c(1,5,10))
write.csv(synthesis_loop_cov_param,"YOURPATH/loopCFAM_cov_parameters.csv")

the_cov_parameters_loop(CZCONT,9,
                    caliper_value = c(0.25,0.5,1),
                    replacement = c(T,F),
                    distance = c("mahalanobis","glm","randomforest"),
                    ratio=c(1,5,10))
write.csv(synthesis_loop_cov_param,"YOURPATH/loopCZ_cov_parameters.csv")

the_cov_parameters_loop(TTFCONT,14,
                    replacement = c(T,F),
                    distance = c("mahalanobis","glm","randomforest"),
                    caliper_value = c(0.25,0.5,1),
                    ratio=c(1,5,10))
write.csv(synthesis_loop_cov_param,"YOURPATH/loopTTF_cov_parameters.csv")

#----------------------------5) Robustness: dropping years -----------------------------------------#
the_year_loop(ANKCONT,11)
did_res_ank <- did_res

the_year_loop(CZCONT,9)
did_res_cz <- did_res

the_year_loop(TTFCONT,14)
did_res_ttf <- did_res

#-------------------------- Graphs

labels <- list("Balance:" = c("<10% obs. unmatched",">90% obs. unmatched", "Mean bal. achieved", "Balanced for all cov."),
               "Parallel trend:" = c("Achieved"),
               "Additional covariates:" = c("Population density", "Dist. nearest settlement", "Annual rainfall", "Dist. nearest track", "Dist. nearest river"),
               "Model parameters:" = c("0.25SD caliper","0.5SD caliper", "1SD caliper", "With replacement"),
               "Distance:" = c("Mahalanobis", "Standard PSM", "Random forest PSM"),
               "Nb. nearest neighbors:" = c("1", "5", "10"))

## ANK
ANK_cov  <- read.csv("YOURPATH/loopANK_cov.csv")
ANK_param  <- read.csv("YOURPATH/loopANK_parameters.csv")
ANK_covparam  <- read.csv("YOURPATH/loopANK_cov_parameters.csv")
ANK <- rbind(ANK_cov[,-1],ANK_param[,-1],ANK_covparam[,-1])
ANK$less_10pc_unmatched  <- ifelse(ANK$unmatched<2862*0.1,T,F)
ANK$more_90pc_unmatched  <- ifelse(ANK$unmatched>2862*0.9,T,F)
ANK$bal__mean_achieved  <- ifelse(ANK$mean_std_diff<0.25,T,F)
ANK$bal_achieved_all_cov  <- ifelse(ANK$max_std_diff<0.25,T,F)
ANK  <- ANK[,-c(3:5)]
ANK  <- ANK[,c(1,2,19:22,3:18)]

rows_invalid_models = which(
                         ANK$more_90pc_unmatched==T |
                         ANK$bal__mean_achieved==F |
                         ANK$parralel_trend==F)

row_main_model = which(ANK$cal1==T & ANK$replacement==F & ANK$maha==T & ANK$ratio1==T & ANK$Pop_density==F & ANK$Dist_sett==F & ANK$Annual_Rain==F &ANK$Dist_track==F & ANK$Dist_river==F)

tiff(file="YOURPATH/ANK_rob4.tiff",
     height = 550, width = 950, pointsize=0.3)

schart(ANK, labels,
       order = "increasing",
       highlight = rows_invalid_models,
       highlight2 = row_main_model,
       col.est = c("#E69F00","#fcd67e","black"),
       bg.dot=c("grey60","grey95","grey95","grey60"),
       ylab = "Raw treatment effect",
       fonts=c(2,3))
#text(x=row_main_model,y=-1.5,"*",pos=3,cex=1.5)

dev.off()

## CFAM
CFAM_cov  <- read.csv("YOURPATH/loopCFAM_cov.csv")
CFAM_param  <- read.csv("YOURPATH/loopCFAM_parameters.csv")
CFAM_covparam  <- read.csv("YOURPATH/loopCFAM_cov_parameters.csv")
CFAM <- rbind(CFAM_cov[,-c(1)],CFAM_param[,-c(1)],CFAM_covparam[,-c(1)])
CFAM$less_10pc_unmatched  <- ifelse(CFAM$unmatched<2626*0.1,T,F)
CFAM$more_90pc_unmatched  <- ifelse(CFAM$unmatched>2626*0.9,T,F)
CFAM$bal__mean_achieved  <- ifelse(CFAM$mean_std_diff<0.25,T,F)
CFAM$bal_achieved_all_cov  <- ifelse(CFAM$max_std_diff<0.25,T,F)
CFAM  <- CFAM[,-c(3:5)]
CFAM  <- CFAM[,c(1,2,19:22,3:18)]

rows_invalid_models = which(
                            CFAM$more_90pc_unmatched==T |
                            CFAM$bal__mean_achieved==F |
                            CFAM$parralel_trend==F)

row_main_model = which(CFAM$cal1==T & CFAM$replacement==F & CFAM$maha==T & CFAM$ratio1==T & CFAM$Pop_density==F & CFAM$Dist_sett==F & CFAM$Annual_Rain==F &CFAM$Dist_track==F & CFAM$Dist_river==F)

tiff(file="YOURPATH/CFAM_rob4.tiff",
     height = 600, width = 950, pointsize=0.3)

schart(CFAM, labels,
       order = "increasing",
       highlight = rows_invalid_models,
       highlight2 = row_main_model,
       col.est = c("chartreuse3","#b7ff6e","black"),
       bg.dot=c("grey60","grey95","grey95","grey60"),
       ylab = "Raw treatment effect",
       fonts=c(2,3))
dev.off()

## CZ
CZ_cov  <- read.csv("YOURPATH/loopCZ_cov.csv")
CZ_param  <- read.csv("YOURPATH/loopCZ_parameters.csv")
CZ_covparam  <- read.csv("YOURPATH/loopCZ_cov_parameters.csv")
  CZ <- rbind(CZ_cov[,-c(1)],CZ_param[,-c(1)],CZ_covparam[,-c(1)])
  CZ$less_10pc_unmatched  <- ifelse(CZ$unmatched<1340*0.1,T,F)
  CZ$more_90pc_unmatched  <- ifelse(CZ$unmatched>1340*0.9,T,F)
  CZ$bal__mean_achieved  <- ifelse(CZ$mean_std_diff<0.25,T,F)
  CZ$bal_achieved_all_cov  <- ifelse(CZ$max_std_diff<0.25,T,F)
  CZ  <- CZ[,-c(3:5)]
  CZ  <- CZ[,c(1,2,19:22,3:18)]

  rows_invalid_models = which(
                              CZ$more_90pc_unmatched==T |
                              CZ$bal__mean_achieved==F |
                              CZ$parralel_trend==F)

  row_main_model = which(CZ$cal1==T & CZ$replacement==F & CZ$maha==T & CZ$ratio1==T & CZ$Pop_density==F & CZ$Dist_sett==F & CZ$Annual_Rain==F &CZ$Dist_track==F & CZ$Dist_river==F)

tiff(file="YOURPATH/CZ_rob4.tiff",
     height = 550, width = 950, pointsize=0.3)

schart(CZ, labels,
       order = "increasing",
       highlight = rows_invalid_models,
       highlight2 = row_main_model,
       col.est = c("#F0E442","#fffab3","black"),
       bg.dot=c("grey60","grey95","grey95","grey60"),
       ylab = "Raw treatment effect",
       fonts=c(2,3))
dev.off()

## TTF
TTF_cov  <- read.csv("YOURPATH/loopTTF_cov.csv")
TTF_param  <- read.csv("YOURPATH/loopTTF_parameters.csv")
TTF_covparam  <- read.csv("YOURPATH/loopTTF_cov_parameters.csv")
TTF <- rbind(TTF_cov[,-c(1)],TTF_param[,-c(1)],TTF_covparam[,-c(1)])
TTF$less_10pc_unmatched  <- ifelse(TTF$unmatched<1170*0.1,T,F)
TTF$more_90pc_unmatched  <- ifelse(TTF$unmatched>1170*0.9,T,F)
TTF$bal__mean_achieved  <- ifelse(TTF$mean_std_diff<0.25,T,F)
TTF$bal_achieved_all_cov  <- ifelse(TTF$max_std_diff<0.25,T,F)
TTF  <- TTF[,-c(3:5)]
TTF  <- TTF[,c(1,2,19:22,3:18)]

rows_invalid_models = which(
                          TTF$more_90pc_unmatched==T |
                          TTF$bal__mean_achieved==F  |
                          TTF$parralel_trend==F)

row_main_model = which(TTF$cal1==T & TTF$replacement==F & TTF$maha==T & TTF$ratio1==T & TTF$Pop_density==F & TTF$Dist_sett==F & TTF$Annual_Rain==F &TTF$Dist_track==F & TTF$Dist_river==F)

tiff(file="YOURPATH/TTF_rob4.tiff",
     height = 600, width = 950, pointsize=0.3)

schart(TTF, labels,
       order = "increasing",
       highlight = rows_invalid_models,
       highlight2 = row_main_model,
       col.est = c("#56B4E9","#bfe8ff","black"),
       bg.dot=c("grey60","grey95","grey95","grey60"),
       ylab = "Raw treatment effect",
       fonts=c(2,3))
dev.off()

# --------- Graphs for years

### Ank
plot <- ggplot(did_res_ank, aes(x=Year, y=coef)) +
  geom_errorbar(aes(ymin = coef + 1.96*se, ymax = coef - 1.96*se, col=Drop)) +
  scale_color_manual(values=c("#E69F00","#fcd67e")) +
  geom_point() +
  labs(title = "Ankerana", x = "Year dropped", y = "Coefficient") +
  ylim(-4.5,0) +
  geom_hline(yintercept = 0, linetype=2) +
  guides(color=F) +
  #scale_x_continuous(breaks = 2000:2019) +
  theme_classic()
plot

ggsave(plot,
       filename = "ANK_years.png")

### CZ
plot <- ggplot(did_res_cz, aes(x=Year, y=coef)) +
  geom_errorbar(aes(ymin = coef + 1.96*se, ymax = coef - 1.96*se, col=Drop)) +
  scale_color_manual(values=c("#F0E442","#fffab3")) +
  geom_point() +
  labs(title = "Conservation Zone", x = "Year dropped", y = "Coefficient") +
  ylim(-2.5,0) +
  geom_hline(yintercept = 0, linetype=2) +
  guides(color=F) +
  #scale_x_continuous(breaks = 2000:2019) +
  theme_classic()

ggsave(plot,
       filename = "CZ_years.png")

### TTF
plot <- ggplot(did_res_ttf, aes(x=Year, y=coef)) +
  geom_errorbar(aes(ymin = coef + 1.96*se, ymax = coef - 1.96*se, col=Drop)) +
  scale_color_manual(values=c("#56B4E9","#bfe8ff")) +
  geom_point() +
  labs(title = "Torotorofotsy", x = "Year dropped", y = "Coefficient") +
  geom_hline(yintercept = 0, linetype=2) +
  guides(color=F) +
  #scale_x_continuous(breaks = 2000:2019) +
  theme_classic()

ggsave(plot,
       filename = "TTF_years.png")


## ============================================================================================
##
## analyseData
##
## ============================================================================================

analyseData <- function(path, startStopTimes, n, caseStr, data, followUpTime,
                        data0=c(), followUpTime0=c(), weights=c(), weights0=c()) {

  print(paste(path, n))
  set.seed(100)

  funcList <- computeFuncList(caseStr)
  commonNullDist <- funcList$commonNullDist
  sampleData <- funcList$sampleData
  computeSortedStat <- funcList$computeSortedStat
  computeNofExtreme <- funcList$computeNofExtreme
  xlab <- funcList$xlab
  ylab <- funcList$ylab

  nofPairsVec <- c()
  nullDistList <- list()
  nullDist <- c()
  nofPeriods <- length(startStopTimes)-n+1

  nofPairs0vec <- rep(0, nofPeriods)
  nofPairs1vec <- rep(0, nofPeriods)
  pVals <- matrix(NA, nrow=nofPeriods, ncol=nrow(data))
  for (p in 1:nofPeriods) {
    print(paste("  ", p, "of", nofPeriods))
    curData <- data[, followUpTime>=startStopTimes[p] &
                    followUpTime<=startStopTimes[p+n-1]]
    curWeights <- c()
    if (length(weights)>0)
      curWeights <- weights[, followUpTime>=startStopTimes[p] &
                            followUpTime<=startStopTimes[p+n-1]]
    nofPairs <- nofPairs1vec[p] <- ncol(curData)
    nofPairs0 <- 0
    compStat <- TRUE
    if (caseStr=="Weight") {
      if ((sum(followUpTime0>=startStopTimes[p] &
               followUpTime0<=startStopTimes[p+n-1])<3) | nofPairs<3) {
        compStat <- FALSE
        nofPairs0vec[p] <- sum(followUpTime0>=startStopTimes[p] &
                               followUpTime0<=startStopTimes[p+n-1])
      } else {
        curData <- cbind(curData, data0[, followUpTime0>=startStopTimes[p] &
                                        followUpTime0<=startStopTimes[p+n-1]])
        if (length(weights)>0)
          curWeights <- cbind(curWeights, weights0[, followUpTime0>=startStopTimes[p] &
                                                   followUpTime0<=startStopTimes[p+n-1]])
        nofPairs0 <- nofPairs0vec[p] <- ncol(curData)-nofPairs
      }
    }

    if (!compStat) {
      pVals[p, ] <- 1
    } else {
      expSd <- computeSortedStat(curData, nofPairs, nofPairs0, curWeights)
      if (!commonNullDist || length(nofPairsVec)==0 || !(nofPairsVec %in% nofPairs)) {
        ## Compute null distribution
        runif(1)
        mc.reset.stream()
        workerFunc <- function(s) {
          curDlist <- sampleData(data, curData, nofPairs,  weights, curWeights)
          curD <- curDlist$data
          curW <- curDlist$weights
          res <- computeSortedStat(curD, nofPairs, nofPairs0, curW)
          rm(curDlist, curD, curW)
          res
        }

        res <- mclapply(values, workerFunc, mc.cores = numWorkers)
        nullDist <- matrix(NA,  nrow=nSim, ncol=nrow(curData))
        for (s in 1:nSim)
          nullDist[s, ] <- res[[s]]

        if (commonNullDist) {
          nofPairsVec <- c(nofPairsVec, nofPairs)
          nullDistList[[length(nofPairsVec)]] <- nullDist
        }
      } else { ## commonNullDist && (nofPairs %in% nofPairsVec)
        nullDist <- nullDistList[[which(nofPairsVec %in% nofPairs)]]
      }

      nofExtreme <-  computeNofExtreme(expSd, nullDist)
      pVals[p, ] <- nofExtreme/nSim
    }
  }

  write.table(pVals, paste(path, "pVals", n, ".txt", sep=""), col.names=F, row.names=F, quote=F)

  pdf(paste(path, "plotPvals", n, ".pdf", sep=""))
  for (p in 1:nofPeriods) {
    main <- ""
    if (caseStr=="Weight")
      main <- paste("Nof with spread:", nofPairs1vec[p], "   Nof without spread:", nofPairs0vec[p])
    plot(pVals[p,], type="l", ylim=c(0,1), log="x", main=main)
    abline(h=0.05, col=2)
  }
  dev.off()

  pdf(paste(path, "pVals", n, "AllGenes.pdf", sep=""))
  ind <- 1:ncol(pVals)
  mm <- 4000
  nn <- 100
  xVals <- 6:(length(pVals[1,ind])-5)
  plot(xVals, runmed(pVals[1,ind],11)[xVals], type="l", ylim=c(0,1), ylab="p-value",
       xlab=xlab)
  for (p in 1:nofPeriods)
    lines(xVals, runmed(pVals[p,ind],11)[xVals])
  for (p in (nofPeriods-5):nofPeriods) {
    pV <- runmed(pVals[p,ind],11)[xVals]
    lines(pV,col=2)
    number <- nofPeriods-p+1
    points(xVals[mm+nn*number], pV[mm+nn*number], pch=paste(number))
  }
  for (p in 1:6) {
    pV <- runmed(pVals[p,ind],11)[xVals]
    lines(pV,col=4)
    number <- p
    points(xVals[mm+nn*number], pV[mm+nn*number], pch=paste(number))
  }
  abline(h=0.05, col=3)
  dev.off()

  pdf(paste(path, "pVals", n, "2000Genes.pdf", sep=""))
  ind <- 1:2000
  mm <- 300
  nn <- 30
  xVals <- 6:(length(pVals[1,ind])-5)
  plot(xVals, runmed(pVals[1,ind],11)[xVals], type="l", ylim=c(0,1), ylab="p-value",
       xlab=xlab)
  for (p in 1:nofPeriods)
    lines(xVals, runmed(pVals[p,ind],11)[xVals])
  for (p in (nofPeriods-5):nofPeriods) {
    pV <- runmed(pVals[p,ind],11)[xVals]
    lines(pV,col=2)
    number <- nofPeriods-p+1
    points(xVals[mm+nn*number], pV[mm+nn*number], pch=paste(number))
  }
  for (p in 1:6) {
    pV <- runmed(pVals[p,ind],11)[xVals]
    lines(pV,col=4)
    number <- p
    points(xVals[mm+nn*number], pV[mm+nn*number], pch=paste(number))
  }
  abline(h=0.05, col=3)
  dev.off()

  ## Make plots of p-values over time

  ## smooth pVals - median-filter over genes - window l
  pValsSmooth <- pVals
  for (p in 1:nofPeriods)
    pValsSmooth[p,] <- runmed(pVals[p,],99)

  if (length(followUpTime0)>length(followUpTime)) {
    meanTimeForPeriod <- rep(NA, nofPeriods)
    for (p in 1:nofPeriods)
      meanTimeForPeriod[p] <- (followUpTime0[p+n-1]+followUpTime0[p])/2
  } else {
    meanTimeForPeriod <- rep(NA, nofPeriods)
    for (p in 1:nofPeriods)
      meanTimeForPeriod[p] <- (followUpTime[p+n-1]+followUpTime[p])/2
  }

  days <- min(dataList$followUpTime):max(dataList$followUpTime)
  periodForDay <- rep(NA, length(days))
  periodForDay[days < mean(meanTimeForPeriod[1:2])] <- 1
  periodForDay[days > mean(meanTimeForPeriod[(length(meanTimeForPeriod)-1):
                                             (length(meanTimeForPeriod))])] <- nofPeriods
  for (p in 2:(nofPeriods-1))
    periodForDay[days >= mean(meanTimeForPeriod[(p-1):p]) &
                 days <= mean(meanTimeForPeriod[(p):(p+1)])] <- p

  library(caTools)

  for (winLen in c(1, 30, 90, 365)) {
    pdf(paste(path, "pValsTime", caseStr, winLen, ".pdf", sep=""), height=6, width=7)

    pValVec <- (pValsSmooth[,50])[periodForDay]
    pValVec <- caTools::runmean(pValVec, winLen)
    plot(days, pValVec, type="l", xlim=rev(range(dataList$followUpTime)), ylim =c(0,1),
         ylab="p-value", xlab="Follow up time (days)", cex=1.0, cex.axis=1.0, cex.lab=1.0)
    text(days[1], pValVec[1], labels=paste(50), cex=0.6)
    col <- 1
    for (r in c(200, 500, 1000, 2000)) {
      col <- col+1
      pValVec <- (pValsSmooth[,r])[periodForDay]
      pValVec <- caTools::runmean(pValVec, winLen)
      lines(days, pValVec, col=col)
      text(days[1], pValVec[1], labels=paste(r), col=col, cex=0.6)
    }
    for (y in 0:7)
      abline(v=y*365)
    abline(h=0.05, lty=2)

    dev.off()
  }
}