#' Generate Color Palette for ggplot2
#'
#' This function creates a color palette suitable for ggplot2 visualizations by evenly spacing colors in the HCL color space. The function ensures that the colors are well-distributed and visually distinct, making it ideal for categorical data where each category needs to be represented by a different color.
#'
#' @param g An integer indicating the number of distinct colors to generate. This value should be a positive integer, with higher values resulting in a broader range of colors.
#' @return A vector of color codes in hexadecimal format, suitable for use in ggplot2 charts and plots. The length of the vector will match the input parameter `g`.
#' @examples
#' # Generate a palette of 5 distinct colors
#' ggplotColors(5)
#'
#' # Use the generated colors in a ggplot2 chart
#' library(ggplot2)
#' df <- data.frame(x = 1:5, y = rnorm(5), group = factor(1:5))
#' ggplot(df, aes(x, y, color = group)) +
#' geom_point() +
#' scale_color_manual(values = ggplotColors(5))
#'
#' @export
ggplotColors <- function(g){
d <- 360/g # Calculate the distance between colors in HCL color space
h <- cumsum(c(15, rep(d,g - 1))) # Create cumulative sums to define hue values
hcl(h = h, c = 100, l = 65) # Convert HCL values to hexadecimal color codes
}
###############################################
#' ggplot2 extension for an iNEXT object
#'
#' \code{ggiNEXT}: the \code{\link[ggplot2]{ggplot}} extension for \code{\link{iNEXT}} Object to plot sample-size- and coverage-based rarefaction/extrapolation curves along with a bridging sample completeness curve
#' @param x an \code{iNEXT} object computed by \code{\link{iNEXT}}.
#' @param type three types of plots: sample-size-based rarefaction/extrapolation curve (\code{type = 1});
#' sample completeness curve (\code{type = 2}); coverage-based rarefaction/extrapolation curve (\code{type = 3}).
#' @param se a logical variable to display confidence interval around the estimated sampling curve.
#' @param facet.var create a separate plot for each value of a specified variable:
#' no separation \cr (\code{facet.var="None"});
#' a separate plot for each diversity order (\code{facet.var="Order.q"});
#' a separate plot for each assemblage (\code{facet.var="Assemblage"});
#' a separate plot for each combination of order x assemblage (\code{facet.var="Both"}).
#' @param color.var create curves in different colors for values of a specified variable:
#' all curves are in the same color (\code{color.var="None"});
#' use different colors for diversity orders (\code{color.var="Order.q"});
#' use different colors for sites (\code{color.var="Assemblage"});
#' use different colors for combinations of order x assemblage (\code{color.var="Both"}).
#' @param grey a logical variable to display grey and white ggplot2 theme.
#' @param ... other arguments passed on to methods. Not currently used.
#' @return a ggplot2 object
#' @examples
#' # single-assemblage abundance data
#' data(spider)
#' out1 <- iNEXT(spider$Girdled, q=0, datatype="abundance")
#' ggiNEXT(x=out1, type=1)
#' ggiNEXT(x=out1, type=2)
#' ggiNEXT(x=out1, type=3)
#'
#'\dontrun{
#' # single-assemblage incidence data with three orders q
#' data(ant)
#' size <- round(seq(10, 500, length.out=20))
#' y <- iNEXT(ant$h500m, q=c(0,1,2), datatype="incidence_freq", size=size, se=FALSE)
#' ggiNEXT(y, se=FALSE, color.var="Order.q")
#'
#' # multiple-assemblage abundance data with three orders q
#' z <- iNEXT(spider, q=c(0,1,2), datatype="abundance")
#' ggiNEXT(z, facet.var="Assemblage", color.var="Order.q")
#' ggiNEXT(z, facet.var="Both", color.var="Both")
#'}
#' @export
#'
ggiNEXT <- function(x, type=1, se=TRUE, facet.var="None", color.var="Assemblage", grey=FALSE){
UseMethod("ggiNEXT", x)
}
#' @export
#' @rdname ggiNEXT
ggiNEXT.iNEXT <- function(x, type=1, se=TRUE, facet.var="None", color.var="Assemblage", grey=FALSE){
TYPE <- c(1, 2, 3)
SPLIT <- c("None", "Order.q", "Assemblage", "Both")
if(is.na(pmatch(type, TYPE)) | pmatch(type, TYPE) == -1)
stop("invalid plot type")
if(is.na(pmatch(facet.var, SPLIT)) | pmatch(facet.var, SPLIT) == -1)
stop("invalid facet variable")
if(is.na(pmatch(color.var, SPLIT)) | pmatch(color.var, SPLIT) == -1)
stop("invalid color variable")
type <- pmatch(type, 1:3)
facet.var <- match.arg(facet.var, SPLIT)
color.var <- match.arg(color.var, SPLIT)
if(facet.var=="Order.q") color.var <- "Assemblage"
if(facet.var=="Assemblage") color.var <- "Order.q"
options(warn = -1)
z <- fortify(x, type=type)
options(warn = 0)
# Check if the number of unique 'Assemblage' is 8 or less
if (length(unique(z$Assemblage)) <= 8){
cbPalette <- rev(c("#999999", "#E69F00", "#56B4E9", "#009E73", "#330066", "#CC79A7", "#0072B2", "#D55E00"))
}else{
# If there are more than 8 assemblages, start with the same predefined color palette
# Then extend the palette by generating additional colors using the 'ggplotColors' function
cbPalette <- rev(c("#999999", "#E69F00", "#56B4E9", "#009E73", "#330066", "#CC79A7", "#0072B2", "#D55E00"))
cbPalette <- c(cbPalette, ggplotColors(length(unique(z$Assemblage))-8))
}
if(!('y.lwr' %in% names(z))) { se <- FALSE }
datatype <- unique(z$datatype)
if(color.var=="None"){
if(levels(factor(z$Order.q))>1 & length(unique(z$Assemblage))>1){
warning("invalid color.var setting, the iNEXT object consists multiple assemblages and orders, change setting as Both")
color.var <- "Both"
z$col <- z$shape <- paste(z$Assemblage, z$Order.q, sep="-")
}else if(length(unique(z$Assemblage))>1){
warning("invalid color.var setting, the iNEXT object consists multiple assemblages, change setting as Assemblage")
color.var <- "Assemblage"
z$col <- z$shape <- z$Assemblage
}else if(levels(factor(z$Order.q))>1){
warning("invalid color.var setting, the iNEXT object consists multiple orders, change setting as Order.q")
color.var <- "Order.q"
z$col <- z$shape <- factor(z$Order.q)
}else{
z$col <- z$shape <- rep(1, nrow(z))
}
}else if(color.var=="Order.q"){
z$col <- z$shape <- factor(z$Order.q)
}else if(color.var=="Assemblage"){
if(length(unique(z$Assemblage))==1){
warning("invalid color.var setting, the iNEXT object do not consist multiple assemblages, change setting as Order.q")
z$col <- z$shape <- factor(z$Order.q)
}
z$col <- z$shape <- z$Assemblage
}else if(color.var=="Both"){
if(length(unique(z$Assemblage))==1){
warning("invalid color.var setting, the iNEXT object do not consist multiple assemblages, change setting as Order.q")
z$col <- z$shape <- factor(z$Order.q)
}
z$col <- z$shape <- paste(z$Assemblage, z$Order.q, sep="-")
}
zz=z
z$Method[z$Method=="Observed"]="Rarefaction"
z$lty <- factor(z$Method, levels = c("Rarefaction", "Extrapolation"))
z$col <- factor(z$col)
data.sub <- zz[which(zz$Method=="Observed"),]
g <- ggplot(z, aes_string(x="x", y="y", colour="col")) +
geom_point(aes_string(shape="shape"), size=5, data=data.sub)+
scale_colour_manual(values=cbPalette)
g <- g + geom_line(aes_string(linetype="lty"), lwd=1.5) +
guides(linetype=guide_legend(title=NULL),
colour=guide_legend(title=NULL),
fill=guide_legend(title=NULL),
shape=guide_legend(title=NULL)) +
theme(legend.position = "bottom",
legend.title=element_blank(),
text=element_text(size=18),
legend.key.width = unit(1.2,"cm"))
if(type==2L) {
g <- g + labs(x="Number of sampling units", y="Sample coverage")
if(datatype=="abundance") g <- g + labs(x="Number of individuals", y="Sample coverage")
}else if(type==3L|type==4L) {
g <- g + labs(x="Sample coverage", y="Species diversity")
}else {
g <- g + labs(x="Number of sampling units", y="Species diversity")
if(datatype=="abundance") g <- g + labs(x="Number of individuals", y="Species diversity")
}
if(se)
g <- g + geom_ribbon(aes_string(ymin="y.lwr", ymax="y.upr", fill="factor(col)", colour="NULL"), alpha=0.2)+
scale_fill_manual(values=cbPalette)
if(facet.var=="Order.q"){
if(length(levels(factor(z$Order.q))) == 1 & type!=2){
warning("invalid facet.var setting, the iNEXT object do not consist multiple orders.")
}else{
odr_grp <- as_labeller(c(`0` = "q = 0", `1` = "q = 1",`2` = "q = 2"))
g <- g + facet_wrap(~Order.q, nrow=1, labeller = odr_grp)
if(color.var=="Both"){
g <- g + guides(colour=guide_legend(title=NULL, ncol=length(levels(factor(z$Order.q))), byrow=TRUE),
fill=guide_legend(title=NULL))
}
if(type==2){
g <- g + theme(strip.background = element_blank(),strip.text.x = element_blank())
}
}
}
if(facet.var=="Assemblage"){
if(length(unique(z$Assemblage))==1) {
warning("invalid facet.var setting, the iNEXT object do not consist multiple assemblages")
}else{
g <- g + facet_wrap(~Assemblage, nrow=1)
if(color.var=="Both"){
g <- g + guides(colour=guide_legend(title=NULL, nrow=length(levels(factor(z$Order.q)))),
fill=guide_legend(title=NULL))
}
}
}
if(facet.var=="Both"){
if(length(levels(factor(z$Order.q))) == 1 | length(unique(z$Assemblage))==1){
warning("invalid facet.var setting, the iNEXT object do not consist multiple assemblages or orders.")
}else{
odr_grp <- as_labeller(c(`0` = "q = 0", `1` = "q = 1",`2` = "q = 2"))
g <- g + facet_wrap(Assemblage~Order.q,labeller = labeller(Order.q = odr_grp))
if(color.var=="both"){
g <- g + guides(colour=guide_legend(title=NULL, nrow=length(levels(factor(z$Assemblage))), byrow=TRUE),
fill=guide_legend(title=NULL))
}
}
}
if(grey){
g <- g + theme_bw(base_size = 18) +
scale_fill_grey(start = 0, end = .4) +
scale_colour_grey(start = .2, end = .2) +
guides(linetype=guide_legend(title=NULL),
colour=guide_legend(title=NULL),
fill=guide_legend(title=NULL),
shape=guide_legend(title=NULL)) +
theme(legend.position="bottom",
legend.title=element_blank())
}
g <- g + theme(legend.box = "vertical")
return(g)
}
#' @export
#' @rdname ggiNEXT
ggiNEXT.default <- function(x, ...){
stop(
"iNEXT doesn't know how to deal with data of class ",
paste(class(x), collapse = "/"),
call. = FALSE
)
}
#' Fortify method for classes from the iNEXT package.
#'
#' @name fortify.iNEXT
#' @param model \code{iNEXT} to convert into a dataframe.
#' @param data not used by this method
#' @param type three types of plots: sample-size-based rarefaction/extrapolation curve (\code{type = 1});
#' sample completeness curve (\code{type = 2}); coverage-based rarefaction/extrapolation curve (\code{type = 3}).
#' @param ... not used by this method
#' @import ggplot2
#' @export
#' @examples
#' data(spider)
#' # single-assemblage abundance data
#' out1 <- iNEXT(spider$Girdled, q=0, datatype="abundance")
#' ggplot2::fortify(out1, type=1)
fortify.iNEXT <- function(model, data = model$iNextEst, type = 1, ...) {
datatype <- ifelse(names(model$DataInfo)[2]=="n","abundance","incidence")
z <- data
# if(inherits(z, "list")){
# if(datatype=='abundance'){
# id_match <- match(c("Assemblage","m", "Method", "Order.q", "qD", "qD.LCL", "qD.UCL", "SC"), names(z$coverage_based), nomatch = 0)
# }else if (datatype=='incidence'){
# id_match <- match(c("Assemblage","t", "Method", "Order.q", "qD", "qD.LCL", "qD.UCL", "SC"), names(z$coverage_based), nomatch = 0)
# }
# z$coverage_based <- cbind(z$coverage_based[,id_match],SC.LCL=NA,SC.UCL=NA)
# z <- data.frame(do.call("rbind", z), base=rep(names(z), each = sapply(z, nrow)))
# rownames(z) <- NULL
# }else{
# z$site <- ""
# }
# if(ncol(z)==6) {
# warning("invalid se setting, the iNEXT object do not consist confidence interval")
# se <- FALSE
# }else if(ncol(z)>6) {
# se <- TRUE
# }
if(is.na(z$size_based$qD.LCL[1])) {
warning("invalid se setting, the iNEXT object do not consist confidence interval")
se <- FALSE
}else{
se <- TRUE
}
if(type==1L) {
z <- z$size_based
z$x <- z[,2]
z$y <- z$qD
z$datatype <- datatype
z$plottype <- type
if(se){
z$y.lwr <- z$qD.LCL
z$y.upr <- z$qD.UCL
data <- z[,c("datatype","plottype","Assemblage","Method","Order.q","x","y","y.lwr","y.upr")]
}else{
data <- z[,c("datatype","plottype","Assemblage","Method","Order.q","x","y")]
}
}else if(type==2L){
z <- z$size_based
if(length(unique(z$Order.q))>1){
# z <- subset(z, Order.q==unique(z$Order.q)[1])
z <- z[z$Order.q==unique(z$Order.q)[1],]
}
z$x <- z[,2]
z$y <- z$SC
z$datatype <- datatype
z$plottype <- type
if(se){
z$y.lwr <- z$SC.LCL
z$y.upr <- z$SC.UCL
data <- z[,c("datatype","plottype","Assemblage","Method","Order.q","x","y","y.lwr","y.upr")]
}else{
data <- z[,c("datatype","plottype","Assemblage","Method","Order.q","x","y")]
}
}else if(type==3L){
z <- z$coverage_based
z$x <- z$SC
z$y <- z$qD
z$datatype <- datatype
z$plottype <- type
if(se){
z$y.lwr <- z$qD.LCL
z$y.upr <- z$qD.UCL
data <- z[,c("datatype","plottype","Assemblage","Method","Order.q","x","y","y.lwr","y.upr")]
}else{
data <- z[,c("datatype","plottype","Assemblage","Method","Order.q","x","y")]
}
}
# else if(type==4L){
# z <- z$size_based
# z$x <- z$SC
# z$y <- z$qD
# z$datatype <- datatype
# z$plottype <- type
# if(se){
# z$y.lwr <- z$qD.LCL
# z$y.upr <- z$qD.UCL
# data <- z[,c("datatype","plottype","Assemblage","Method","Order.q","x","y","y.lwr","y.upr")]
# }else{
# data <- z[,c("datatype","plottype","Assemblage","Method","Order.q","x","y")]
# }
# }
data
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.