## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(collapse = FALSE, comment = "", fig.width = 7, fig.height = 6.2,
                      dev = if (knitr::is_latex_output()) "cairo_pdf" else
                        if (requireNamespace("svglite", quietly = TRUE)) "svglite" else "png")
if (requireNamespace("stability", quietly = TRUE)) library(stability) else
  pkgload::load_all(export_all = FALSE, helpers = FALSE, quiet = TRUE)


## ----facts, include = FALSE---------------------------------------------------
# the numbers quoted in the text: the biplot data of every scaling
views <- c("basic", "which-won-where", "mean-stability", "discrimination")
svps  <- c("genotype", "symmetric", "environment")
gg <-
  lapply(
      X   = stats::setNames(object = svps, nm = svps)
    , FUN = function(s)
        attr(
            x     = gge_biplot(
                .data  = ge_data
              , .y     = Yield
              , .gen   = Gen
              , .env   = Env
              , .which = "basic"
              , .svp   = s
              )
          , which = "gge"
          )
    )
pct    <- sum(gg$genotype$percent)
pc     <- gg$genotype$percent
nG     <- nrow(gg$genotype$gen)
nE     <- nrow(gg$genotype$env)
same_w <- identical(x = gg$genotype$winners, y = gg$symmetric$winners) && identical(
    x = gg$genotype$winners
  , y = gg$environment$winners
  )
win    <- unique(gg$genotype$winners$Winner)
vtx    <- lapply(X = gg, FUN = function(g) sort(g$vertex))
same_v <- identical(x = vtx$genotype, y = vtx$symmetric) && identical(
    x = vtx$genotype
  , y = vtx$environment
  )
same_a <- identical(x = gg$genotype$atc$Gen, y = gg$environment$atc$Gen)
rc <- function(a, b, key, v) round(
    x      = stats::cor(x = a[[v]], y = b[[v]][match(x = a[[key]], table = b[[key]])], method = "spearman")
  , digits = 2
  )
ri_gs <- rc(gg$genotype$atc, gg$symmetric$atc, "Gen", "Instability")
ri_ge <- rc(gg$genotype$atc, gg$environment$atc, "Gen", "Instability")
rl_es <- rc(gg$environment$envs, gg$symmetric$envs, "Env", "Length")
rl_eg <- rc(gg$environment$envs, gg$genotype$envs, "Env", "Length")
ra_es <- rc(gg$environment$envs, gg$symmetric$envs, "Env", "Angle")
ra_eg <- rc(gg$environment$envs, gg$genotype$envs, "Env", "Angle")
lam <- sqrt(pc[1] / pc[2])
lst <- function(x) if (length(x) < 2L) x else paste0(paste(x[-length(x)], collapse = ", "), " and ", x[length(x)])


## ----basic-g------------------------------------------------------------------
p <-
  gge_biplot(
      .data  = ge_data
    , .y     = Yield
    , .rep   = Rep
    , .gen   = Gen
    , .env   = Env
    , .which = "basic"
    , .svp   = "genotype"
    )
p
stab_interpret(
    x             = p
  , higher_better = TRUE
  , top           = 5
  )


## ----basic-s------------------------------------------------------------------
p <-
  gge_biplot(
      .data  = ge_data
    , .y     = Yield
    , .rep   = Rep
    , .gen   = Gen
    , .env   = Env
    , .which = "basic"
    , .svp   = "symmetric"
    )
p
stab_interpret(
    x             = p
  , higher_better = TRUE
  , top           = 5
  )


## ----basic-e------------------------------------------------------------------
p <-
  gge_biplot(
      .data  = ge_data
    , .y     = Yield
    , .rep   = Rep
    , .gen   = Gen
    , .env   = Env
    , .which = "basic"
    , .svp   = "environment"
    )
p
stab_interpret(
    x             = p
  , higher_better = TRUE
  , top           = 5
  )


## ----www-g--------------------------------------------------------------------
p <-
  gge_biplot(
      .data  = ge_data
    , .y     = Yield
    , .rep   = Rep
    , .gen   = Gen
    , .env   = Env
    , .which = "which-won-where"
    , .svp   = "genotype"
    )
p
stab_interpret(
    x             = p
  , higher_better = TRUE
  , top           = 5
  )


## ----www-s--------------------------------------------------------------------
p <-
  gge_biplot(
      .data  = ge_data
    , .y     = Yield
    , .rep   = Rep
    , .gen   = Gen
    , .env   = Env
    , .which = "which-won-where"
    , .svp   = "symmetric"
    )
p
stab_interpret(
    x             = p
  , higher_better = TRUE
  , top           = 5
  )


## ----www-e--------------------------------------------------------------------
p <-
  gge_biplot(
      .data  = ge_data
    , .y     = Yield
    , .rep   = Rep
    , .gen   = Gen
    , .env   = Env
    , .which = "which-won-where"
    , .svp   = "environment"
    )
p
stab_interpret(
    x             = p
  , higher_better = TRUE
  , top           = 5
  )


## ----ms-g---------------------------------------------------------------------
p <-
  gge_biplot(
      .data  = ge_data
    , .y     = Yield
    , .rep   = Rep
    , .gen   = Gen
    , .env   = Env
    , .which = "mean-stability"
    , .svp   = "genotype"
    )
p
stab_interpret(
    x             = p
  , higher_better = TRUE
  , top           = 5
  )
head(x = attr(x = p, which = "gge")$atc, n = 8)


## ----ms-s---------------------------------------------------------------------
p <-
  gge_biplot(
      .data  = ge_data
    , .y     = Yield
    , .rep   = Rep
    , .gen   = Gen
    , .env   = Env
    , .which = "mean-stability"
    , .svp   = "symmetric"
    )
p
stab_interpret(
    x             = p
  , higher_better = TRUE
  , top           = 5
  )


## ----ms-e---------------------------------------------------------------------
p <-
  gge_biplot(
      .data  = ge_data
    , .y     = Yield
    , .rep   = Rep
    , .gen   = Gen
    , .env   = Env
    , .which = "mean-stability"
    , .svp   = "environment"
    )
p
stab_interpret(
    x             = p
  , higher_better = TRUE
  , top           = 5
  )


## ----dis-g--------------------------------------------------------------------
p <-
  gge_biplot(
      .data  = ge_data
    , .y     = Yield
    , .rep   = Rep
    , .gen   = Gen
    , .env   = Env
    , .which = "discrimination"
    , .svp   = "genotype"
    )
p
stab_interpret(
    x             = p
  , higher_better = TRUE
  , top           = 5
  )


## ----dis-s--------------------------------------------------------------------
p <-
  gge_biplot(
      .data  = ge_data
    , .y     = Yield
    , .rep   = Rep
    , .gen   = Gen
    , .env   = Env
    , .which = "discrimination"
    , .svp   = "symmetric"
    )
p
stab_interpret(
    x             = p
  , higher_better = TRUE
  , top           = 5
  )


## ----dis-e--------------------------------------------------------------------
p <-
  gge_biplot(
      .data  = ge_data
    , .y     = Yield
    , .rep   = Rep
    , .gen   = Gen
    , .env   = Env
    , .which = "discrimination"
    , .svp   = "environment"
    )
p
stab_interpret(
    x             = p
  , higher_better = TRUE
  , top           = 5
  )
head(x = attr(x = p, which = "gge")$envs[order(-Length)], n = 6)


## ----grid, fig.width = 11, fig.height = 13, echo = FALSE----------------------
pl <- list()
for (w in views) for (s in svps) {
  pl[[paste(w, s)]] <-
    gge_biplot(
        .data  = ge_data
      , .y     = Yield
      , .gen   = Gen
      , .env   = Env
      , .which = w
      , .svp   = s
      ) +
    ggplot2::labs(title = w, subtitle = paste(s, "scaling"), x = NULL, y = NULL) +
    ggplot2::theme(legend.position = "none", plot.title = ggplot2::element_text(size = 9),
                   plot.subtitle = ggplot2::element_text(size = 8),
                   axis.text = ggplot2::element_text(size = 6))
}
pl <-
  lapply(
      X   = pl
    , FUN = function(q) { q$layers <- Filter(
          f = function(l) !inherits(x = l$geom, what = "GeomTextRepel")
        , x = q$layers
        )
      q }
    )
grid::grid.newpage()
grid::pushViewport(grid::viewport(layout = grid::grid.layout(nrow = 4, ncol = 3)))
for (k in seq_along(pl)) {
  print(
      pl[[k]]
    , vp = grid::viewport(layout.pos.row = (k - 1) %/% 3 + 1, layout.pos.col = (k - 1) %% 3 + 1)
    )
}