tests/testthat/_problems/test_gge-203.R

In gge: Genotype Plus Genotype-by-Environment Biplots

# Extracted from test_gge.R:203

# prequel ----------------------------------------------------------------------
require(gge)
mat1 <- matrix(c(50, 55, 65, 50, 60, 65, 75,
                 67, 71, 76, 80, 82, 89, 95,
                 90, 93, 95, 102, 97, 106, 117,
                 98, 102, 105, 130, 135, 137, 133,
                 120, 129, 134, 138, 151, 153, 155),
               ncol=5, byrow=FALSE)
colnames(mat1) <- c("E1","E2","E3","E4","E5")
rownames(mat1) <- c("G1","G2","G3","G4","G5","G6","G7")
mat2 <- mat1
mat2[1,1] <- NA
bar <- transform(lattice::barley, env=paste0(site,year))

# test -------------------------------------------------------------------------
require(rgl)
expect_silent({
    skip_on_cran()
    require(agridat)
    dat <- yan.winterwheat
    m2 <- gge(dat, yield ~ gen*env, scale=FALSE)
    
    # Tests for 3D
    biplot3d(m2)
    biplot3d(m2, cex.gen=1)
    # biplot3d(m2, cex.gen=0) # omit genotype names
    biplot3d(m2, cex.env=1)
    biplot3d(m2, col.gen="red")
    biplot3d(m2, col.env=c("red","blue")) # should ignore blue
    biplot3d(m2, comps=c(1,2,4))
    biplot3d(m2, lab.env=FALSE)
    biplot3d(m2, res.vec=FALSE)
    biplot3d(m2, zoom.gen=2)
    
    data(crossa.wheat, package="agridat")
    dat2 <- crossa.wheat
    
    #dat2 <- data.frame(
    #  env=c("BH93","EA93","HW93","ID93","KE93","NN93","OA93","RN93","WP93"),
    #  grp=c("G2","G2","G2","G2","G1","G2","G1","G2","G2"))    
  
    dat$eg <- c("G2","G2","G2","G2","G1","G2","G1","G2","G2")[
      match(dat$env, c("BH93","EA93","HW93","ID93","KE93","NN93","OA93","RN93","WP93"))]
  
    m4 <- gge(dat, yield ~ gen*env, env.group=eg, scale=FALSE)
    biplot3d(m4)
    while (rgl.cur() > 0) { close3d() }
  })