# This file is a generated template, your changes will not be overwritten
#' @importFrom psych polychoric
#' @importFrom ShinyItemAnalysis plot_corr
#' @importFrom stats hclust
#' @importFrom stats cor
#' @import ggplot2
#' @import ggdendro
#' @import psych
#' @import ShinyItemAnalysis
#' @importFrom ggdendro ggdendrogram
#' @export
corClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class(
"corClass",
inherit = corBase,
private = list(
#------------------------------------
.init = function() {
if (is.null(self$data) | is.null(self$options$vars)) {
self$results$instructions$setVisible(visible = TRUE)
}
self$results$instructions$setContent(
"<html>
<head>
</head>
<body>
<div class='instructions'>
<p>____________________________________________________________________________________</p>
<p> 1. Computes and visualizes an item correlation matrix, offering several correlation types and clustering methods.</p>
<p> 2. The heatmap is estimated by using <b>ShinyItemAnalysis::plot_corr</b> function.</p>
<p> 3. When clustering method is <b>none</b>, dendrogram will not be drawn.</p>
<p> 4. Feature requests and bug reports can be made on the <a href='https://github.com/hyunsooseol/seolmatrix/issues' target = '_blank'>GitHub</a>.</p>
<p>____________________________________________________________________________________</p>
</div>
</body>
</html>"
)
if(isTRUE(self$options$plot)){
width <- self$options$width
height <- self$options$height
self$results$plot$setSize(width, height)
}
if(isTRUE(self$options$plot1)){
width <- self$options$width5
height <- self$options$height5
self$results$plot1$setSize(width, height)
}
if(isTRUE(self$options$plot2)){
width <- self$options$width4
height <- self$options$height4
self$results$plot2$setSize(width, height)
}
if(isTRUE(self$options$plot3)){
width <- self$options$width3
height <- self$options$height3
self$results$plot3$setSize(width, height)
}
},
.run = function() {
if (is.null(self$options$vars))
return()
vars <- self$options$vars
# get the data
data <- self$data
data <- na.omit(data)
# pearson and spearman correlation------
mat<- stats::cor(data, method = self$options$type)
mat1 <- as.dist(1-mat)
# heatmap plot----------
image <- self$results$plot
image$setState(mat)
# dendrogram plot-------
if(!self$options$method=='none'){
image <- self$results$plot1
image$setState(mat1)
}
if(isTRUE(self$options$poly)){
#Polychoric correlation------
corP <- psych::polychoric(data)
dis <- as.dist(1-corP$rho)
# Polychoric heatmap plot---------
image <- self$results$plot2
image$setState(data)
# Polychoric dendrogram plot---------
if(!self$options$method=='none'){
image <- self$results$plot3
image$setState(dis)
}
}
},
.plot = function(image, ggtheme, theme, ...) {
if (is.null(image$state))
return(FALSE)
mat<- image$state
plot <- ShinyItemAnalysis::plot_corr(mat,
cor=self$options$type,
clust_method = self$options$method,
n_clust=self$options$k,
labels_size = self$options$size,
line_col = "red",
line_size = 1.5, labels = TRUE)
print(plot)
TRUE
},
.plot1 = function(image, ggtheme, theme, ...) {
if (is.null(image$state))
return(FALSE)
mat1 <- image$state
hc <- stats::hclust(mat1, method = self$options$method)
if(self$options$horiz == TRUE){
plot1<- ggdendro::ggdendrogram(hc, rotate=TRUE)
} else {
plot1<- ggdendro::ggdendrogram(hc)
}
print(plot1)
TRUE
},
.plot2 = function(image, ggtheme, theme, ...) {
if (is.null(image$state))
return(FALSE)
data<- image$state
plot2 <- ShinyItemAnalysis::plot_corr(data,
cor='polychoric',
clust_method = self$options$method,
n_clust=self$options$k,
labels_size = self$options$size,
line_col = "red",
line_size = 1.5, labels = TRUE)
print(plot2)
TRUE
},
.plot3 = function(image, ggtheme, theme, ...) {
if (is.null(image$state))
return(FALSE)
dis <- image$state
hc <- stats::hclust(dis, method = self$options$method)
if(self$options$horiz1 == TRUE){
plot3<- ggdendro::ggdendrogram(hc, rotate=TRUE)
} else {
plot3<- ggdendro::ggdendrogram(hc)
}
print(plot3)
TRUE
}
)
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.