Nothing
#' Plot line or bar graphic
#'
#' @description Function use the dtsm function for plot the results
#' @param data Output from ger_testcomp function
#' @param type Type of graphic. "bar" or "line"
#' @param x Axis x variable
#' @param y Axis y variable
#' @param group Group variable
#' @param ylab Title for the axis y
#' @param xlab Title for the axis x
#' @param glab Title for the legend
#' @param ylimits limits of the y axis
#' @param xrotation Rotation in x axis c(angle, h, v)
#' @param xtext Text labels in x axis
#' @param gtext Text labels in groups
#' @param legend the position of legends ("none", "left", "right", "bottom", "top", or two-element numeric vector)
#' @param sig Column with the significance
#' @param sigsize Font size in significance letters
#' @param error Show the error bar ("ste" or "std").
#' @param color colored figure c(TRUE, FALSE) or vector with the color.
#' @param opt Add news layer to the plot
#' @return Line o bar plot
#' @import dplyr
#' @importFrom grDevices colorRampPalette colors
#' @importFrom tibble deframe
#' @importFrom grDevices gray.colors
#' @import ggplot2
#' @export
#'
#' @examples
#'
#' \dontrun{
#'
#' library(GerminaR)
#' library(dplyr)
#'
#' smr <- ger_summary(SeedN = "seeds"
#' , evalName = "D"
#' , data = prosopis) %>%
#' mutate(across(rep:temp, as.factor))
#'
#' av <- aov(grp ~ nacl*temp, smr)
#'
#' anova(av)
#'
#' mc <- ger_testcomp(aov = av
#' , comp = c("nacl", "temp"))
#'
#' plotdt <- mc$table
#'
#' plot <- fplot(data = plotdt
#' , type = "bar"
#' , x = "temp"
#' , y = "grp"
#' , group = "nacl"
#' , sig = "sig"
#' #, error = "ste"
#' , color = T
#' , ylimits = c(0, 120, 20)
#' )
#'
#' plot
#'
#' }
#'
fplot <- function(data
, type = "bar"
, x
, y
, group = NA
, xlab = NA
, ylab = NA
, glab = NA
, ylimits = NA
, xrotation = NA
, xtext = NA
, gtext = NA
, legend = "top"
, sig = NA
, sigsize = 3
, error = NA
, color = TRUE
, opt = NA
){
# match args --------------------------------------------------------------
legend <- match.arg(legend, c("top", "left", "right", "bottom", "none"))
type <- match.arg(type, c("barra", "linea"))
if(!c(x %in% colnames(data))) stop("colum no exist")
if(!c(y %in% colnames(data))) stop("colum no exist")
# -------------------------------------------------------------------------
if(is.null(group)) {group <- x}
xlab <- if(is.null(xlab) || is.na(xlab) || xlab == "") {NULL} else {xlab}
ylab <- if(is.null(ylab) || is.na(ylab) || ylab == "") {NULL} else {ylab}
glab <- if(is.null(glab) || is.na(glab) || glab == "") {NULL} else {glab}
opt <- if(is.null(opt) || is.na(opt) || opt == "") {NULL} else {opt}
sig <- if(is.null(sig) || is.na(sig) || sig == "" || sig == "none") {NULL} else {sig}
error <- if(is.null(error) || is.na(error) || error == "" || error == "none") {
NULL} else {error}
color <- if(is.null(color) || is.na(color) || color == "" || color == "yes") {
TRUE} else if (color == "none") {FALSE} else {color}
ylimits <- if(all(is.null(ylimits)) || all(is.na(ylimits)) || all(ylimits %in% "")) {
NULL
} else if(is.character(ylimits)) {
ylimits %>%
gsub("[[:space:]]", "", .) %>%
strsplit(., "[*]") %>%
unlist() %>% as.numeric()
} else {ylimits}
xtext <- if(is.null(xtext) || is.na(xtext) || xtext == "") {
NULL} else if (is.character(xtext)){
xtext %>%
strsplit(., ",") %>%
unlist() %>%
base::trimws()
} else {xtext}
gtext <- if(is.null(gtext) || is.na(gtext) || gtext == "") {
NULL} else if (is.character(gtext)){
gtext %>%
strsplit(., ",") %>%
unlist() %>%
base::trimws()
} else {gtext}
xrotation <- if(all(is.null(xrotation)) || all(is.na(xrotation)) || all(xrotation == "")) {
c(0, 0.5, 0.5)
} else if (is.character(xrotation)){
xrotation %>%
gsub("[[:space:]]", "", .) %>%
strsplit(., "[*]") %>%
unlist() %>% as.numeric()
} else {xrotation}
# graph-color -------------------------------------------------------------
if (isTRUE(color)) {
color <- colorRampPalette(
c("#86CD80" # green
, "#F4CB8C" # orange
, "#F3BB00" # yellow
, "#0198CD" # blue
, "#FE6673" # red
))(length(data[[group]] %>% unique()))
} else if (isFALSE(color)) {
color <- gray.colors(n = data[[group]] %>% unique() %>% length()
, start = 0.8
, end = 0.3)
} else {
color <- color
}
# sci-labels --------------------------------------------------------------
if ( !is.null(xlab) ) {
xlab <- xlab %>%
gsub(pattern = " ", "~", .)
xlab <- eval(expression(parse(text = xlab)))
}
if ( !is.null(ylab) ) { #
ylab <- ylab %>%
gsub(pattern = " ", "~", .)
ylab <- eval(expression(parse(text = ylab)))
}
if ( !is.null(glab) ) {
glab <- glab %>%
gsub(pattern = " ", "~", .)
glab <- eval(expression(parse(text = glab)))
}
# type --------------------------------------------------------------------
plotdt <- data %>%
select(!starts_with("{") | !ends_with("}")) %>%
select_if(~ !all(is.na(.))) %>%
drop_na(names(.[1])) %>%
mutate(across(c({{group}}), as.factor))
# bar plot ----------------------------------------------------------------
if(type == "barra") {
plot <- plotdt %>%
ggplot(., aes(x = .data[[x]]
, y = .data[[y]]
, fill = .data[[group]])
) +
geom_col(
position = position_dodge2()
, colour = "black"
, size = 0.4
, na.rm = T
) +
labs(
x = if(is.null(xlab)) x else xlab
, y = if(is.null(ylab)) y else ylab
, fill = if(is.null(glab)) group else glab
) +
{
if (!is.null(error))
geom_errorbar(
aes(ymin = .data[[y]] - .data[[error]]
, ymax = .data[[y]] + .data[[error]] )
, position = position_dodge(width = 0.9)
, width = 0.15
, na.rm = T)
} +
{
if (!is.null(sig) )
geom_text(
aes(label = .data[[sig]]
, y = if(!is.null(error)) .data[[y]] + .data[[error]] else .data[[y]])
, position = position_dodge(width = 0.9)
, na.rm = T
, colour = "black"
, vjust = -0.5
, hjust = 0.5
, angle = 0
, size = sigsize
)
} +
scale_fill_manual(values = color
, labels = if(!is.null(gtext)) gtext else waiver())
}
# line plot ---------------------------------------------------------------
if (type == "linea") {
plot <- plotdt %>%
ggplot( aes(x = .data[[x]]
, y = .data[[y]]
, shape = .data[[group]]
, colour = .data[[group]]
) ) +
geom_point( aes(group = .data[[group]]
, shape = .data[[group]]
, color = .data[[group]]
), size = 2.5 ) +
geom_line( aes( group = .data[[group]]
, color = .data[[group]]
, linetype = .data[[group]]
) , size = 1 ) +
labs(x = if(is.null(xlab)) x else xlab
, y = if(is.null(ylab)) y else ylab
, shape = if(is.null(glab)) group else glab
, color = if(is.null(glab)) group else glab
, linetype = if(is.null(glab)) group else glab
) +
{
if (!is.null(error))
geom_errorbar(aes(ymin = .data[[y]] - .data[[error]]
, ymax = .data[[y]] + .data[[error]])
, width = 0.08)
} +
{
if (!is.null(sig))
geom_text(
aes(label = .data[[sig]]
, y = if(!is.null(error)) .data[[y]] + .data[[error]] else .data[[y]])
, colour = "black"
, vjust = -0.5
, hjust = 0.5
, angle = 0
, size = 3
)
} +
scale_color_manual(
labels = if(!is.null(gtext)) gtext else waiver()
, values = color
) +
scale_linetype_discrete(labels = if(!is.null(gtext)) gtext else waiver()) +
scale_shape_discrete(labels = if(!is.null(gtext)) gtext else waiver())
}
# layers ------------------------------------------------------------------
graph <- plot +
{ if(!is.null(xtext)) scale_x_discrete(labels = xtext) } +
{
if(!is.null(ylimits))
scale_y_continuous(
limits = ylimits[1:2]
, breaks = seq(ylimits[1], ylimits[2], by = abs(ylimits[3]))
, expand = c(0,0)
)
}
layers <- 'graph +
theme_minimal() +
theme(legend.position = legend
, panel.border = element_rect(colour = "black", fill=NA)
, panel.background = element_rect(fill = "transparent")
, legend.background = element_rect(colour = "transparent", fill = "transparent")
, axis.text.x = element_text(angle = xrotation[1]
, hjust= xrotation[2]
, vjust = xrotation[3])
)'
if(is.null(opt)) {
eval(parse(text = layers))
} else {
eval(parse(text = paste(layers, opt, sep = " + ")))
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.