Nothing
#' @title pgu.correlator
#'
#' @description
#' An R6 class that performs pairwise correlation on the pguIMP data set.
#'
#' @format [R6::R6Class] object.
#' @section Construction:
#' x <- pguIMP::pgu.correlator$new()
#'
#' @importFrom R6 R6Class
#' @importFrom magrittr %>%
#' @importFrom dplyr select select_if pull rename mutate everything
#' @importFrom tibble tibble as_tibble is_tibble rownames_to_column
#'
#' @importFrom stats cor.test
#' @examples
#' require(dplyr)
#' require(tibble)
#' data(iris)
#' data_df <- iris %>%
#' tibble::as_tibble() %>%
#' dplyr::select(-c("Species"))
#' correlator = pguIMP::pgu.correlator$new(data_df)
#' @author Sebastian Malkusch, \email{malkusch@@med.uni-frankfurt.de}
#' @export
#'
pgu.correlator <- R6::R6Class("pgu.correlator",
####################
# instance variables
####################
private = list(
.featureNames = "character",
.method = "character",
.r = "matrix",
.pPearson = "matrix",
.tau = "matrix",
.pKendall = "matrix",
.rho = "matrix",
.pSpearman = "matrix",
.abscissa = "character",
.ordinate = "character",
.test = "htest"
),
##################
# accessor methods
##################
active = list(
#' @field featureNames
#' Returns the instance variable featureNames.
#' (character)
featureNames = function(){
return(private$.featureNames)
},
#' @field setFeatureNames
#' Sets the instance variable featureNames.
#' It further initializes the instance variables:
#' intercept, pIntercept, slope, pSlope.
#' (character)
setFeatureNames = function(names = "character"){
private$.featureNames <- names
private$.r <- self$resetMatrix(value = 0)
private$.pPearson <- self$resetMatrix(value = 1)
private$.tau <- self$resetMatrix(value = 0)
private$.pKendall <- self$resetMatrix(value = 1)
private$.rho <- self$resetMatrix(value = 0)
private$.pSpearman <- self$resetMatrix(value = 1)
},
#' @field method
#' Returns the instance variable method.
#' (character)
method = function(){
return(private$.method)
},
#' @field r
#' Returns the instance variable r.
#' (matrix)
r = function(){
return(private$.r)
},
#' @field pPearson
#' Returns the instance variable pPearson.
#' (matrix)
pPearson = function(){
return(private$.pPearson)
},
#' @field tau
#' Returns the instance variable tau.
#' (matrix)
tau = function(){
return(private$.tau)
},
#' @field pKendall
#' Returns the instance variable pKendall.
#' (matrix)
pKendall = function(){
return(private$.pKendall)
},
#' @field rho
#' Returns the instance variable rho.
#' (matrix)
rho = function(){
return(private$.rho)
},
#' @field pSpearman
#' Returns the instance variable pSpearman.
#' (matrix)
pSpearman = function(){
return(private$.pSpearman)
},
#' @field abscissa
#' Returns the instance variable abscissa.
#' (character)
abscissa = function(){
return(private$.abscissa)
},
#' @field setAbscissa
#' Sets the instance variable abscicca to value.
setAbscissa = function(value = "character"){
private$.abscissa <- value
},
#' @field ordinate
#' Returns the instance variable ordinate.
#' (character)
ordinate = function(){
return(private$.ordinate)
},
#' @field setOrdinate
#' Sets the instance variable ordinate to value.
setOrdinate = function(value = "character"){
private$.ordinate <- value
},
#' @field test
#' Returns the instance variable test.
#' (stats::cor.test)
test = function(){
return(private$.test)
}
),
###################
# memory management
###################
public = list(
#' @description
#' Creates and returns a new `pgu.correlator` object.
#' @param data
#' The data to be modeled.
#' (tibble::tibble)
#' @return
#' A new `pgu.correlator` object.
#' (pguIMP::pgu.correlator)
initialize = function(data = "tbl_df"){
if(!tibble::is_tibble(data)){
data <- tibble::tibble(names <- "none",
values <- c(NA))
}
self$resetCorrelator(data)
},
#' @description
#' Clears the heap and
#' indicates if instance of `pgu.correlator` is removed from heap.
finalize = function(){
print("Instance of pgu.correlator removed from heap")
},
##########################
# print instance variables
##########################
#' @description
#' Prints instance variables of a `pgu.correlator` object.
#' @return
#' string
print = function(){
rString <- sprintf("\npgu.correlator\n")
cat(rString)
print(self$featureNames)
mString <- sprintf("\nmethod: %s\n", self$method[1])
cat(mString)
coefString <- sprintf("\nPearson's r:\n")
cat(coefString)
print(self$r)
pString <- sprintf("\nPearson's p-Value:\n")
cat(pString)
print(self$pPearson)
mString <- sprintf("\nmethod: %s\n", self$method[2])
cat(mString)
coefString <- sprintf("\nKendall's tau:\n")
cat(coefString)
print(self$tau)
pString <- sprintf("\nKendall's p-Value:\n")
cat(pString)
print(self$pKendall)
mString <- sprintf("\nmethod: %s\n", self$method[3])
cat(mString)
coefString <- sprintf("\nSpearman's rho:\n")
cat(coefString)
print(self$rho)
pString <- sprintf("\nSpearman's p-Value:\n")
cat(pString)
print(self$pPearson)
cat("\n\n")
invisible(self)
},#function
####################
# public functions #
####################
#' @description
#' Performes pair-wise correlation analysis on the attributes of the data frame.
#' Progresse is indicated by the progress object passed to the function.
#' @param data
#' Dataframe with at least two numeric attributes.
#' (tibble::tibble)
#' @param progress
#' Keeps track of the analysis progress.
#' (shiny::Progress)
resetCorrelator = function(data = "tbl_df", progress = "Progress"){
private$.featureNames <- data %>%
dplyr::select_if(is.numeric) %>%
colnames()
private$.method <- c("pearson", "kendall","spearman")
private$.r <- self$resetMatrix(value = 0)
private$.pPearson <- self$resetMatrix(value = 1)
private$.tau <- self$resetMatrix(value = 0)
private$.pKendall <- self$resetMatrix(value = 1)
private$.rho <- self$resetMatrix(value = 0)
private$.pSpearman <- self$resetMatrix(value = 1)
self$correlate(data, progress)
},#function
#' @description
#' Creates a square matrix which dimension corresponds to the length
#' of the instance variable featureNames. The matrix entries are set to a distict `value`.
#' @param value
#' The value the matrix entries are set to.
#' (numeric)
#' @return
#' A square matrix.
#' (matrix)
resetMatrix = function(value = "numeric"){
n = length(self$featureNames)
df <- matrix(data = value,
nrow = n,
ncol = n,
dimnames = list(self$featureNames, self$featureNames))
return(df)
},#function
####################
# helper functions #
####################
#' @description
#' Determines the numerical index of the column of an attribute based on the attribute name.
#' @param feature
#' The attribute's name.
#' (character)
#' @return
#' The attributes column index.
#' (numeric)
featureIdx = function(feature = "character"){
idx <- match(feature, self$featureNames)
if(is.na(idx)){
rString <- sprintf("\nWarning in pgu.correlator: feature %s is not known\n",
feature)
cat(rString)
}
return(idx)
},#function
#########################
# correlation functions #
#########################
#' @description
#' Creates a correlation test between two attributes of a dataframe.
#' The test is stored as instance variable.
#' @param abscissa
#' The abscissa values.
#' (numeric)
#' @param ordinate
#' The ordinate values.
#' (numeric)
#' @param method
#' The cname of the correlation test.
#' Valid coiced are defined by the instance variable `method`.
#' (chatacter)
calcCorrelationNumeric = function(abscissa = "numeric", ordinate = "numeric", method = "character"){
private$.test <- stats::cor.test(x = abscissa,
y = ordinate,
alternative = "two.sided",
exact = FALSE,
method = method)
},#function
#' @description
#' Performs the actual correlation test routine after Pearson.
#' Iteratively runs through the attributes known to the class
#' and calculates Pearson's correlation for each valid attribute pair.
#' The test results are stored in the instance variables:
#' r, pPearson.
#' Here, pX represents the p-value of the respective parameter X.
#' Displays the progress if shiny is loaded.
#' @param data
#' The data to be analysed.
#' (tibble::tibble)
#' @param progress
#' If shiny is loaded, the analysis' progress is stored within this instance of the shiny Progress class.
#' (shiny::Progress)
createCorrelationMatrixPearson = function(data = "tbl_df", progress = "Progress"){
for (abs in self$featureNames){
for (ord in self$featureNames){
if(("shiny" %in% (.packages())) & (class(progress)[1] == "Progress")){
progress$inc(1)
}#if
self$calcCorrelationNumeric(abscissa = data %>%
dplyr::pull(abs),
ordinate = data %>%
dplyr::pull(ord),
method = self$method[1])
private$.r[ord,abs] <-self$test$estimate[[1]]
private$.pPearson[ord, abs] <- self$test$p.value
}#for
}#for
},#function
#' @description
#' Performs the actual correlation test routine after Kendall.
#' Iteratively runs through the attributes known to the class
#' and calculates Kendall's correlation for each valid attribute pair.
#' The test results are stored in the instance variables:
#' tau, pKendall.
#' Here, pX represents the p-value of the respective parameter X.
#' Displays the progress if shiny is loaded.
#' @param data
#' The data to be analysed.
#' (tibble::tibble)
#' @param progress
#' If shiny is loaded, the analysis' progress is stored within this instance of the shiny Progress class.
#' (shiny::Progress)
createCorrelationMatrixKendall = function(data = "tbl_df", progress = "Progress"){
for (abs in self$featureNames){
for (ord in self$featureNames){
if(("shiny" %in% (.packages())) & (class(progress)[1] == "Progress")){
progress$inc(1)
}#if
self$calcCorrelationNumeric(abscissa = data %>%
dplyr::pull(abs),
ordinate = data %>%
dplyr::pull(ord),
method = self$method[2])
private$.tau[ord,abs] <-self$test$estimate[[1]]
private$.pKendall[ord, abs] <- self$test$p.value
}#for
}#for
},#function
#' @description
#' Performs the actual correlation test routine after Spearman.
#' Iteratively runs through the attributes known to the class
#' and calculates Spearman's correlation for each valid attribute pair.
#' The test results are stored in the instance variables:
#' rho, pSpearman.
#' Here, pX represents the p-value of the respective parameter X.
#' Displays the progress if shiny is loaded.
#' @param data
#' The data to be analysed.
#' (tibble::tibble)
#' @param progress
#' If shiny is loaded, the analysis' progress is stored within this instance of the shiny Progress class.
#' (shiny::Progress)
createCorrelationMatrixSpearman = function(data = "tbl_df", progress = "Progress"){
for (abs in self$featureNames){
for (ord in self$featureNames){
if(("shiny" %in% (.packages())) & (class(progress)[1] == "Progress")){
progress$inc(1)
}#if
self$calcCorrelationNumeric(abscissa = data %>%
dplyr::pull(abs),
ordinate = data %>%
dplyr::pull(ord),
method = self$method[3])
private$.rho[ord,abs] <-self$test$estimate[[1]]
private$.pSpearman[ord, abs] <- self$test$p.value
}#for
}#for
},#function
#' @description
#' Performs the all three correlation test routines defined
#' within the instance variable `method`.
#' Displays the progress if shiny is loaded.
#' @param data
#' The data to be analysed.
#' (tibble::tibble)
#' @param progress
#' If shiny is loaded, the analysis' progress is stored within this instance of the shiny Progress class.
#' (shiny::Progress)
correlate = function(data = "tbl_df", progress = "Progress"){
self$createCorrelationMatrixPearson(data, progress)
self$createCorrelationMatrixKendall(data, progress)
self$createCorrelationMatrixSpearman(data, progress)
},#function
###################
# print functions #
###################
#' @description
#' Transforms the results of the correlation procedure for a valid pair of attributes to a dataframe
#' and returns it.
#' @return
#' The analyis result as a dataframe.
#' (tibble::tibble)
printFeature = function(){
df <- data.frame(
abscissa = self$abscissa,
ordinate = self$ordinate,
r = self$r[self$ordinate, self$abscissa],
p.Pearson = self$pPearson[self$ordinate, self$abscissa],
tau = self$tau[self$ordinate, self$abscissa],
p.Kendall = self$pPearson[self$ordinate, self$abscissa],
rho = self$rho[self$ordinate, self$abscissa],
p.Spearman = self$pSpearman[self$ordinate, self$abscissa]) %>%
t() %>%
as.data.frame() %>%
tibble::rownames_to_column("correlation parameter") %>%
tibble::as_tibble() %>%
dplyr::rename(value = "V1")
return(df)
},#function
#' @description
#' Transfroms instance variable `r` to a dataframe and returns it.
#' @return
#' Dataframe of instance variable `r`.
#' (tibble::tibble)
printRTbl = function(){
self$r %>%
tibble::as_tibble() %>%
dplyr::mutate(features = self$featureNames) %>%
dplyr::select(features, dplyr::everything()) %>%
return()
},#function
#' @description
#' Transfroms instance variable `pPearson` to a dataframe and returns it.
#' @return
#' Dataframe of instance variable `pPearson`.
#' (tibble::tibble)
printPPearsonTbl = function(){
self$pPearson %>%
tibble::as_tibble() %>%
dplyr::mutate(features = self$featureNames) %>%
dplyr::select(features, dplyr::everything()) %>%
return()
},#function
#' @description
#' Transfroms instance variable `tau` to a dataframe and returns it.
#' @return
#' Dataframe of instance variable `tau`.
#' (tibble::tibble)
printTauTbl = function(){
self$tau %>%
tibble::as_tibble() %>%
dplyr::mutate(features = self$featureNames) %>%
dplyr::select(features, dplyr::everything()) %>%
return()
},#function
#' @description
#' Transfroms instance variable `pKendall` to a dataframe and returns it.
#' @return
#' Dataframe of instance variable `pKendall`.
#' (tibble::tibble)
printPKendallTbl = function(){
self$pKendall %>%
tibble::as_tibble() %>%
dplyr::mutate(features = self$featureNames) %>%
dplyr::select(features, dplyr::everything()) %>%
return()
},#function
#' @description
#' Transfroms instance variable `rho` to a dataframe and returns it.
#' @return
#' Dataframe of instance variable `rho`.
#' (tibble::tibble)
printRhoTbl = function(){
self$rho %>%
tibble::as_tibble() %>%
dplyr::mutate(features = self$featureNames) %>%
dplyr::select(features, dplyr::everything()) %>%
return()
},#function
#' @description
#' Transfroms instance variable `pSpearman` to a dataframe and returns it.
#' @return
#' Dataframe of instance variable `pSpearman`.
#' (tibble::tibble)
printPSpearmanTbl = function(){
self$pSpearman %>%
tibble::as_tibble() %>%
dplyr::mutate(features = self$featureNames) %>%
dplyr::select(features, dplyr::everything()) %>%
return()
}#function
)#public
)#Class
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.