Untitled

drawparti <- function(grouping, x, y, method = "lda", prec = 100, 
    xlab=NULL, ylab=NULL, col.correct = "black", col.wrong = "red", 
    col.mean = "black", col.contour = "darkgrey", gs = as.character(grouping), 
    pch.mean = 19, cex.mean = 1.3, print.err = 0.7, legend.err = FALSE,
    legend.bg = "white", imageplot = TRUE, image.colors = cm.colors(nc), 
    plot.control = list(), ...){                       
    #grouping: class vec.
    #x: first data vec.
    #y: second data vec.
    #prec: nr. of hor/vert splits.

    success <- switch(method, 
        rpart = requireNamespace("rpart") , 
        naiveBayes = requireNamespace("e1071"))
    if(!is.null(success) && !success){
        message("For method 'rpart' the 'rpart' package is required, for method 'naiveBayes' the package 'e1071'.")
        return(NULL)
    }
    
    z <- switch(method,
        lda = lda(grouping ~ x + y,...),
        qda = qda(grouping ~ x + y,...),
        svmlight = svmlight(grouping ~ x + y,...),
        rda = rda(grouping~ x + y, 
            data = cbind.data.frame("grouping" = grouping, "x" = x, "y" = y), ...),
        sknn = sknn(grouping ~ x + y,...),
        rpart = rpart::rpart(grouping~ x + y,...),
        naiveBayes = e1071::naiveBayes(grouping~ x + y, 
            data = cbind.data.frame("grouping" = grouping, "x" = x, "y" = y), ...),
        stop("method not yet supported"))

    # Build a grid on the 2 coordinates
    xg <- seq(min(x), max(x), length = prec)
    yg <- seq(min(y), max(y), length = prec)
    grd <- expand.grid(x = xg, y = yg)
    # Calculate posterior Probabilities on grid points
    temp <- switch(method,
        lda = predict(z, grd,...)$post,
        qda = predict(z, grd,...)$post,
        svmlight = e.scal(predict(z, grd,...)$post)$sv,
        rda = predict(z, grd, posterior=TRUE, aslist=TRUE)$post,
        rpart = predict(z, grd, ...),
        sknn = predict(z, grd, ...)$post,
        naiveBayes = predict(z, grd , type="raw", ...),
        stop("method not yet supported"))

    khead <- switch(method,
        lda = predict(z, data.frame(cbind(x,y)),...)$post,
        qda = predict(z, data.frame(cbind(x,y)),...)$post,
        svmlight = e.scal(predict(z, data.frame(cbind(x,y)),...)$post)$sv,
        rda = predict(z, data.frame(cbind(x,y)), posterior=TRUE, aslist=TRUE)$post,
        rpart = predict(z, data.frame(cbind(x,y)), ...),
        sknn = predict(z, data.frame(cbind(x,y)),...)$post,
        naiveBayes = predict(z, data.frame(cbind(x,y)), type="raw", ...),
        stop("method not yet supported"))

    colorw <- colnames(khead)[apply(khead, 1, which.max)] != grouping
    
    err <- round(mean(colorw), 3)
    color <- ifelse(colorw, col.wrong, col.correct)
    if(is.character(gs) || is.factor(gs)) gs <- substr(gs, 1, 1)

    nc <- ncol(temp)
    if(imageplot){
        do.call("image", c(list(xg, yg, matrix(apply(temp, 1, which.max), ncol = prec), 
            main = NULL, col = image.colors, breaks = (0:nc) + .5, 
            xlab = xlab, ylab = ylab), plot.control))
        do.call("points", c(list(x, y, pch = gs, col = color), plot.control))
        box()
    }
    else 
        do.call("plot", c(list(x, y, pch = gs, col = color, main = NULL, xlab = xlab, ylab = ylab), plot.control))
    if((method=="lda") || (method=="qda")) 
        points(z$means, pch = pch.mean, cex = cex.mean, col = col.mean)
    
    # For each class calculate the difference between prob. and max(prob) for other class,
    # so, the obs is assigned to class iff diff>0
    if(!imageplot)
        for(i in 1:ncol(temp)){
            dummy <- temp[,i] - apply(temp[ , -i, drop = FALSE], 1, max)            
        # Draw contour line at hight=0, i.e. class border
            contour(xg, yg, matrix(dummy, ncol = prec), levels = 0, 
                add = TRUE, drawlabels = FALSE, col = col.contour)
        }

    if(print.err){
        if(legend.err)
            legend(par("usr")[1], par("usr")[4], 
                legend = paste("Error:", err), bg = legend.bg, cex = print.err)
        else
            mtext(paste("app. error rate:", err), 3, cex = print.err)
    }

    # Returning the data used for plotting
    plotted_data <- data.frame(x = x, y = y, grouping = grouping)
    return(plotted_data)
}