Spectral decomposition, code

Tools for spectral decomposition of a data set and spectral clustering

DESCRIPTION

@@ -1,11 +1,12 @@
 Package: clustTools
 Type: Package
 Title: Tools for Dimensionality Reduction and Data Clustering
-Version: 1.3.0
+Version: 1.3.1
 Maintainer: Piotr Tymoszuk <[email protected]>
 Description: Provides a comprehensive set of R functions for dimensionality 
-    reduction (PCA, MDS and UMAP), clustering (HCl, KMEANS, PAM, DBSCAN, SOM 
-    and regularized KMEANS) and combined reduction-clustering tools. 
+    reduction (PCA, MDS, UMAP, matrix decomposition), 
+    clustering (HCl, KMEANS, PAM, DBSCAN, SOM and regularized KMEANS) 
+    and combined reduction-clustering tools. 
     Visualization and QC toolset is provided as well.
 License: GPL-3
 Encoding: UTF-8
@@ -21,6 +22,7 @@ Imports:
     coxed,
     dbscan,
     dendextend,
+    expm,
     factoextra,
     furrr,
     future,

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(as_red_analysis,spectre)
 S3method(components,clust_analysis)
 S3method(components,combi_analysis)
 S3method(components,min_analysis)
@@ -34,6 +35,7 @@ S3method(nobs,clust_analysis)
 S3method(nobs,combi_analysis)
 S3method(nobs,min_analysis)
 S3method(nobs,red_analysis)
+S3method(nobs,spectre)
 S3method(np,clust_analysis)
 S3method(np,combi_analysis)
 S3method(np,red_analysis)
@@ -47,6 +49,7 @@ S3method(plot,importance)
 S3method(plot,knb)
 S3method(plot,red_analysis)
 S3method(plot,sil_extra)
+S3method(plot,spectre)
 S3method(plot,tuner)
 S3method(plot,umatrix_analysis)
 S3method(plot_clust_hm,clust_analysis)
@@ -66,6 +69,7 @@ S3method(print,clust_analysis)
 S3method(print,combi_analysis)
 S3method(print,cross_dist)
 S3method(print,red_analysis)
+S3method(print,spectre)
 S3method(print,tuner)
 S3method(qe,clust_analysis)
 S3method(qe,combi_analysis)
@@ -88,6 +92,8 @@ S3method(var,clust_analysis)
 S3method(var,combi_analysis)
 S3method(var,default)
 S3method(var,red_analysis)
+export(as_red_analysis)
+export(as_red_analysis.spectre)
 export(calculate_dist)
 export(calculate_weighted_dist)
 export(center_data)
@@ -100,6 +106,7 @@ export(cross_distance)
 export(cv)
 export(dbscan_cluster)
 export(dist)
+export(dist2affi)
 export(extract)
 export(extract.clust_analysis)
 export(extract.cluster_cv)
@@ -119,6 +126,7 @@ export(is_knb)
 export(is_min_analysis)
 export(is_red_analysis)
 export(is_sil_extra)
+export(is_spectre)
 export(is_tuner)
 export(is_umatrix_analysis)
 export(kcluster)
@@ -134,6 +142,7 @@ export(plot.importance)
 export(plot.knb)
 export(plot.red_analysis)
 export(plot.sil_extra)
+export(plot.spectre)
 export(plot.tuner)
 export(plot_clust_hm)
 export(plot_nbclust)
@@ -151,6 +160,7 @@ export(silhouette.clust_analysis)
 export(silhouette.combi_analysis)
 export(som_cluster)
 export(som_reduce)
+export(spectralize)
 export(summary.clust_analysis)
 export(summary.combi_analysis)
 export(summary.cross_dist)
@@ -168,11 +178,17 @@ importFrom(dplyr,count)
 importFrom(dplyr,filter)
 importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
+importFrom(dplyr,relocate)
 importFrom(dplyr,rename)
 importFrom(dplyr,select)
+importFrom(expm,`%^%`)
 importFrom(generics,components)
 importFrom(ggplot2,aes)
+importFrom(ggplot2,geom_point)
+importFrom(ggplot2,geom_vline)
 importFrom(ggplot2,ggplot)
+importFrom(ggplot2,labs)
+importFrom(ggplot2,position_jitter)
 importFrom(purrr,compact)
 importFrom(purrr,map)
 importFrom(purrr,map2)

R/class_testing.R

@@ -5,7 +5,7 @@
 #' @description
 #' Tests if the object is an instance of the `red_analysis`, `clust_analysis`,
 #' `combi_analysis`, `importance`, `cross_dist`, `sil_extra`, `min_analysis`,
-#' `umatrix_analysis`, `cluster_cv`, `knb` or `tuner` class.
+#' `umatrix_analysis`, `cluster_cv`, `knb`, `tuner`, or `spectre` class.
 #'
 #' @return a logical value.
 #'
@@ -65,4 +65,9 @@
 
   is_tuner <- function(x) inherits(x, 'tuner')
 
+#' @rdname is_clust_analysis
+#' @export
+
+  is_spectre <- function(x) inherits(x, 'spectre')
+
 # END ------

R/constructors.R

@@ -753,4 +753,65 @@
 
   }
 
+# Spectralization result container -------
+
+#' Create a `spectre` object.
+#'
+#' @description
+#' Creates an instance of `spectre` class.
+#'
+#' @details
+#' Technically, a `spectre` object is a list with the following components:
+#'
+#' * `degrees`: a numeric vector with degrees of the graph nodes stored in the
+#' diagonal of the degree matrix
+#'
+#' * `eigen_values`: a numeric vector of eigenvalues sorted from the largest to
+#' the smallest one
+#'
+#' * `eigen_vectors`: a numeric matrix whose rows represent the observations in
+#' he initial data set and columns representing the eigenvectors.
+#' The eigenvectors are sorted by their einegvalues: the largest come first
+#'
+#' @param x a list with elements specified in Details.
+#'
+#' @return an instance of the `spectre` class as described in Details.
+
+  spectre <- function(x) {
+
+    ## entry control -------
+
+    error_txt <-
+      paste("'x' has to be a list with the following elements: 'degree',",
+            "eigen_values', and 'eigen_vectors'.")
+
+    if(!is.list(x)) stop(error_txt, call. = FALSE)
+
+    if(is.null(names(x))) stop(error_txt, call = FALSE)
+
+    if(any(!c('degrees', 'eigen_values', 'eigen_vectors') %in% names(x))) {
+
+      stop(error_txt, call. = FALSE)
+
+    }
+
+    if(!is.numeric(x$degrees) | !is.numeric(x$eigen_values)) {
+
+      stop("'degree' and 'eigen_values' have to be numeric vectors.",
+           call. = FALSE)
+
+    }
+
+    error_txt <- "'eigen_vectors' has to be a numeric matrix."
+
+    if(!is.matrix(x$eigen_vector)) stop(error_txt, call. = FALSE)
+
+    if(!is.numeric(x$eigen_vector)) stop(error_txt, call. = FALSE)
+
+    ## construction --------
+
+    structure(x, class = 'spectre')
+
+  }
+
 # END ------

R/generics.R

@@ -1,5 +1,5 @@
 # Provides S3 generics and the default methods for functions 'kidnapped'
-# from base R and other packages.
+# from base R and other packages, and `as_` functions used for type conversion.
 
 # Variance --------
 
@@ -13,20 +13,12 @@
 #' @param ... extra arguments passed to methods, e.g. \code{\link[stats]{var}}.
 #' @export
 
-  var <- function(x, ...) {
-
-    UseMethod('var')
-
-  }
+  var <- function(x, ...) UseMethod('var')
 
 #' @rdname var
 #' @export
 
-  var.default <- function(x, ...) {
-
-    stats::var(x, ...)
-
-  }
+  var.default <- function(x, ...) stats::var(x, ...)
 
 # Distance --------
 
@@ -42,19 +34,11 @@
 #' @param ... arguments for methods, e.g. passed to \code{\link[stats]{dist}}.
 #' @export
 
-  dist <- function(x, ...) {
-
-    UseMethod('dist')
-
-  }
+  dist <- function(x, ...) UseMethod('dist')
 
 #' @rdname dist
 #' @export
 
-  dist.default <- function(x, ...) {
-
-    stats::dist(x, ...)
-
-  }
+  dist.default <- function(x, ...) stats::dist(x, ...)
 
 # END ------

R/imports.R

@@ -16,6 +16,7 @@
 #' @importFrom dplyr select
 #' @importFrom dplyr filter
 #' @importFrom dplyr rename
+#' @importFrom dplyr relocate
 #'
 #' @importFrom purrr map
 #' @importFrom purrr map2
@@ -50,7 +51,12 @@
 #'
 #' @importFrom ggplot2 ggplot
 #' @importFrom ggplot2 aes
+#' @importFrom ggplot2 geom_vline
+#' @importFrom ggplot2 geom_point
+#' @importFrom ggplot2 labs
+#' @importFrom ggplot2 position_jitter
 #'
 #' @importFrom cluster silhouette
+#' @importFrom expm `%^%`
 
   NULL