Skip to content

Commit

Permalink
Added directed graph centrality analysis
Browse files Browse the repository at this point in the history
  • Loading branch information
@hyunsooseol
hyunsooseol committed Oct 8, 2024
1 parent e056064 commit 2932b67
Show file tree
Hide file tree
Showing 17 changed files with 777 additions and 285 deletions.
8 changes: 4 additions & 4 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,13 +1,13 @@
Package: seolmatrix
Type: Package
Title: Correlations suite for jamovi
Version: 3.9.6
Date: 2024-10-01
Version: 3.9.7
Date: 2024-10-08
Author: Hyunsoo Seol
Maintainer: Hyunsoo Seol <[email protected]>
Description: This module is a tool for calculating correlations such as Person, Partial,
Tetrachoric, Polychoric, Spearman, Intraclass correlation, Rater Reliability, Generalizability Theory, Fleiss Kappa, Bootstrap agreement, Multilevel correlation, Concordance correlation, Analytic Hierarchy Process, Correlation structure, Repeated and Cross correlation, and allows users to produce
Gaussian Graphical Model and Partial plot.
Tetrachoric, Polychoric, Spearman, Intraclass correlation, Rater Reliability, Generalizability Theory, Fleiss Kappa, Bootstrap agreement, Multilevel correlation, Concordance correlation, Analytic Hierarchy Process, Correlation structure, Repeated and Cross correlation, Directed Graph Centrality and allows users to
produce Network plots.
License: GPL (>= 2)
Encoding: UTF-8
LazyData: true
Expand Down
2 changes: 1 addition & 1 deletion R/00jmv.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@
`author`="Seol, H.",
`year`=2024,
`title`="seolmatrix: Correlations suite for jamovi",
`publisher`="(Version 3.9.6) [jamovi module]. URL https://github.com/hyunsooseol/seolmatrix",
`publisher`="(Version 3.9.7) [jamovi module]. URL https://github.com/hyunsooseol/seolmatrix",
`url`="https://github.com/hyunsooseol/seolmatrix"),
`psych`=list(
`type`="software",
Expand Down
129 changes: 129 additions & 0 deletions R/network.b.R
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,129 @@

# This file is a generated template, your changes will not be overwritten
#' @importFrom qgraph qgraph
#' @importFrom RColorBrewer brewer.pal
#' @export
networkClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class(
"networkClass",
inherit = networkBase,
private = list(
.htmlwidget = NULL,

.init = function() {
private$.htmlwidget <- HTMLWidget$new()

if (is.null(self$data) | is.null(self$options$vars) | is.null(self$options$labels)) {
self$results$instructions$setVisible(visible = TRUE)

}

self$results$instructions$setContent(
private$.htmlwidget$generate_accordion(
title="Instructions",
content = paste(
'<div style="border: 2px solid #e6f4fe; border-radius: 15px; padding: 15px; background-color: #e6f4fe; margin-top: 10px;">',
'<div style="text-align:justify;">',
'<ul>',
'<li>Directed graph centrality based on <b>qgraph</b> R package.</li>',
'<li>Undirected graph centrality is provided by the Partial correlation analysis in seolmatrix.</li>',
'<li>Feature requests and bug reports can be made on my <a href="https://github.com/hyunsooseol/seolmatrix/issues" target="_blank">GitHub</a>.</li>',
'</ul></div></div>'

)

)
)

if(isTRUE(self$options$plot)){

width <- self$options$width
height <- self$options$height
self$results$plot$setSize(width, height)
}

},
#######################################
.run = function() {

if (is.null(self$options$labels)) return()

if (!is.null(self$options$vars)) {

vars <- self$options$vars
data <- self$data
data <- jmvcore::naOmit(data)

if ( ! is.null(self$options$labels)) {

rownames(data) <- data[[self$options$labels]]
data[[self$options$labels]] <- NULL

}

for (i in seq_along(vars))
data[[i]] <- jmvcore::toNumeric(data[[i]])

# Data handling---
mat <- as.matrix(data)
weight_matrix <- apply(mat, 2, as.numeric)


# Centrality Table---
res <- qgraph::centrality_auto(weight_matrix)
cen<- res[["node.centrality"]]

table <- self$results$cen

for (i in seq_along(vars)) {

row <- list()

row[["bet"]] <- cen[i, 1]
row[["clo"]] <- cen[i, 2]
row[["ind"]] <- cen[i, 3]
row[["out"]] <- cen[i, 4]
row[["outex"]] <- cen[i, 5]
row[["inex"]] <- cen[i, 6]

table$setRow(rowKey = vars[i], values = row)
}

if(isTRUE(self$options$plot)){
# qgraph---
image <- self$results$plot
image$setState(weight_matrix)
}
}
},

.plot = function(image, ...) {

if(is.null(self$options$labels)) return()

mat<- image$state

node_colors <- RColorBrewer::brewer.pal(n = nrow(mat), name = "Set3")

# g <- igraph::graph_from_adjacency_matrix(mat, mode="directed")
# node_degrees <- igraph::degree(g)
# node_sizes <- node_degrees * 2
#
# label_size <- 1 + (node_degrees / max(node_degrees))

# Calculate node sizes based on label length
#label_lengths <- nchar(self$options$labels)
#node_sizes <- label_lengths * 2 # Adjust the multiplier as needed

plot<- qgraph::qgraph(mat,
labels=self$optios$labels,
directed=TRUE,
edge.color="black",
#vsize=node_sizes,
#label.cex=1,
color=node_colors)

print(plot)
TRUE

})
)
229 changes: 229 additions & 0 deletions R/network.h.R
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,229 @@

# This file is automatically generated, you probably don't want to edit this

networkOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"networkOptions",
inherit = jmvcore::Options,
public = list(
initialize = function(
labels = NULL,
vars = NULL,
cen = TRUE,
plot = FALSE,
width = 500,
height = 500, ...) {

super$initialize(
package="seolmatrix",
name="network",
requiresData=TRUE,
...)

private$..labels <- jmvcore::OptionVariable$new(
"labels",
labels,
suggested=list(
"nominal"),
permitted=list(
"id",
"factor"))
private$..vars <- jmvcore::OptionVariables$new(
"vars",
vars)
private$..cen <- jmvcore::OptionBool$new(
"cen",
cen,
default=TRUE)
private$..plot <- jmvcore::OptionBool$new(
"plot",
plot,
default=FALSE)
private$..width <- jmvcore::OptionInteger$new(
"width",
width,
default=500)
private$..height <- jmvcore::OptionInteger$new(
"height",
height,
default=500)

self$.addOption(private$..labels)
self$.addOption(private$..vars)
self$.addOption(private$..cen)
self$.addOption(private$..plot)
self$.addOption(private$..width)
self$.addOption(private$..height)
}),
active = list(
labels = function() private$..labels$value,
vars = function() private$..vars$value,
cen = function() private$..cen$value,
plot = function() private$..plot$value,
width = function() private$..width$value,
height = function() private$..height$value),
private = list(
..labels = NA,
..vars = NA,
..cen = NA,
..plot = NA,
..width = NA,
..height = NA)
)

networkResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"networkResults",
inherit = jmvcore::Group,
active = list(
instructions = function() private$.items[["instructions"]],
text = function() private$.items[["text"]],
cen = function() private$.items[["cen"]],
plot = function() private$.items[["plot"]]),
private = list(),
public=list(
initialize=function(options) {
super$initialize(
options=options,
name="",
title="Directed Graph Centrality",
refs="seolmatrix")
self$add(jmvcore::Html$new(
options=options,
name="instructions",
title="Instructions",
visible=TRUE))
self$add(jmvcore::Preformatted$new(
options=options,
name="text",
title=""))
self$add(jmvcore::Table$new(
options=options,
name="cen",
title="Centrality",
visible="(cen)",
rows="(vars)",
clearWith=list(
"vars",
"labels"),
refs="qgraph",
columns=list(
list(
`name`="name",
`title`="",
`type`="text",
`content`="($key)"),
list(
`name`="bet",
`title`="Betweenness"),
list(
`name`="clo",
`title`="Closeness"),
list(
`name`="ind",
`title`="InDegree"),
list(
`name`="out",
`title`="OutDegree"),
list(
`name`="outex",
`title`="OutExpectedInfluence"),
list(
`name`="inex",
`title`="InExpectedInfluence"))))
self$add(jmvcore::Image$new(
options=options,
name="plot",
title="Directed Graph Centrality",
requiresData=TRUE,
visible="(plot)",
renderFun=".plot",
refs="qgraph",
clearWith=list(
"vars",
"labels",
"width",
"height")))}))

networkBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"networkBase",
inherit = jmvcore::Analysis,
public = list(
initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
super$initialize(
package = "seolmatrix",
name = "network",
version = c(1,0,0),
options = options,
results = networkResults$new(options=options),
data = data,
datasetId = datasetId,
analysisId = analysisId,
revision = revision,
pause = NULL,
completeWhenFilled = FALSE,
requiresMissings = FALSE,
weightsSupport = 'auto')
}))

#' Directed Graph Centrality
#'
#'
#' @param data The data as a data frame.
#' @param labels .
#' @param vars .
#' @param cen .
#' @param plot .
#' @param width .
#' @param height .
#' @return A results object containing:
#' \tabular{llllll}{
#' \code{results$instructions} \tab \tab \tab \tab \tab a html \cr
#' \code{results$text} \tab \tab \tab \tab \tab a preformatted \cr
#' \code{results$cen} \tab \tab \tab \tab \tab a table \cr
#' \code{results$plot} \tab \tab \tab \tab \tab an image \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$cen$asDF}
#'
#' \code{as.data.frame(results$cen)}
#'
#' @export
network <- function(
data,
labels,
vars,
cen = TRUE,
plot = FALSE,
width = 500,
height = 500) {

if ( ! requireNamespace("jmvcore", quietly=TRUE))
stop("network requires jmvcore to be installed (restart may be required)")

if ( ! missing(labels)) labels <- jmvcore::resolveQuo(jmvcore::enquo(labels))
if ( ! missing(vars)) vars <- jmvcore::resolveQuo(jmvcore::enquo(vars))
if (missing(data))
data <- jmvcore::marshalData(
parent.frame(),
`if`( ! missing(labels), labels, NULL),
`if`( ! missing(vars), vars, NULL))


options <- networkOptions$new(
labels = labels,
vars = vars,
cen = cen,
plot = plot,
width = width,
height = height)

analysis <- networkClass$new(
options = options,
data = data)

analysis$run()

analysis$results
}

Loading

0 comments on commit 2932b67

Please sign in to comment.