#' Create all Biplots
#'
#' Function to create all possible biplots
#'
#' @param df dataframe to source
#' @param groupName Name of column to group by
#' @param mColors optional list of colors to use in plot
#'
#' @return None
#'
#' @examples
#' scatterPlots(df)
#'
#' @export
scatterPlots <- function(df = "dataframe", groupName = NULL, mColors = NULL)
{ ... }
# Function
scatterPlots <- function(df = "dataframe", groupName = NULL, mColors = NULL){
if(!is.data.frame(df)){
stop("Please include a dataframe object.")
}
if (missing("groupName")) {
groupName <- "Source"
}
if (missing("mColors")) {
myColors <- readRDS(system.file('Colors', 'Colors.Rds', package='elemSource'))
mColors <- myColors$Hex[1:length(unique(df$Source))]
}
artifacts <- which(df$Type == "Artifact")
sources <- c(which(df$Type == "Source"),which(df$Type == "Source Flake"))
# load packages
myPackages <- c("ggplot2", "grid","gridExtra")
options(warn = -1)
suppressMessages(library(ggplot2))
suppressMessages(library(grid))
suppressMessages(library(gridExtra))
options(warn = 0)
# get all plots into a list
# run all plots
mPlots <- list() # new empty list
# create global variable needed for saving plots to list
.GlobalEnv$.temp.k <- 1
on.exit(rm(.temp.k, envir=.GlobalEnv))
# run all plots and save to list
for (i in 7:11)
for (j in i:11)
local({
i <- i
j <- j
if(!identical(i,j)){
(max(df[,j])-min(df[,j]))
g <- ggplot() +
geom_point(data = df[artifacts,], aes(x = df[artifacts,i],
y = df[artifacts,j],
color = df$Source[artifacts])) +
xlab(names(df)[i]) +
ylab(names(df)[j]) +
theme_minimal() +
theme(legend.title=element_blank()) +
scale_color_manual(values = mColors) + # used for manual colors
stat_ellipse(data = df[sources,], aes(x = df[sources,i],
y = df[sources,j],
color = df$Source[sources]),
type = "norm",
level = .9,
lwd = .5) # this ellipse is based off the multivariate normal distribution
mPlots[[.temp.k]] <<- g # add each plot into plot list
.GlobalEnv$.temp.k <- .temp.k + 1
}
})
# create a function to create one shared plot
grid_arrange_shared_legend <- function(plots) {
g <- ggplotGrob(plots[[1]] + theme(legend.position="bottom"))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
lheight <- sum(legend$height)
grid.arrange(
do.call(arrangeGrob, lapply(plots, function(x)
x + theme(legend.position="none"))),
legend,
ncol = 1,
heights = unit.c(unit(1, "npc") - lheight, lheight))
}
g <- grid_arrange_shared_legend(mPlots)
return(g)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.