diff options
| author | Luca Coraggio <luca.coraggio@unina.it> | 2020-07-04 09:50:03 +0000 |
|---|---|---|
| committer | cran-robot <csardi.gabor+cran@gmail.com> | 2020-07-04 09:50:03 +0000 |
| commit | 511e3ca9e5235e018f772693907d9ec10002b02a (patch) | |
| tree | c7cb699babfa439e6bfbe47007e3916867517f76 /R/rmad.R | |
version 1.0
Diffstat (limited to 'R/rmad.R')
| -rw-r--r-- | R/rmad.R | 31 |
1 files changed, 31 insertions, 0 deletions
diff --git a/R/rmad.R b/R/rmad.R new file mode 100644 index 0000000..b8e9d41 --- /dev/null +++ b/R/rmad.R @@ -0,0 +1,31 @@ +rmad <- function(x, y = NULL, na.rm = FALSE, even.correction = FALSE) { + dat <- .check_input_data_matrix(x = x, y = y, na.rm = na.rm) + colnames_original <- colnames(dat) + storage.mode(dat) <- "double" + n <- as.integer(nrow(dat)) + p <- as.integer(ncol(dat)) + nc <- as.integer({ + p^2 - p + }/2) + if (even.correction) { + evencorrection <- 1L + } + else { + evencorrection <- 0L + } + u <- .Fortran("cormadvecdp", matrix = dat, nrow = n, ncol = p, res = numeric(nc), + ressize = nc, correcteven = evencorrection, PACKAGE = "RSC")$res + if (!is.null(y)) { + return(u) + } + else { + R <- Matrix(1, nrow = p, ncol = p, sparse = FALSE) + R[lower.tri(R, diag = FALSE)] <- u + R <- forceSymmetric(R, uplo = "L") + R <- as(R, "dspMatrix") + if (!is.null(colnames_original)) { + dimnames(R)[[1]] <- dimnames(R)[[2]] <- colnames_original + } + return(R) + } +} |
