
### following RWeka packages can be downloaded in site: http://sourceforge.net/projects/weka/files/weka-packages/
RWeka::WPM("install-package", "./packages/linearForwardSelection1.0.1.zip")
RWeka::WPM("install-package", "./packages/ridor1.0.1.zip")
RWeka::WPM("install-package", "./packages/EMImputation1.0.1.zip")
RWeka::WPM("install-package", "./packages/citationKNN1.0.1.zip")
RWeka::WPM("install-package", "./packages/isotonicRegression1.0.1.zip")
RWeka::WPM("install-package", "./packages/paceRegression1.0.1.zip")
RWeka::WPM("install-package", "./packages/leastMedSquared1.0.1.zip")
RWeka::WPM("install-package", "./packages/RBFNetwork1.0.8.zip")
RWeka::WPM("install-package", "./packages/conjunctiveRule1.0.4.zip")
RWeka::WPM("install-package", "./packages/rotationForest1.0.2.zip")

coreExperiment <- function(fit, est, sampling=TRUE, seed=0) {
    ###### evaluation criterias ######
    Popt <- ACC <- NULL
    
	# Remove the commit date
	fit$commitdate <- est$commitdate <- NULL

    fit.old <- fit
    est.old <- est

	### sampling
    if (sampling) {
        fit <- doSampling(fit, "bug", seed=seed)
    }

	### calc churn
    churn.fit.old <- decChurn(fit.old); churn.fit <- decChurn(fit)
    churn.est.old <- decChurn(est.old); churn.est <- decChurn(est)

    fbug.old <- fit.old$bug; fbug <- fit$bug
    ebug.old <- est.old$bug; ebug <- est$bug

    # log transformation for each measure except fix
    idx <- charmatch(c("la","ld","lt","exp","rexp","sexp","ndev","pd","npt","entropy"), colnames(fit))
    fit[,idx] <- fit[,idx] + 1
    idx <- charmatch(c("fix","bug"), colnames(fit))
    fit[,-c(idx)] <- apply(fit[,-c(idx)], 2, log)

    ###### remove the variable that has high correlation to other variables
    idx <- charmatch(c("nm","rexp"), colnames(fit))
    fit <- fit[,-c(idx)]

    ###### remove la and ld from the prediction model
    idx <- charmatch(c("la","ld"), colnames(fit))
    fit <- fit[,-c(idx)]

    ### remove those variables with 0 variance
    va <- apply(fit, 2, var)
    fit <- fit[,((!is.na(va))&(va!=0))] ### fit <- fit[,!(va==0)]

    err <- try(vifstep.names <- as.character(usdm::vifstep(fit[, setdiff(colnames(fit), "bug")], th=10)@results$Variables), silent=TRUE)
    if (class(err)!="try-error") {
        fit <- fit[, c(vifstep.names, "bug")]            
    }

    ### VIF analysis
    idx <- charmatch(c("bug"), colnames(fit))
    x <- fit[,-c(idx)]
    err <- try(x <- remVarsByVIF(x), silent=TRUE)
    if (class(err)!="try-error") {
        fit <- cbind(x, fit["bug"])
    }

    ### log transformation for est
    idx <- charmatch(c("la","ld","lt","exp","rexp","sexp","ndev","pd","npt","entropy"), colnames(est))
    est[,idx] <- est[,idx] + 1
    idx <- charmatch(c("fix","bug"), colnames(est))
    est[,-c(idx)] <- apply(est[,-c(idx)], 2, log)

    ### evaluate the prediction performance when considering effort (effort=churn)
    fit$bugdensity <- fit$bug/(churn.fit+1)
    est$bugdensity <- est$bug/(churn.est+1)

    fit.old$bugdensity <- fit.old$bug/(churn.fit.old+1)
    est.old$bugdensity <- est.old$bug/(churn.est.old+1)

    ### obtain original values for each variable
    est.old$lt  <- est.old$lt  * est.old$nf
    est.old$la  <- est.old$la  * est.old$lt
    est.old$ld  <- est.old$ld  * est.old$lt
    est.old$nuc <- est.old$npt * est.old$nf

    fit.old$lt  <- fit.old$lt  * fit.old$nf
    fit.old$la  <- fit.old$la  * fit.old$lt
    fit.old$ld  <- fit.old$ld  * fit.old$lt
    fit.old$nuc <- fit.old$npt * fit.old$nf

    getWekaClassifier <- function(name) {
        WC <- NULL

        if (name %in% c("LinearRegression", "Logistic", "SMO", "IBk", "LBR", "AdaBoostM1", "Bagging", "LogitBoost", "MultiBoostAB", "Stacking", "CostSensitiveClassifier", "JRip", "M5Rules", "OneR", "PART", "J48", "LMT", "M5P", "DecisionStump", "SimpleKMeans")) {
            WC <- get(name, asNamespace("RWeka"))
        } else {
            if (name=="NaiveBayes") {
                WC <- RWeka::make_Weka_classifier("weka/classifiers/bayes/NaiveBayes")
            } else if (name %in% c("GaussianProcesses", "SimpleLogistic", "SimpleLinearRegression", "IsotonicRegression", "LeastMedSq", "MultilayerPerceptron", "PaceRegression", "PLSClassifier", "RBFNetwork", "SMOreg")) {
                WC <- RWeka::make_Weka_classifier(paste("weka/classifiers/functions/", name, sep=""))
            } else if (name %in% c("KStar", "LWL")) {
                WC <- RWeka::make_Weka_classifier(paste("weka/classifiers/lazy/", name, sep=""))
            } else if (name %in% c("Bagging", "AdaBoostM1", "RotationForest", "RandomSubSpace", "AdditiveRegression", "AttributeSelectedClassifier", "CVParameterSelection", "Grading", "GridSearch", "MultiScheme", "RegressionByDiscretization", "StackingC", "Vote")) {
                WC <- RWeka::make_Weka_classifier(paste("weka/classifiers/meta/", name, sep=""))
            } else if (name %in% c("ConjunctiveRule", "DecisionTable", "ZeroR", "Ridor")) {
                WC <- RWeka::make_Weka_classifier(paste("weka/classifiers/rules/", name, sep=""))
            } else if (name %in% c("REPTree", "UserClassifier", "RandomForest")) {
                WC <- RWeka::make_Weka_classifier(paste("weka/classifiers/trees/", name, sep=""))
            }
        }
        return(WC)
    }

    subFunc <- function(data.train, data.valid, method=NULL, meta=NULL, base=NULL, yname.numeric=NULL, yname.nominal=NULL, xnames=NULL, xname=NULL) {
        if (is.null(method)) {
            if (!is.null(meta)) { method <- paste(meta, base, sep="+") } else { method <- base }
        } else {
            base <- method
        }

        pred.train <- pred.valid <- NULL

        if (grepl("UP", method)) {
            pred.train <- 10000/(data.train[, xname]+1)
            pred.valid <- 10000/(data.valid[, xname]+1)
        } else if (method=="EALR") {
            formula <- as.formula(paste(yname.numeric, paste(xnames, collapse="+"), sep="~"))
            model <- glm(formula=formula, data=data.train, family=gaussian)
            try(model <- step(model, k=log(nrow(data.train)), trace=FALSE), silent=TRUE)

            if (length(attr(model$terms, "term.labels"))>=2) {
                err <- try(model.vif <- max(car::vif(model)), silent=TRUE)
                if (class(err)!="try-error") {
                    if (!is.na(model.vif)) {
                        if (model.vif > 10) { cat("VIF of EALR model is larger than 10.\n") }
                    }
                }
            }

            pred.train <- predict(model, new=data.train)
            pred.valid <- predict(model, new=data.valid)

            step.xnames <- attr(model$terms, "term.labels")
            for (aname in step.xnames) {
                data.train[, aname] <- (data.train[, aname]-min(data.train[, aname]))/(max(data.train[, aname])-min(data.train[, aname]))
                data.valid[, aname] <- (data.valid[, aname]-min(data.valid[, aname]))/(max(data.valid[, aname])-min(data.valid[, aname]))
            }
        } else if (!is.null(meta)) {
            data.train[, yname.nominal] <- as.factor(data.train[, yname.nominal])
            formula <- as.formula(paste(yname.nominal, paste(xnames, collapse="+"), sep="~"))
            ########################################
            ### Ensemble methods
            ########################################
            WC <- getWekaClassifier(meta)
            BC <- getWekaClassifier(base)
            model <- WC(formula=formula, data=data.train, control=RWeka::Weka_control(W=BC))
            
            if (is.null(yname.numeric)) {
                pred.train <- predict(model, new=data.train, type="probability")[, "1"]
                pred.valid <- predict(model, new=data.valid, type="probability")[, "1"]
            } else {
                pred.train <- predict(model, new=data.train)
                pred.valid <- predict(model, new=data.valid)
            }
        } else {
            data.train[, yname.nominal] <- as.factor(data.train[, yname.nominal])
            formula <- as.formula(paste(yname.nominal, paste(xnames, collapse="+"), sep="~"))

            WC <- getWekaClassifier(base)
            model <- NULL
            if (method=="IBk") {
                model <- WC(formula=formula, data=data.train, control=RWeka::Weka_control(K=8))
            } else {
                model <- WC(formula=formula, data=data.train)
            }

            if (is.null(yname.numeric)) {
                pred.train <- predict(model, new=data.train, type="probability")[, "1"]
                pred.valid <- predict(model, new=data.valid, type="probability")[, "1"]
            } else {
                pred.train <- predict(model, new=data.train)
                pred.valid <- predict(model, new=data.valid)
            }
        }

        pred.train <- as.vector(pred.train)
        pred.valid <- as.vector(pred.valid)
        train.dt <- valid.dt <- NULL
        if (grepl("UP", method)) {
            train.dt <- data.frame(NUM=fbug.old, REL=fbug.old, LOC=churn.fit.old, PRE=pred.train)
            valid.dt <- data.frame(NUM=ebug.old, REL=ebug.old, LOC=churn.est.old, PRE=pred.valid)
        } else {
            train.dt <- data.frame(NUM=fbug, REL=fbug, LOC=churn.fit, PRE=pred.train)
            valid.dt <- data.frame(NUM=ebug, REL=ebug, LOC=churn.est, PRE=pred.valid)
        }

        sorted           <- FALSE
        worstcase        <- TRUE  ### compute the worst performance for unsupervised models
        bestcase         <- FALSE
        LOCUP            <- FALSE
        allpercentcutoff <- TRUE
        sub.Popt <- sub.ACC <- NULL
        if (grepl("UP", method)) {
            sub.Popt <- ComputePopt(sorted=sorted, data=valid.dt, worstcase=worstcase, bestcase=bestcase, LOCUP=LOCUP)
            sub.ACC <- ComputeACC(sorted=sorted, data=valid.dt, worstcase=worstcase, bestcase=bestcase, LOCUP=LOCUP)
        } else {
            sub.Popt <- ComputePopt(sorted=sorted, data=valid.dt)
            sub.ACC <- ComputeACC(sorted=sorted, data=valid.dt)
        }

        names(sub.Popt) <- paste(method, "Popt", sep=".")
        Popt <<- c(Popt, sub.Popt)
        names(sub.ACC) <- paste(method, "ACC", sep=".")
        ACC <<- c(ACC, sub.ACC)
    }

    yname.numeric <- "bugdensity"; yname.nominal <- "bug"
    xnames <- setdiff(colnames(fit), c("bug", "bugdensity"))

    subFunc(method="EALR", data.train=fit, data.valid=est, yname.numeric=yname.numeric, xnames=xnames)

    for (method in c("NaiveBayes", "SimpleLogistic", "LMT", "RBFNetwork", "JRip", "Logistic", "RandomForest", "SMO", "J48", "Ridor", "IBk")) { ### 
        subFunc(data.train=fit, data.valid=est, method=method, yname.numeric=NULL, yname.nominal=yname.nominal, xnames=xnames)
    }

    for (meta in c("Bagging", "RotationForest", "AdaBoostM1", "RandomSubSpace")) { ### ensemble methods
        bases <- c("SimpleLogistic", "LMT", "NaiveBayes", "SMO", "J48")
        for (base in bases) {
            subFunc(data.train=fit, method=NULL, meta=meta, base=base, data.valid=est, yname.numeric=NULL, yname.nominal=yname.nominal, xnames)
        }
    }

    cnames <- c("ns", "nm", "nf", "entropy", "lt", "fix", "ndev", "pd",  "nuc", "exp", "rexp", "sexp")
    labels <- c("NS", "ND", "NF", "Entropy", "LT", "FIX", "NDEV", "AGE", "NUC", "EXP", "REXP", "SEXP")

    for (i in seq(cnames)) {
        xname <- cnames[i]; label <- labels[i]
        methods <- paste(label, "UP", sep=".")

        for (method in methods) {
            subFunc(method=method, data.train=fit.old, data.valid=est.old, xname=xname)
        }
    }

    #######################################################################
    ### -> Output
    return(list(Popt=Popt, ACC=ACC))
}

### 10 times 10-fold cross-validation
exeExperiment.crossvalidation <- function(project, sampling=TRUE, totalFolds=10, totalRuns=1) {
    Popt <- ACC <- NULL

    all.name <- paste(project, ".csv", sep="")
    file <- file.path("..", "input", all.name, fsep=.Platform$file.sep)
    if (!file.exists(file)) { return(NULL) }
    all.data <- read.csv(file=file, header=TRUE, row.names=1)

    cat("(BEG)Cross-validation", "for", project, "\n")

    theList <- NULL
    index <- 1
    for (run in seq(totalRuns)) {
        sub <- divideToKsubsets(data=all.data, k=totalFolds, seed=run)

        for (fold in seq(totalFolds)) {
            fit.name <- paste(project, "_fit_", fold, sep="")
            est.name <- paste(project, "_est_", fold, sep="")

            fit <- est <- NULL
            for (j in seq(totalFolds)) {
                if (j != fold) {
                    fit <- rbind(fit, sub[[j]])
                }
            }
            est <- sub[[fold]]

            tmp.res <- coreExperiment(fit=fit, est=est, sampling=sampling, seed=fold)
            theList[[index]] <- tmp.res
            index <- index + 1
        }
    }

    cat("(END)Cross-validation", "for", project, "\n")

    Popt.lst <- sapply(theList, '[', "Popt")
    ACC.lst <- sapply(theList, '[', "ACC")
    
    for (i in seq(totalRuns*totalFolds)) {
        Popt <- rbind(Popt, Popt.lst[[i]])
        ACC <- rbind(ACC, ACC.lst[[i]])
    }

    return(list(Popt=Popt, ACC=ACC))
}

### timewise cross-validation
exeExperiment.crossvalidation.timewise <- function(project, gap=2, sampling=TRUE) {
    Popt <- ACC <- NULL

    fname <- paste(project, ".csv", sep="")
    file <- file.path("..", "input", fname, fsep=.Platform$file.sep)
    if (!file.exists(file)) { return(NULL) }
    data <- read.csv(file=file, header=TRUE, row.names=1, as.is=TRUE)

    cat("(BEG)Timewise cross-validation for", project, "\n")

    data$commitTime <- strptime(data$commitdate, format="%Y/%m/%d %H:%M") #### data$timePOSIX  <- as.POSIXct(data$commitdate, format="%Y/%m/%d %H:%M") ### 格式化时间
    data$commitTime <- strftime(data$commitTime, format="%Y/%m")
    data <- data[order(data$commitTime), ] ### 对change按提交时间进行排序

    unimon <- unique(data$commitTime)
    unimon <- unimon[order(unimon)]

    totalFolds <- length(unimon)

    sub <- NULL ### dive data into totalFolds parts, each part corresponding to changes within one month
    for (fold in seq(totalFolds)) {
        sub[[fold]] <- data[which(data$commitTime==unimon[fold]), ]
    }

    cat("\n", project, "has", totalFolds, "folds, length of each fold:\n", unlist(lapply(sub, nrow)), "\n")

    theList <- NULL
    train.valid <- NULL
    list.index <- 1
    for (fold in seq(totalFolds)) {
        if (fold+5 > totalFolds) { next }
        fit <- rbind(sub[[fold]], sub[[fold+1]])
        est <- rbind(sub[[fold+2+gap]], sub[[fold+3+gap]])

        fit$commitTime <- est$commitTime <- NULL
        theList[[list.index]] <- coreExperiment(fit=fit, est=est, sampling=sampling, seed=fold)
        list.index <- list.index + 1
        train.valid <- rbind(train.valid, c(fold, fold+2+gap))
    }

    Popt.lst <- sapply(theList, '[', "Popt")
    ACC.lst <- sapply(theList, '[', "ACC")
    
    for (i in seq(length(Popt.lst))) {
        Popt <- rbind(Popt, Popt.lst[[i]])
        ACC <- rbind(ACC, ACC.lst[[i]])
    }

    colnames(train.valid) <- c("trainfold", "validfold")
    train.valid <- data.frame(train.valid)

    train.valid$trainmonth <- unimon[train.valid$trainfold]
    train.valid$validmonth <- unimon[train.valid$validfold]

    Popt <- cbind(train.valid, Popt)
    ACC <- cbind(train.valid, ACC)

    cat("(END)Timewise cross-validation for", project, "\n")

    return(list(Popt=Popt, ACC=ACC))
}

### cross project validation
exeExperiment.crossproject <- function(project.fit, project.est, sampling=TRUE) {
    Popt <- ACC <- NULL

    cat("(BEG)Across-project", project.fit, ":", project.est, "\n")

    fit.name <- paste(project.fit,".csv",sep="")
    fit.data <- read.csv(file.path("..", "input", fit.name, fsep=.Platform$file.sep), header=TRUE, row.names=1)

    est.name <- paste(project.est,".csv",sep="")
    est.data <- read.csv(file.path("..", "input", est.name, fsep=.Platform$file.sep), header=TRUE, row.names=1)

    tmp.res <- NULL
    tmp.res <- coreExperiment(fit=fit.data, est=est.data, sampling=sampling, seed=0)
    
    cat("(END)Across-project", project.fit, ":", project.est, "\n")

    Popt <- rbind(Popt, tmp.res$Popt)
    ACC <- rbind(ACC, tmp.res$ACC)

    return(list(Popt=Popt, ACC=ACC))
}

printResult <- function(tmp, path, name) {
    out.fname <- paste(path, "out_", name, ".txt", sep="")
    dput(tmp, file=out.fname)

    out.fname <- paste(path, "out_", name, "_Popt.txt", sep="")
    dput(tmp$Popt, file=out.fname)

    out.fname <- paste(path, "out_", name, "_ACC.txt", sep="")
    dput(tmp$ACC, file=out.fname)
}

########################################
### output cross validation results
########################################
subFunc.cv <- function(project, sampling=TRUE) {
    path <- "../output/cross-validation/"
    if (!file.exists(file.path(path))) { dir.create(path) }
    file <- paste("../input/", project, ".csv", sep="")
    if (!file.exists(file)) { return(NULL) }
    file <- paste(path, "out_", project, "_ce.txt", sep="")
    if (file.exists(file)) { return(NULL) }
    tmp <- exeExperiment.crossvalidation(project=project, sampling=sampling)
    printResult(tmp, path, project)
}

########################################
### output timewise cross validation results
########################################
subFunc.tw <- function(project, sampling=TRUE) {
    path <- "../output/cross-validation-timewise/"
    if (!file.exists(file.path(path))) { dir.create(path) }
    file <- paste("../input/", project, ".csv", sep="")
    if (!file.exists(file)) { return(NULL) }
    file <- paste(path, "out_", project, "_ce.txt", sep="")
    if (file.exists(file)) { return(NULL) }
    tmp <- exeExperiment.crossvalidation.timewise(project=project, sampling=sampling)
    printResult(tmp, path, project)
}

########################################
### output cross-project performance
########################################
subFunc.cp <- function(arg, sampling=TRUE) {
    path <- "../output/cross-project/"
    if (!file.exists(file.path(path))) { dir.create(path) }
    file1 <- paste("../input/", arg[1], ".csv", sep="")
    file2 <- paste("../input/", arg[2], ".csv", sep="")
    if (!(file.exists(file1))&&(file.exists(file2))) { return(NULL) }
    file <- paste(path, "out_", arg[1], "_cross_", arg[2], "_ce.txt", sep="")
    if (file.exists(file)) { return(NULL) }
    tmp <- exeExperiment.crossproject(project.fit=arg[1], project.est=arg[2], sampling=sampling)
    printResult(tmp, path, paste(arg[1], "_cross_", arg[2], sep=""))
}

source("utils.R")

projects <- c("bugzilla", "columba", "jdt", "platform", "mozilla", "postgres")

#### cross-validation and time-wise-cross-validation
for (project in projects) {
    subFunc.cv(project)
    subFunc.tw(project)   
}

#### across-project prediction
args <- NULL; index <- 1
for (i in seq(projects)) {
    for (j in seq(projects)) {
        if (i==j) { next }
        args[[index]] <- c(projects[i], projects[j])
        index <- index + 1
    }
}

for (arg in args) {
    subFunc.cp(arg)
}