Skip to content

Commit

Permalink
add directed params for network
Browse files Browse the repository at this point in the history
  • Loading branch information
Hy4m committed Mar 19, 2020
1 parent a78774d commit 2e3f892
Show file tree
Hide file tree
Showing 10 changed files with 90 additions and 60 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: ggcor
Type: Package
Title: Extended tools for correlation analysis and visualization
Version: 0.9.4.2
Version: 0.9.4.3
Authors@R: c(
person("Houyun", "Huang", email = "[email protected]", role = c("aut", "cre")),
person("Lei", "Zhou", email = "[email protected]", role = "aut"),
Expand Down
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -290,6 +290,7 @@ importFrom(grid,unit)
importFrom(igraph,as.igraph)
importFrom(igraph,as_data_frame)
importFrom(igraph,graph_from_data_frame)
importFrom(igraph,is.directed)
importFrom(purrr,map)
importFrom(purrr,map2)
importFrom(purrr,map_chr)
Expand Down
37 changes: 21 additions & 16 deletions R/as-cor-network.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
#' Coerce to a cor_network object
#' @description Functions to coerce a object to cor_network if possible.
#' @param x any \code{R} object.
#' @param directed logical value, whether or not to create a directed graph.
#' @param simplify logical value (defaults to TRUE) indicating whether to
#' delete nodes without edge connections.
#' @param weight NULL (default) or name of column in edges which will be renamed
Expand All @@ -27,6 +28,7 @@ as_cor_network <- function(x, ...) {
#' @export
#' @method as_cor_network cor_tbl
as_cor_network.cor_tbl <- function(x,
directed = FALSE,
simplify = TRUE,
weight = NULL,
r.thres = 0.6,
Expand Down Expand Up @@ -80,57 +82,60 @@ as_cor_network.cor_tbl <- function(x,
edges <- dplyr::rename(edges, weight = !!weight)
}

structure(.Data = list(nodes = nodes,
edges = edges), class = "cor_network")
structure(.Data = list(nodes = nodes, edges = edges),
directed = directed, class = "cor_network")
}

#' @rdname as_cor_network
#' @export
#' @method as_cor_network mantel_tbl
as_cor_network.mantel_tbl <- function(x, ...) {
as_cor_network(as_cor_tbl(x), ...)
as_cor_network.mantel_tbl <- function(x, directed = FALSE, ...) {
as_cor_network(as_cor_tbl(x), directed = directed, ...)
}

#' @rdname as_cor_network
#' @export
#' @method as_cor_network matrix
as_cor_network.matrix <- function(x, ...) {
cor_network(corr = x, ..., val.type = "list")
as_cor_network.matrix <- function(x, directed = FALSE, ...) {
cor_network(corr = x, directed = directed, ..., val.type = "list")
}
#' @rdname as_cor_network
#' @export
#' @method as_cor_network data.frame
as_cor_network.data.frame <- function(x, ...) {
cor_network(corr = x, ..., val.type = "list")
as_cor_network.data.frame <- function(x, directed = FALSE, ...) {
cor_network(corr = x, directed = directed, ..., val.type = "list")
}

#' @rdname as_cor_network
#' @export
#' @method as_cor_network correlate
as_cor_network.correlate <- function(x, ...) {
cor_network(corr = x$r, p.value = x$p.value, ..., val.type = "list")
as_cor_network.correlate <- function(x, directed = FALSE, ...) {
cor_network(corr = x$r, p.value = x$p.value, directed = directed, ...,
val.type = "list")
}

#' @rdname as_cor_network
#' @export
#' @method as_cor_network rcorr
as_cor_network.rcorr <- function(x, ...)
as_cor_network.rcorr <- function(x, directed = FALSE, ...)
{
p.value <- x$P
diag(p.value) <- 0
cor_network(corr = x$r, p.value = p.value, ..., val.type = "list")
cor_network(corr = x$r, p.value = p.value, directed = directed, ...,
val.type = "list")
}

#' @rdname as_cor_network
#' @export
#' @method as_cor_network corr.test
as_cor_network.corr.test <- function(x, ...)
as_cor_network.corr.test <- function(x, directed = FALSE, ...)
{
cor_network(corr = x$r, p.value = x$p, ..., val.type = "list")
cor_network(corr = x$r, p.value = x$p, directed = directed, ...,
val.type = "list")
}

#' @importFrom tibble as_tibble
#' @importFrom igraph as_data_frame
#' @importFrom igraph as_data_frame is.directed
#' @rdname as_cor_network
#' @export
#' @method as_cor_network igraph
Expand All @@ -139,7 +144,7 @@ as_cor_network.igraph <- function(x, ...)
nodes <- tibble::as_tibble(igraph::as_data_frame(x, "vertices"))
edges <- tibble::as_tibble(igraph::as_data_frame(x, "edges"))
structure(.Data = list(nodes = nodes, edges = edges),
class = "cor_network")
directed = igraph::is.directed(x), class = "cor_network")
}

#' @rdname as_cor_network
Expand Down
28 changes: 16 additions & 12 deletions R/as-igraph.R
Original file line number Diff line number Diff line change
@@ -1,54 +1,58 @@
#' Corece to a igraph object
#' @description Functions to coerce a object to igraph if possible.
#' @param x \code{R} object.
#' @param directed logical value, whether or not to create a directed graph.
#' @param ... extra params.
#' @return igraph object.
#' @importFrom igraph graph_from_data_frame as.igraph
#' @rdname as_igraph
#' @examples
#' fortify_cor(mtcars) %>% as.igraph()
#' correlate(mtcars, cor.test = TRUE) %>% as.igraph()
#' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei
#' @export
as.igraph.cor_tbl <- function(x, ...)
as.igraph.cor_tbl <- function(x, directed = FALSE, ...)
{
x <- as_cor_network(x, ...)
igraph::graph_from_data_frame(x$edges, directed = FALSE,
igraph::graph_from_data_frame(x$edges, directed = directed,
vertices = x$nodes)
}

#' @rdname as_igraph
#' @export
as.igraph.mantel_tbl <- function(x, ...)
as.igraph.mantel_tbl <- function(x, directed = FALSE, ...)
{
as.igraph(as_cor_tbl(x), ...)
as.igraph(as_cor_tbl(x), directed = directed, ...)
}

#' @rdname as_igraph
#' @importFrom tidygraph tbl_graph
#' @export
as.igraph.rcorr <- function(x, ...)
as.igraph.rcorr <- function(x, directed = FALSE, ...)
{
p.value <- x$P
diag(p.value) <- 0
cor_network(x$r, p.value, ..., val.type = "igraph")
cor_network(x$r, p.value, directed = directed, ..., val.type = "igraph")
}

#' @rdname as_igraph
#' @export
as.igraph.corr.test <- function(x, ...)
as.igraph.corr.test <- function(x, directed = FALSE, ...)
{
cor_network(x$r, x$p, ..., val.type = "igraph")
cor_network(x$r, x$p, directed = directed, ..., val.type = "igraph")
}

#' @rdname as_igraph
#' @export
as.igraph.correlate <- function(x, ...)
as.igraph.correlate <- function(x, directed = FALSE, ...)
{
cor_network(x$r, x$p.value, ..., val.type = "igraph")
cor_network(x$r, x$p.value, directed = directed, ..., val.type = "igraph")
}

#' @importFrom igraph graph_from_data_frame
#' @rdname as_igraph
#' @export
as.igraph.cor_network <- function(x, ...)
as.igraph.cor_network <- function(x, directed = FALSE, ...)
{
igraph::graph_from_data_frame(x$edges, FALSE, x$nodes)
igraph::graph_from_data_frame(x$edges, directed, x$nodes)
}
25 changes: 14 additions & 11 deletions R/as-tbl-graph.R
Original file line number Diff line number Diff line change
@@ -1,54 +1,57 @@
#' Corece to a graph_tbl object
#' @description Functions to coerce a object to graph_tbl if possible.
#' @param x \code{R} object.
#' @param directed logical value, whether or not to create a directed graph.
#' @param ... extra params.
#' @return tbl_graph object.
#' @importFrom tidygraph tbl_graph as_tbl_graph
#' @rdname as_tbl_graph
#' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei
#' @export
as_tbl_graph.cor_tbl <- function(x, ...)
as_tbl_graph.cor_tbl <- function(x, directed = FALSE, ...)
{
x <- as_cor_network(x, ...)
tidygraph::tbl_graph(nodes = x$nodes,
edges = x$edges, directed = FALSE)
edges = x$edges, directed = directed)
}


#' @rdname as_tbl_graph
#' @export
as_tbl_graph.mantel_tbl <- function(x, ...)
as_tbl_graph.mantel_tbl <- function(x, directed = FALSE, ...)
{
as_tbl_graph(as_cor_tbl(x), ...)
as_tbl_graph(as_cor_tbl(x), directed = directed, ...)
}

#' @rdname as_tbl_graph
#' @export
as_tbl_graph.rcorr <- function(x, ...)
as_tbl_graph.rcorr <- function(x, directed = FALSE, ...)
{
p.value <- x$P
diag(p.value) <- 0
cor_network(x$r, p.value, ..., val.type = "tbl_graph")
cor_network(x$r, p.value, directed = directed, ..., val.type = "tbl_graph")
}

#' @rdname as_tbl_graph
#' @export
as_tbl_graph.corr.test <- function(x, ...)
as_tbl_graph.corr.test <- function(x, directed = FALSE, ...)
{
cor_network(x$r, x$p, ..., val.type = "tbl_graph")
cor_network(x$r, x$p, directed = directed, ..., val.type = "tbl_graph")
}

#' @rdname as_tbl_graph
#' @export
as_tbl_graph.correlate <- function(x, ...)
as_tbl_graph.correlate <- function(x, directed = FALSE, ...)
{
cor_network(x$r, x$p.value, ..., val.type = "tbl_graph")
cor_network(x$r, x$p.value, directed = directed, ..., val.type = "tbl_graph")
}

#' @importFrom tidygraph tbl_graph
#' @rdname as_tbl_graph
#' @export
as_tbl_graph.cor_network <- function(x, ...)
{
tidygraph::tbl_graph(nodes = x$nodes, edges = x$edges, directed = FALSE)
directed <- attr(x, "directed")
tidygraph::tbl_graph(nodes = x$nodes, edges = x$edges,
directed = directed %||% FALSE)
}
9 changes: 6 additions & 3 deletions R/cor-network.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
#' @param x a cor_network object.
#' @param corr correlation matrix.
#' @param p.value significant matrix of correlation.
#' @param directed logical value, whether or not to create a directed graph.
#' @param row.names,col.names row and column names of correlation matrix.
#' @param rm.dup logical (defaults to TRUE) indicating whether remove duplicate
#' rows. If TRUE, the correlation between A-B and B-A is retained only A-B.
Expand Down Expand Up @@ -44,6 +45,7 @@
#' @export
cor_network <- function(corr,
p.value = NULL,
directed = FALSE,
row.names = NULL,
col.names = NULL,
rm.dup = TRUE,
Expand Down Expand Up @@ -107,9 +109,10 @@ cor_network <- function(corr,
}

switch (val.type,
tbl_graph = tidygraph::tbl_graph(nodes = nodes, edges = edges, directed = FALSE),
igraph = igraph::graph_from_data_frame(edges, directed = FALSE, vertices = nodes),
list = structure(.Data = list(nodes = nodes, edges = edges), class = "cor_network")
tbl_graph = tidygraph::tbl_graph(nodes = nodes, edges = edges, directed = directed),
igraph = igraph::graph_from_data_frame(edges, directed = directed, vertices = nodes),
list = structure(.Data = list(nodes = nodes, edges = edges),
directed = directed, class = "cor_network")
)
}

Expand Down
15 changes: 9 additions & 6 deletions man/as_cor_network.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

18 changes: 12 additions & 6 deletions man/as_igraph.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

12 changes: 7 additions & 5 deletions man/as_tbl_graph.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

0 comments on commit 2e3f892

Please sign in to comment.