Nothing
#' Genotype-environment effects
#' @description
#' `r badge('stable')`
#'
#' This is a helper function that computes the genotype-environment effects,
#' i.e., the residual effect of the additive model
#'
#'
#' @param .data The dataset containing the columns related to Environments,
#' Genotypes, replication/block and response variable(s).
#' @param env The name of the column that contains the levels of the
#' environments. The analysis of variance is computed for each level of this
#' factor.
#' @param gen The name of the column that contains the levels of the genotypes.
#' @param resp The response variable(s). To analyze multiple variables in a
#' single procedure a vector of variables may be used. For example `resp
#' = c(var1, var2, var3)`.
#' @param type The type of effect to compute. Defaults to `"ge"`, i.e.,
#' genotype-environment. To compute genotype plus genotype-environment effects
#' use `type = "gge"`.
#' @param verbose Logical argument. If `verbose = FALSE` the code will run
#' silently.
#' @return A list where each element is the result for one variable that
#' contains a two-way table with genotypes in rows and environments in
#' columns.
#' @author Tiago Olivoto \email{tiagoolivoto@@gmail.com}
#' @export
#' @examples
#' \donttest{
#' library(metan)
#' ge_eff <- ge_effects(data_ge, ENV, GEN, GY)
#' gge_eff <- ge_effects(data_ge, ENV, GEN, GY, type = "gge")
#' plot(ge_eff)
#' }
#'
ge_effects <- function(.data,
env,
gen,
resp,
type = "ge",
verbose = TRUE) {
if(!type %in% c("ge", "gge")){
stop("Invalid value for the argument 'type': It must be either 'ge' or 'gge'", call. = FALSE)
}
factors <-
.data %>%
select({{env}}, {{gen}}) %>%
mutate(across(everything(), as.factor))
vars <- .data %>% select({{resp}}, -names(factors))
vars %<>% select_numeric_cols()
factors %<>% set_names("ENV", "GEN")
listres <- list()
nvar <- ncol(vars)
for (var in 1:nvar) {
data <- factors %>%
mutate(Y = vars[[var]])
if(has_na(data)){
data <- remove_rows_na(data)
has_text_in_num(data)
}
data <- mean_by(data, ENV, GEN, na.rm = TRUE)
if(type == "ge"){
effects <- data %>%
mutate(ge = residuals(lm(Y ~ ENV + GEN, data = data))) %>%
make_mat(GEN, ENV, ge) %>%
rownames_to_column("GEN") %>%
as_tibble()
} else{
effects <- data %>%
mutate(gge = residuals(lm(Y ~ ENV, data = data))) %>%
make_mat(GEN, ENV, gge) %>%
rownames_to_column("GEN") %>%
as_tibble()
}
listres[[paste(names(vars[var]))]] <- effects
}
return(structure(listres, class = "ge_effects"))
}
#' Plot an object of class ge_effects
#'
#' Plot the regression model generated by the function `ge_effects`.
#'
#'
#' @param x An object of class `ge_effects`
#' @param var The variable to plot. Defaults to `var = 1` the first
#' variable of `x`.
#' @param plot_theme The graphical theme of the plot. Default is
#' `plot_theme = theme_metan()`. For more details, see
#' [ggplot2::theme()].
#' @param x.lab The label of x-axis. Each plot has a default value. New
#' arguments can be inserted as `x.lab = "my label"`.
#' @param y.lab The label of y-axis. Each plot has a default value. New
#' arguments can be inserted as `y.lab = "my label"`.
#' @param leg.position The position of the legend.
#' @param size.text The size of the text in the axes text and labels. Default
#' is `12`.
#' @param ... Current not used.
#' @author Tiago Olivoto \email{tiagoolivoto@@gmail.com}
#' @seealso [ge_plot()]
#' @method plot ge_effects
#' @return An object of class `gg, ggplot`.
#' @export
#' @examples
#' \donttest{
#' library(metan)
#' ge_eff <- ge_effects(data_ge2, ENV, GEN, PH)
#' plot(ge_eff)
#' }
#'
plot.ge_effects <- function(x, var = 1, plot_theme = theme_metan(), x.lab = NULL, y.lab = NULL,
leg.position = "right", size.text = 12, ...){
data <- x[[var]] %>%
column_to_rownames("GEN") %>%
make_long()
names <- names(data)
if (is.null(y.lab) == FALSE) {
y.lab <- y.lab
} else {
y.lab <- names[1]
}
if (is.null(x.lab) == FALSE) {
x.lab <- x.lab
} else {
x.lab <- names[2]
}
p <-
ggplot(data, aes_string(names[2], names[1], fill= names[3])) +
geom_tile()+
scale_y_discrete(expand = expansion(mult = c(0,0)))+
scale_x_discrete(expand = expansion(mult = c(0,0)))+
scale_fill_gradient2()+
guides(fill = guide_colourbar(label = TRUE,
draw.ulim = TRUE,
draw.llim = TRUE,
frame.colour = "black",
ticks = TRUE,
nbin = 10,
label.position = "right",
barwidth = 1.3,
barheight = 10,
direction = 'vertical'))+
labs(x = x.lab, y = y.lab)+
plot_theme %+replace%
theme(legend.position = leg.position,
axis.title = element_text(size = size.text),
axis.text = element_text(size = size.text),
legend.text = element_text(size = size.text),
legend.title = element_blank())
return(p)
}
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.