-
Notifications
You must be signed in to change notification settings - Fork 1
/
gg_matrix.R
119 lines (97 loc) · 3.78 KB
/
gg_matrix.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
#' Plot a connectivity or a nodes-by-edges matrix
#'
#' @description
#' Plots an connectivity or a nodes-by-edges matrix.
#'
#' @param x a `matrix` object. An adjacency or nodes-by-edges matrix.
#'
#' @param title a `character` of length 1. The caption of the figure.
#'
#' @return A `ggplot2` object.
#'
#' @export
#'
#' @examples
#' library("chessboard")
#'
#' # Import Adour sites ----
#' path_to_file <- system.file("extdata", "adour_survey_sampling.csv",
#' package = "chessboard")
#' adour_sites <- read.csv(path_to_file)
#'
#' # Select first location ----
#' #adour_sites <- adour_sites[adour_sites$"location" == 1, ]
#'
#' # Create node labels ----
#' adour_nodes <- create_node_labels(data = adour_sites,
#' location = "location",
#' transect = "transect",
#' quadrat = "quadrat")
#'
#' # Find edges with 1 degree of neighborhood (queen method) ----
#' adour_edges <- create_edge_list(adour_nodes, method = "queen",
#' directed = FALSE)
#'
#' # Get connectivity matrix ----
#' adour_con_matrix <- connectivity_matrix(adour_edges)
#'
#' # Visualize matrix ----
#' gg_matrix(adour_con_matrix, title = "Connectivity matrix") +
#' ggplot2::theme(axis.text = ggplot2::element_text(size = 6))
gg_matrix <- function(x, title) {
## Check 'x' argument ----
if (missing(x)) {
stop("Argument 'x' is required", call. = FALSE)
}
if (!is.matrix(x)) {
stop("Argument 'x' must be a matrix (connectivity or nodes-by-edges ",
"matrix)", call. = FALSE)
}
if (!is.numeric(x)) {
stop("Argument 'x' must be a numeric matrix (connectivity or ",
"nodes-by-edges matrix)", call. = FALSE)
}
## Check title argument ----
if (missing(title)) title <- ""
if (!is.character(title) || length(title) != 1) {
stop("Argument 'title' must be a character of length 1", call. = FALSE)
}
## Prepare to pivot ----
x <- ifelse(is.na(x), 0, x)
if (length(unique(as.vector(x))) > 2) {
stop("This function only works on binary matrix", call. = FALSE)
}
x <- as.data.frame(x)
x <- data.frame("from" = rownames(x), x)
rownames(x) <- NULL
colnames(x) <- gsub("\\.", "-", colnames(x))
colnames(x) <- gsub("X", "", colnames(x))
## Pivot to longer format ----
x <- tidyr::pivot_longer(x, cols = -1, names_to = "to", values_to = "edge")
x <- as.data.frame(x)
## Order data ----
nodes <- sort(unique(x$"from"))
edges <- sort(unique(x$"to"))
x$"edge" <- factor(x$"edge", levels = c(0, 1))
x$"from" <- factor(x$"from", levels = rev(nodes))
x$"to" <- factor(x$"to", levels = edges)
ggplot2::ggplot(data = x) +
ggplot2::geom_tile(ggplot2::aes(.data$to, .data$from, fill = .data$edge),
color = "lightgray") +
ggplot2::scale_fill_manual(values = c(`0` = "transparent",
`1` = "black")) +
ggplot2::coord_fixed() +
ggplot2::xlab("") + ggplot2::ylab("") +
ggplot2::scale_x_discrete(position = "top") +
ggplot2::theme_classic() +
ggplot2::labs(caption = title) +
ggplot2::theme(legend.position = "none",
axis.line = ggplot2::element_blank(),
axis.ticks = ggplot2::element_blank(),
axis.text = ggplot2::element_text(family = "serif"),
axis.text.x = ggplot2::element_text(angle = 90,
vjust = 1,
hjust = 0),
plot.caption = ggplot2::element_text(family = "serif",
size = 11))
}