/
fviz_add.R
109 lines (99 loc) · 3.92 KB
/
fviz_add.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
#' Add supplementary data to a plot
#'
#' @description
#' Add supplementary data to a plot
#'
#' @param ggp a ggplot2 plot.
#' @param df a data frame containing the x and y coordinates
#' @param axes a numeric vector of length 2 specifying the components to be plotted.
#' @param geom a character specifying the geometry to be used for the graph
#' Allowed values are "point" or "arrow" or "text"
#' @param color the color to be used
#' @param addlabel a logical value. If TRUE, labels are added
#' @param labelsize the size of labels. Default value is 4
#' @param pointsize the size of points
#' @param shape point shape when geom ="point"
#' @param linetype the linetype to be used when geom ="arrow"
#' @param repel a boolean, whether to use ggrepel to avoid overplotting text
#' labels or not.
#' @param font.family character vector specifying font family.
#' @param ... Additional arguments, not used
#' @return a ggplot2 plot
#' @author Alboukadel Kassambara \email{alboukadel.kassambara@@gmail.com}
#' @references http://www.sthda.com
#' @examples
#' \donttest{
#' # Principal component analysis
#' data(decathlon2)
#' decathlon2.active <- decathlon2[1:23, 1:10]
#' res.pca <- prcomp(decathlon2.active, scale = TRUE)
#'
#' # Visualize variables
#' p <- fviz_pca_var(res.pca)
#' print(p)
#'
#' # Add supplementary variables
#' coord <- data.frame(PC1 = c(-0.7, 0.9), PC2 = c(0.25, -0.07))
#' rownames(coord) <- c("Rank", "Points")
#' print(coord)
#' fviz_add(p, coord, color ="blue", geom="arrow")
#' }
#'
#' @export
fviz_add <- function(ggp, df, axes = c(1,2), geom=c("point", "arrow"), color ="blue",
addlabel = TRUE, labelsize = 4, pointsize = 2, shape=19, linetype ="dashed",
repel = FALSE, font.family = "", ...)
{
# Deprecated arguments
extra_args <- list(...)
if (!is.null(extra_args$jitter)) {
warning("argument jitter is deprecated; please use repel = TRUE instead, to avoid overlapping of labels.",
call. = FALSE)
if(!is.null(extra_args$jitter$width) | !is.null(extra_args$jitter$height) ) repel = TRUE
}
if(!inherits(df, c("data.frame", "matrix")))
stop("df should be a data frame or a matrix")
if(!inherits(df, "data.frame")) df <- as.data.frame(df)
if(ncol(df) < 2)
stop("df should have at least two columns (x and y coordinates)")
if(length(intersect(geom, c("point", "arrow", "text"))) == 0)
stop("The specified value(s) for the argument geom are not allowed ")
if(is.null(df$name)) df$name <- rownames(df)
if(is.null(df$x)) df$x <- df[,axes[1]]
if(is.null(df$y)) df$y <- df[,axes[2]]
# Plot
#%%%%%%%%%%%%%%%%%%%%%%
hjust <- vjust <- 0.5
if("point" %in% geom) {
p <- ggp + ggpubr::geom_exec(geom_point, data = df, x = "x", y = "y",
color = color, shape = shape, size = pointsize)
vjust <- -0.7
}
else if("arrow" %in% geom){
p <- ggp + geom_segment(data = df,
aes_string(x = 0, y = 0, xend = 'x', yend = 'y'),
arrow = grid::arrow(length = grid::unit(0.2, 'cm')),
color=color, linetype=linetype)
hjust <- 0.8
vjust <- 0
}
else if("text" %in% geom) {
vjust <- -0.7
p <- ggp
}
if(addlabel | "text" %in% geom){
if(repel){
p <- p + ggpubr::geom_exec(ggrepel::geom_text_repel, data = df, x = "x", y = "y",
label = "name", color = color, size = labelsize,
family = font.family)
}
else{
p <- p + ggpubr::geom_exec(geom_text, data = df, x = "x", y = "y",
label = "name", color = color, size = labelsize,
vjust=vjust, hjust = hjust, family = font.family)
# p <- p + geom_text(data = df, aes_string("x", "y"), color = color,
# label = df$name, size = labelsize, vjust=vjust, hjust = hjust)
}
}
return(p)
}