version 1.0

DESCRIPTION

@@ -0,0 +1,18 @@
+Package: mvcauchy
+Type: Package
+Title: Multivariate Cauchy Distribution
+Version: 1.0
+Date: 2024-02-06
+Authors@R: c( person("Michail", "Tsagris", role = c("aut", "cre"), email = "mtsagris@uoc.gr"),
+      		   person("Christos", "Adam", role = "ctb", email = "pada4m4@gmail.com") )
+Author: Michail Tsagris [aut, cre],
+  Christos Adam [ctb]
+Maintainer: Michail Tsagris <mtsagris@uoc.gr>
+Depends: R (>= 4.0)
+Imports: graphics, grDevices, Rfast, Rfast2
+Description: The Cauchy distribution is a special case of the t distribution when the degrees of freedom are equal to 1. The functions are related to the multivariate Cauchy distribution and include simulation, computation of the density, maximum likelihood estimation, contour plot of the bivariate Cauchy distribution, and discriminant analysis. References include: Nadarajah S. and Kotz S. (2008). "Estimation methods for the multivariate t distribution". Acta Applicandae Mathematicae, 102(1): 99--118. <doi:10.1007/s10440-008-9212-8>, and Kanti V. Mardia, John T. Kent and John M. Bibby (1979). "Multivariate analysis", ISBN:978-0124712522. Academic Press, London.
+License: GPL (>= 2)
+NeedsCompilation: no
+Packaged: 2024-02-06 06:30:05 UTC; mtsag
+Repository: CRAN
+Date/Publication: 2024-02-06 18:20:08 UTC

MD5

@@ -0,0 +1,21 @@
+31d6a39e36c8c076e3ef0c960d6e3b3a *DESCRIPTION
+a72f41fe4150246a0c4e5005f36b807e *NAMESPACE
+96becc82b52f6c83dcb38685cbc4464a *R/bivcauchy.contour.R
+add44450c8cc83ca88968e8a642511e1 *R/cauchy.nb.R
+534bbf7af68734d0a8e22611575b8bde *R/cauchynb.pred.R
+a03b6d07d60cfa5cfb58fc5408cf5456 *R/cv.cauchynb.R
+a9f08007493bf5feddea80f3983d1a07 *R/cv.mvcauchyda.R
+69950e359ea311b00c78d3b9ee612ac9 *R/dmvcauchy.R
+9e4f194a34b2375c1cece1e55c91a6d2 *R/mvcauchy.da.R
+5126ddbf59b5d7eb33a99f22a4ff27ed *R/mvcauchy.mle.R
+91d44d0c44ec8e60e92a1bb18bd069f3 *R/rmvcauchy.R
+38ce166b863ac29da3be8853fd3c71d2 *man/bivcauchy.contour.Rd
+a1a97e7628f693e9ca5cb493871ae340 *man/cauchy.nb.Rd
+5e5cd75e24490766d80c2869eb767573 *man/cauchynb.pred.Rd
+4408e8b131b6a51066fba318246714b6 *man/cv.cauchynb.Rd
+4a6d41f11bd6548ae740bc0a39d05722 *man/cv.mvcauchyda.Rd
+afb04278b5c3d67c6c1090e5ee85c014 *man/dmvcauchy.Rd
+0df599d9502a273dd2e2a6a9a1ccaa5b *man/mvcauchy-package.Rd
+7d5e1c3110c77d452b5e44f053e90c48 *man/mvcauchy.da.Rd
+56f3b5d36d1a816e84a4f20df296ce73 *man/mvcauchy.mle.Rd
+aead35d9d3252670413861f47ddb00c2 *man/rmvcauchy.Rd

NAMESPACE

@@ -0,0 +1,12 @@
+#useDynLib(pchc, .registration = TRUE)
+
+importFrom("Rfast", dmvt, mvt.mle, rmvt)
+importFrom("Rfast2", cauchynb.pred, cauchy.nb, nb.cv)
+importFrom("graphics", filled.contour, contour, points, axis, par)
+importFrom("grDevices", "colorRampPalette")
+
+exportPattern("^[[:alpha:]]+")
+exportPattern("^[^\\.]")
+
+export(bivcauchy.contour, cauchy.nb, cauchynb.pred, cv.cauchynb, cv.mvcauchyda,
+       dmvcauchy, rmvcauchy, mvcauchy.da, mvcauchy.mle)

R/bivcauchy.contour.R

@@ -0,0 +1,39 @@
+bivcauchy.contour <- function(x, m = NULL, s = NULL, cont.lines = TRUE, add.points = TRUE) {
+    n1 <- 100
+    n2 <- 100
+    x1 <- seq(min(x[, 1]) - 0.5, max(x[, 1]) + 0.5, length = n1)
+    x2 <- seq(min(x[, 2]) - 0.5, max(x[, 2]) + 0.5, length = n2)
+
+    if ( is.null(m) | is.null(s) ) {
+      f <- mvcauchy::mvcauchy.mle(x)
+      m <- f$location
+      s <- f$scatter
+    }
+    r <- s[2]/sqrt(s[1] * s[4])
+    con <- 0.5 * sqrt(pi) - lgamma(1/2) - 0.5 * log( det(pi * s) )
+    z1 <- (x1 - m[1])/sqrt(s[1])
+    z2 <- (x2 - m[2])/sqrt(s[4])
+    mat1 <- outer(z1^2, rep(1, n1), "*")
+    mat2 <- outer(rep(1, n2), z2^2, "*")
+    mat3 <- tcrossprod(z1, z2)
+    mat <- con - 1.5 * log1p( 1/(1 - r^2) * (mat1 + mat2 - 2 * r * mat3) )
+
+    mat <- exp(mat)
+    ind <- (mat < Inf)
+    ind[ind == FALSE] <- NA
+    mat <- mat * ind
+
+    oldpar <- par(fg = NA)
+    on.exit( par(oldpar) )
+    filled.contour(x1, x2, mat, nlevels = 200, color.palette =  colorRampPalette( c( "blue","cyan","yellow","red") ),
+                   xlab = colnames(x)[1], ylab = colnames(x)[2], cex.lab = 1.2, cex.axis = 1.2,
+        key.axes = {axis(4, col = "black")},
+        plot.axes = {
+        if ( cont.lines )  contour(x1, x2, mat, nlevels = 10, col = 1, labcex = 0.8, lwd = 1.5, add = TRUE)
+        if (add.points) {
+          points(x[, 1], x[, 2], pch = 20, col = 1)
+          points(m[1], m[2], pch = 10, cex = 1.5, col = 1)
+        }
+      }
+    )
+}

R/cauchy.nb.R

@@ -0,0 +1,3 @@
+cauchy.nb <- function(xnew = NULL, x, ina) {
+  Rfast2::cauchy.nb(xnew, x, ina)
+}

R/cauchynb.pred.R

@@ -0,0 +1,3 @@
+cauchynb.pred <- function(xnew, location, scale, ni) {
+  Rfast2::cauchynb.pred(xnew, location, scale, ni)
+}

R/cv.cauchynb.R

@@ -0,0 +1,46 @@
+cv.cauchynb <- function(x, ina, folds = NULL, nfolds = 10,
+                       stratified = TRUE, seed = FALSE, pred.ret = FALSE) {
+
+Rfast2::nb.cv(x, ina, type = "cauchy", folds = NULL, nfolds = 10,
+                  stratified = TRUE, seed = FALSE, pred.ret = FALSE)
+}
+
+
+
+
+.makefolds <- function (ina, nfolds = 10, stratified = TRUE, seed = NULL) {
+  names <- paste("Fold", 1:nfolds)
+  runs <- sapply(names, function(x) NULL)
+  if (!is.null(seed))
+    set.seed(seed)
+  if (!stratified) {
+    rat <- length(ina) %% nfolds
+    mat <- matrix(Rfast2::Sample.int(length(ina)), ncol = nfolds)
+    mat[-c(1:length(ina))] <- NA
+    for  (i in 1:c(nfolds - 1) ) runs[[i]] <- mat[, i]
+    a <- prod(dim(mat)) - length(ina)
+    runs[[nfolds]] <- mat[1:c(nrow(mat) - a), nfolds]
+  }
+  else {
+    labs <- unique(ina)
+    run <- list()
+    for ( i in 1:length(labs) ) {
+      names <- which( ina == labs[i] )
+      run[[i]] <- sample(names)
+    }
+    run <- unlist(run)
+    for ( i in 1:length(ina) ) {
+      k <- i %% nfolds
+      if (k == 0)
+        k <- nfolds
+      runs[[k]] <- c(runs[[k]], run[i])
+    }
+  }
+  for (i in 1:nfolds) {
+    if ( any( is.na( runs[[ i ]] ) ) )
+      runs[[ i ]] <- runs[[ i ]][ !is.na( runs[[ i ]] ) ]
+  }
+  if ( length( runs[[ nfolds ]] ) == 0 )
+    runs[[nfolds]] <- NULL
+  runs
+}

R/cv.mvcauchyda.R

@@ -0,0 +1,21 @@
+cv.mvcauchyda <- function(x, ina, nfolds = 10, folds = NULL, stratified = TRUE, seed = NULL) {
+  ina <- as.numeric(ina)
+  if ( is.null(folds) )  folds <- .makefolds(ina, nfolds = nfolds,
+                                             stratified = stratified, seed = seed)
+  nfolds <- length(folds)
+  per <- numeric(nfolds)
+  runtime <- proc.time()
+
+  for (vim in 1:nfolds) {
+    test <- x[ folds[[ vim ]], , drop = FALSE ]   ## test sample
+    id <- ina[ folds[[ vim ]] ] ## groups of test sample
+    train <- x[ -folds[[ vim ]], , drop = FALSE]  ## training sample
+    ida <- ina[ -folds[[ vim ]] ]   ## groups of training sample
+    group <- mvcauchy::mvcauchy.da(test, train, ida)$est
+    per[vim] <- mean( group == id )
+  }  ##  end  for (vim in 1:nfolds) {
+
+  runtime <- proc.time() - runtime
+  perf <- mean(per)
+  list(perf = perf, runtime = runtime)
+}

R/dmvcauchy.R

@@ -0,0 +1,3 @@
+dmvcauchy <- function(x, mu, sigma, logged = FALSE) {
+  Rfast::dmvt(x, mu, sigma, nu = 1, logged)
+}

R/mvcauchy.da.R

@@ -0,0 +1,31 @@
+mvcauchy.da <- function(xnew, x, ina, mod = NULL) {
+  ina <- as.numeric(ina)
+  d <- dim(x)[2]
+  ni <- tabulate(ina)
+  g <- length(ni)
+
+  xnew <- as.matrix(xnew)
+  if ( dim(xnew)[2] == 1 )  xnew <- matrix(xnew, ncol = d)
+  nu <- dim(xnew)[1]
+
+  est <- matrix(nrow = nu, ncol = g)
+
+  if ( is.null(mod) ) {
+    mod <- list()
+    for (i in 1:g) {
+      mod[[ i ]] <- mvcauchy::mvcauchy.mle(x[ina == i, ])
+      est[, i] <- mvcauchy::dmvcauchy(xnew, mod[[ i ]]$location,
+                            mod[[ i ]]$scatter, logged = TRUE) + log(ni[i])
+    }
+
+  } else {
+    for (i in 1:g)  est[, i] <- mvcauchy::dmvcauchy(x[ina == i, ], mod[[ i ]]$location,
+                                          mod[[ i ]]$scatter, logged = TRUE) + log(ni[i])
+
+  } ## end if ( is.null(mod) )
+
+  prob <- exp(est)
+  prob <- prob / Rfast::rowsums( prob ) ## the probability of classification
+
+  list( mod = mod, prob = prob, est = Rfast::rowMaxs(est) )
+}

R/mvcauchy.mle.R

@@ -0,0 +1,3 @@
+mvcauchy.mle <- function(x, tol = 1e-7) {
+  Rfast::mvt.mle(x, v = 1, tol)
+}

R/rmvcauchy.R

@@ -0,0 +1,3 @@
+rmvcauchy <- function(n, mu, sigma) {
+  Rfast::rmvt(n, mu, sigma, v = 1)
+}

man/bivcauchy.contour.Rd

@@ -0,0 +1,71 @@
+\name{Contour plot of the bivariate Cauchy distribution}
+\alias{bivcauchy.contour}
+\title{
+Contour plot of the bivariate Cauchy distribution
+}
+
+\description{
+Contour plot of the bivariate Cauchy distribution.
+}
+
+\usage{
+bivcauchy.contour(x, m = NULL, s = NULL, cont.lines = TRUE, add.points = TRUE)
+}
+
+\arguments{
+\item{x}{
+A matrix with two columns containing the data.
+}
+\item{m}{
+If you know the location vector place it here. In this case the function still
+needs the argument with the data.
+}
+\item{s}{
+If you know the scatter matrix place it here. In this case the function still
+needs the argument with the data.
+}
+\item{cont.lines}{
+Do you want the contour lines to appear?
+}
+\item{add.points}{
+Do you want the data points to appear?
+}
+}
+
+\value{
+The contour plot.
+}
+
+\details{
+The function plots the contours of the bivariate Cauchy distribution whose parameters
+are either estimated from some data or they are given as inputs. If you want the contour
+plot of the bivariate Cauchy distribution with some pre-specified location and scatter
+matrix, then provide some cleverly specified data "x" so that you receive what you want.
+See the examples.
+}
+
+\author{
+Michail Tsagris and Christos Adam.
+
+R implementation and documentation: Michail Tsagris \email{mtsagris@uoc.gr}
+and Christos Adam \email{pada4m4@gmail.com}.
+}
+
+\seealso{
+\code{\link{dmvcauchy}
+}
+}
+
+\examples{
+## not specified location and scatter
+x <- as.matrix(iris[, 1:2])
+bivcauchy.contour(x)
+
+## with specified location and scatter
+m <- colMeans(x)
+s <- cov(x)
+## in this case you may need to adjust the data points youself
+## "play"" with minimum and maximum values of the two axes
+y <- rbind( apply(x, 2, min) - 1, apply(x, 2, max) + 2 )
+bivcauchy.contour(y, m = m, s = s, add.points = FALSE)
+}

man/cauchy.nb.Rd

@@ -0,0 +1,74 @@
+\name{Cauchy naive Bayes classifier}
+\alias{cauchy.nb}
+
+\title{
+Cauchy naive Bayes classifier
+}
+
+\description{
+Cauchy naive Bayes classifier.
+}
+
+\usage{
+cauchy.nb(xnew = NULL, x, ina)
+}
+
+\arguments{
+\item{xnew}{
+A numerical matrix with new predictor variables whose group is to be predicted.
+This is set to NUUL, as you might want just the model and not to predict the
+membership of new observations.
+}
+\item{x}{
+A numerical matrix with the observed predictor variable values.
+}
+\item{ina}{
+A numerical vector with strictly positive numbers, i.e. 1,2,3 indicating the groups
+of the dataset. Alternatively this can be a factor variable.
+}
+}
+
+%\details{
+%
+%}
+
+\value{
+Depending on the classifier a list including (the ni and est are common for all classifiers):
+\item{location}{
+A matrix with the location parameters (medians).
+}
+\item{scale}{
+A matrix with the scale parameters.
+}
+\item{ni}{
+The sample size of each group in the dataset.
+}
+\item{est}{
+The estimated group of the xnew observations. It returns a numerical value back regardless of the target
+variable being numerical as well or factor. Hence, it is suggested that you do \"as.numeric(ina)\" in order to
+see what is the predicted class of the new data.
+}
+}
+
+%\references{
+%
+%}
+
+\author{
+Michail Tsagris.
+
+R implementation and documentation: Michail Tsagris \email{mtsagris@uoc.gr}.
+}
+%\note{
+%%  ~~further notes~~
+%}
+
+\seealso{
+\code{ \link{cauchynb.pred}, \link{cv.cauchynb}
+}
+}
+
+\examples{
+x <- as.matrix(iris[, 1:4])
+a <- cauchy.nb(x, x, ina = iris[, 5])
+}