mlKnn added

Author: phgrosjean

NAMESPACE

@@ -16,6 +16,7 @@ export(mlearning)
 export(mlLda)
 export(mlQda)
 export(mlRforest)
+export(mlKnn)
 export(mlLvq)
 export(mlNnet)
 export(mlSvm)
@@ -63,6 +64,7 @@ S3method(print, summary.lvq)
 S3method(mlLda, default)
 S3method(mlQda, default)
 S3method(mlRforest, default)
+S3method(mlKnn, default)
 S3method(mlLvq, default)
 S3method(mlNnet, default)
 S3method(mlSvm, default)
@@ -72,6 +74,7 @@ S3method(mlNaiveBayes, default)
 S3method(mlLda, formula)
 S3method(mlQda, formula)
 S3method(mlRforest, formula)
+S3method(mlKnn, formula)
 S3method(mlLvq, formula)
 S3method(mlNnet, formula)
 S3method(mlSvm, formula)
@@ -81,6 +84,7 @@ S3method(mlNaiveBayes, formula)
 S3method(predict, mlLda)
 S3method(predict, mlQda)
 S3method(predict, mlRforest)
+S3method(predict, mlKnn)
 S3method(predict, mlLvq)
 S3method(predict, mlNnet)
 S3method(predict, mlSvm)

NEWS.md

@@ -1,6 +1,6 @@
 # mlearning 1.1.0
 
--   mlKnn() is implemented for K-nearest neigbour.
+-   mlKnn() is implemented for K-nearest neigbours.
 
 -   Several adjustments were required for compatibility with R 4.2.0 (it is not allowed any more to use vectors \> 1 with \|\| and &&).
 

R/mlearning.R

@@ -1312,3 +1312,104 @@ na.action = na.exclude, threshold = 0.001, eps = 0, ...) {
 #    algorithm = "Weka naive Bayes classifier",
 #    class = c("mlNaiveBayesWeka", "mlearning", "Weka_classifier"))
 #}
+
+mlKnn <- function(train, ...)
+  UseMethod("mlKnn")
+
+mlKnn.formula <- function(formula, data, k.nn = 5, ..., subset, na.action) {
+  mlearning(formula, data = data, method = "mlKnn", model.args =
+      list(formula  = formula, data = substitute(data),
+        subset = substitute(subset)), call = match.call(), k.nn = k.nn, ...,
+    subset = subset, na.action = substitute(na.action))
+}
+
+mlKnn.default <- function(train, response, k.nn = 5, ...) {
+  if (!is.factor(response))
+    stop("only factor response (classification) accepted for mlKnn")
+
+  dots <- list(...)
+  .args. <- dots$.args.
+  dots$.args. <- NULL
+  dots$k.nn <- k.nn
+  if (!length(.args.))
+    .args. <- list(levels = levels(response),
+      n = c(intial = NROW(train), final = NROW(train)),
+      type = "classification", na.action = "na.pass",
+      mlearning.call = match.call(), method = "mlKnn")
+
+  # matrix of numeric values
+  if (any(sapply(train, is.factor))) {
+    warning("force conversion from factor to numeric; may be not optimal or suitable")
+    train <- sapply(train, as.numeric)
+  }
+
+  # Create an object similar to the one obtained with ipred::ipredknn
+  res <- list(learn = list(y = response, X = train))
+  res$k <- k.nn
+  class(res) <- "simpleKnn"
+
+  # Return a mlearning object
+  structure(res, formula = .args.$formula, train = train,
+    response = response, levels = .args.$levels, n = .args.$n, args = dots,
+    optim = .args.$optim, numeric.only = TRUE, type = .args.$type,
+    pred.type = c(class = "class", prob = "prob"), summary = NULL,
+    na.action = .args.$na.action,
+    mlearning.call = .args.$mlearning.call, method = .args.$method,
+    algorithm = "k-nearest neighbours",
+    class = c("mlKnn", "mlearning", class(res)))
+}
+
+#summary.mlKnn <- function(object, ...)
+#  structure(cbind(Class = object$cl, as.data.frame(object$x)),
+#    class = c("summary.mlKnn", "data.frame"))
+
+#print.summary.mlKnn <- function(x, ...) {
+#  cat("Train dataset:\n")
+#  print(as.data.frame(x))
+#  invisible(x)
+#}
+
+predict.mlKnn <- function(object, newdata,
+  type = c("class", "prob", "both"),
+  method = c("direct", "cv"), na.action = na.exclude, ...) {
+  if (!inherits(object, "mlKnn"))
+    stop("'object' must be a 'mlKnn' object")
+
+  # If method == "cv", delegate to cvpredict()
+  method <- as.character(method)[1]
+  if (method == "cv") {
+    if (!missing(newdata))
+      stop("cannot handle new data with method = 'cv'")
+    return(cvpredict(object = object, type = type, na.action = na.action, ...))
+  }
+
+  # Recalculate newdata according to formula...
+  if (missing(newdata))
+    newdata <- object$learn$X # Use train
+  # Use model.frame but eliminate dependent variable, not required
+  # (second item in the formula)
+  newdata <- model.frame(formula = attr(object, "formula")[-2],
+    data = newdata, na.action = na.pass)[, names(object$learn$X)]
+  # Only numerical predictors
+  newdata <- sapply(as.data.frame(newdata), as.numeric)
+
+  # Determine how many data and perform na.action
+  n <- NROW(newdata)
+  newdata <- match.fun(na.action)(newdata)
+  ndrop <- attr(newdata, "na.action")
+
+  if (inherits(object, "simpleKnn")) {
+    res <- class::knn(object$learn$X, newdata, object$learn$y, k = object$k,
+      prob = TRUE)
+  } else {# ipred::ipredknn
+    res <- ipred::predict.ipredknn(object, newdata, type = "class")
+  }
+  type <- as.character(type[1])
+  if (type == "prob") {
+    return(attr(res, "prob"))
+  } else if (type == "class") {
+    attr(res, "prob") <- NULL
+  }
+
+  .expandFactor(res, n, ndrop)
+}

README.md

@@ -6,7 +6,7 @@
 
 <!-- badges: end -->
 
-{mlearning} rovides a unified interface to various machine learning algorithms. Confusion matrices are provided too.
+{mlearning} provides a unified interface to various machine learning algorithms. Confusion matrices are provided too.
 
 ## Installation
 

man/mlearning.Rd

@@ -25,6 +25,10 @@
 \alias{mlNnet.default}
 \alias{mlNnet.formula}
 \alias{predict.mlNnet}
+\alias{mlKnn}
+\alias{mlKnn.default}
+\alias{mlKnn.formula}
+\alias{predict.mlKnn}
 \alias{mlLvq}
 \alias{mlLvq.default}
 \alias{mlLvq.formula}
@@ -91,6 +95,12 @@ mlNnet(train, ...)
 \method{predict}{mlNnet}(object, newdata, type = c("class", "membership", "both", "raw"),
     method = c("direct", "cv"), na.action = na.exclude,...)
 
+mlKnn(train, ...)
+\method{mlKnn}{default}(train, response, k.nn = 5, ...)
+\method{mlKnn}{formula}(formula, data, k.nn = 5, ..., subset, na.action)
+\method{predict}{mlKnn}(object, newdata, type = c("class", "prob", "both"),
+    method = c("direct", "cv"), na.action = na.exclude,...)
+
 mlLvq(train, ...)
 \method{mlLvq}{default}(train, response, k.nn = 5, size, prior, algorithm = "olvq1", ...)
 \method{mlLvq}{formula}(formula, data, k.nn = 5, size, prior, algorithm = "olvq1", ...,
@@ -193,7 +203,7 @@ train(object, ...)
     computed. }
   \item{decay}{ parameter for weight decay. Default 0. }
   \item{maxit}{ maximum number of iterations. Default 1000. }
-  \item{k.nn}{ k used for k-NN test of correct classification. Default is 5. }
+  \item{k.nn}{ k used for k-NN number of neighbour considered. Default is 5. }
   \item{algorithm}{ an algorithm among 'olvq1' (default, the optimized lvq1),
     'lvq1', 'lvq2', or 'lvq3'. }
   \item{scale}{ are all the variables scaled? If a vector is provided, it is
@@ -356,6 +366,13 @@ plot(na.omit(airquality)$Ozone, predict(ozone.nnet, type = "raw"))
 abline(a = 0, b = 1)
 
 
+## Supervised classification using k-nearest neighbours
+summary(res <- mlKnn(Species ~ ., data = irisTrain))
+predict(res) # This object only returns class
+confusion(res) # Self-consistency
+confusion(predict(res, newdata = irisTest), irisTest$Species) # Test set perfs
+
+
 ## Supervised classification using learning vector quantization
 summary(res <- mlLvq(Species ~ ., data = irisTrain))
 predict(res) # This object only returns class