是的,我们可以为ggplot设计一个新的geom,然后将它与ggbiplot一起使用。 这是一个新的geom,将做凸壳:
library(ggplot2)
StatBag
compute_group = function(data, scales, prop = 0.5) {
#################################
#################################
# originally from aplpack package, plotting functions removed
plothulls_
col.hull, lty.hull, lwd.hull, density=0, ...){
# function for data peeling:
# x,y : data
# fraction.in.inner.hull : max percentage of points within the hull to be drawn
# n.hull : number of hulls to be plotted (if there is no fractiion argument)
# col.hull, lty.hull, lwd.hull : style of hull line
# plotting bits have been removed, BM 160321
# pw 130524
if(ncol(x) == 2){ y
n
if(!missing(fraction)) { # find special hull
n.hull
if(missing(col.hull)) col.hull
if(missing(lty.hull)) lty.hull
if(missing(lwd.hull)) lwd.hull
x.old
idx
for( i in 1:(length(x)/3)){
x
if( (length(x)/n) < fraction ){
return(cbind(x.hull,y.hull))
}
idx
}
}
if(missing(col.hull)) col.hull
if(length(col.hull)) col.hull
if(missing(lty.hull)) lty.hull
if(length(lty.hull)) lty.hull
if(missing(lwd.hull)) lwd.hull
if(length(lwd.hull)) lwd.hull
result
for( i in 1:n.hull){
idx
result
x
if(0 == length(x)) return(result)
}
result
} # end of definition of plothulls
#################################
# prepare data to go into function below
the_matrix
# get data out of function as df with names
setNames(data.frame(plothulls_(the_matrix, fraction = prop)), nm = c("x", "y"))
# how can we get the hull and loop vertices passed on also?
},
required_aes = c("x", "y")
)
#' @inheritParams ggplot2::stat_identity
#' @param prop Proportion of all the points to be included in the bag (default is 0.5)
stat_bag
position = "identity", na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE, prop = 0.5, alpha = 0.3, ...) {
layer(
stat = StatBag, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, prop = prop, alpha = alpha, ...)
)
}
geom_bag
stat = "identity", position = "identity",
prop = 0.5,
alpha = 0.3,
...,
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE) {
layer(
data = data,
mapping = mapping,
stat = StatBag,
geom = GeomBag,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
na.rm = na.rm,
alpha = alpha,
prop = prop,
...
)
)
}
#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
GeomBag
draw_group = function(data, panel_scales, coord) {
n
if (n == 1) return(zeroGrob())
munched
# Sort by group to make sure that colors, fill, etc. come in same order
munched
# For gpar(), there is one entry per polygon (not one entry per point).
# We'll pull the first value from each group, and assume all these values
# are the same within each group.
first_idx
first_rows
ggplot2:::ggname("geom_bag",
grid:::polygonGrob(munched$x, munched$y, default.units = "native",
id = munched$group,
gp = grid::gpar(
col = first_rows$colour,
fill = alpha(first_rows$fill, first_rows$alpha),
lwd = first_rows$size * .pt,
lty = first_rows$linetype
)
)
)
},
default_aes = aes(colour = "NA", fill = "grey20", size = 0.5, linetype = 1,
alpha = NA, prop = 0.5),
handle_na = function(data, params) {
data
},
required_aes = c("x", "y"),
draw_key = draw_key_polygon
)
在这里它与ggbiplot一起使用,我们将prop设置为1表示我们想要绘制一个包含所有点的多边形:
library(ggbiplot)
data(wine)
wine.pca
g
groups = wine.class, ellipse = FALSE, circle = TRUE)
g
g
g + geom_bag(aes(group = wine.class, fill = wine.class), prop = 1)