Merge branch 'basic-multitrait'

Author: famuvie

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: breedR
 Type: Package
 Title: Statistical Methods for Forest Genetic Resources Analysts
-Version: 0.11-5
+Version: 0.12
 Encoding: UTF-8
 Authors@R: c(person("Facundo", "Muñoz",
     role=c("aut", "cre"),
@@ -24,12 +24,16 @@ Depends:
     sp
 Imports:
     ggplot2,
+    graphics,
+    grDevices,
     Matrix (>= 1.2.0),
     methods,
     nlme,
     pedigree,
     pedigreemm,
-    splines
+    splines,
+    stats,
+    utils
 Suggests:
     doParallel,
     GGally,
@@ -52,4 +56,4 @@ URL: https://github.com/famuvie/breedR
 BugReports: https://github.com/famuvie/breedR/issues
 Additional_repositories: http://www.math.ntnu.no/inla/R/testing
 VignetteBuilder: knitr
-RoxygenNote: 5.0.1
+RoxygenNote: 6.0.1

NAMESPACE

@@ -7,8 +7,8 @@ S3method(all,equal.remlf90)
 S3method(as.data.frame,metagene)
 S3method(as.data.frame,pedigree)
 S3method(coef,remlf90)
-S3method(effect_size,breedr_effect)
-S3method(effect_size,effect_group)
+S3method(dim,breedr_effect)
+S3method(dim,effect_group)
 S3method(effect_type,breedr_effect)
 S3method(effect_type,effect_group)
 S3method(extractAIC,remlf90)
@@ -38,8 +38,9 @@ S3method(nobs,remlf90)
 S3method(plot,metagene)
 S3method(plot,ranef.breedR)
 S3method(plot,remlf90)
+S3method(print,breedR.q)
 S3method(print,breedR.variogram)
-S3method(print,ranef.breedR)
+S3method(print,breedR_estimates)
 S3method(print,remlf90)
 S3method(print,summary.metagene)
 S3method(print,summary.remlf90)
@@ -59,6 +60,7 @@ S3method(renderpf90,permanent_environmental_competition)
 S3method(renderpf90,splines)
 S3method(residuals,remlf90)
 S3method(sim.spatial,metagene)
+S3method(summary,breedR.q)
 S3method(summary,metagene)
 S3method(summary,remlf90)
 S3method(vcov,random)
@@ -96,11 +98,34 @@ exportMethods("coordinates<-")
 exportMethods(coordinates)
 import(Matrix)
 import(ggplot2)
+import(sp)
+importFrom(grDevices,colorRampPalette)
+importFrom(graphics,par)
+importFrom(graphics,plot.new)
+importFrom(methods,as)
 importFrom(methods,setMethod)
 importFrom(methods,setOldClass)
 importFrom(nlme,fixef)
 importFrom(nlme,ranef)
+importFrom(stats,AIC)
+importFrom(stats,BIC)
+importFrom(stats,aggregate)
+importFrom(stats,dist)
+importFrom(stats,fitted)
+importFrom(stats,logLik)
+importFrom(stats,median)
 importFrom(stats,model.matrix)
+importFrom(stats,model.response)
 importFrom(stats,nobs)
+importFrom(stats,printCoefmat)
+importFrom(stats,quantile)
+importFrom(stats,residuals)
+importFrom(stats,runif)
+importFrom(stats,sd)
+importFrom(stats,terms)
+importFrom(stats,var)
 importFrom(stats,vcov)
+importFrom(stats,xtabs)
+importFrom(utils,read.table)
+importFrom(utils,str)
 importMethodsFrom(Matrix,coerce)

NEWS

@@ -1,4 +1,12 @@
-* Interface for using **weights** for residual variance
+breedR 0.12
+===========
+
+* Basic multitrait interface  (#30)
+
+* Default values for initial (co)variances are now a function of empirical
+(co)variances
+
+* Interface for using **weights** for residual variance  (#77)
 
 * Vignette: Heterogeneous variances
 

R/AllGeneric.R

@@ -23,12 +23,6 @@ get_param <- function(x) UseMethod('get_param')
 #' @param x object to be \emph{translated} to progsf90
 effect_type <- function(x) UseMethod('effect_type')
 
-#' Size of a (group of) effect(s)
-#' 
-#' Returns 0 for a \code{fixed} effect, and the size of a \code{effect_group}
-#' @param x element of the breedr_modelframe
-effect_size <- function(x) UseMethod('effect_size')
-
 #' Render a progsf90 effect
 #' 
 #' Translates breedR effects into progsf90 parameters and data.

R/ar.R

@@ -115,5 +115,6 @@ build.AR.rho.grid <- function(rho) {
 build.AR1d <- function(n, x) {
   temp <- diag(c(1, rep(1 + x^2, n-2), 1))
   subdiag <- rbind(0, cbind(diag(-x, n-1), 0))
-  return(as(Matrix::Matrix(temp + subdiag + t(subdiag), sparse = TRUE), 'dgTMatrix'))
+  ans <- Matrix::Matrix(temp + subdiag + t(subdiag), sparse = TRUE)
+  return(methods::as(ans, 'dgTMatrix'))
 }

R/binaries.R

@@ -30,7 +30,7 @@ check_progsf90 <- function(path = breedR.getOption('breedR.bin'),
   if (!check && !quiet) {
     message('Binary dependencies missing.',
             '\nWould you like to install them?\t')
-    if (menu(c("Yes", "No")) == 1) {
+    if (utils::menu(c("Yes", "No")) == 1) {
       install_progsf90(dest = path, platform = platform)
       check <- check_progsf90(path, platform, quiet)
     }
@@ -100,7 +100,7 @@ retrieve_bin <- function(f, url, dest) {
 
   } else {
     out <- tryCatch(
-      download.file(
+      utils::download.file(
         url = file.path(url, f),
         destfile = destf,
         mode = 'wb',
@@ -154,12 +154,15 @@ progsf90_files <- function(os = breedR.os.type(),
 }
 
 
-## Check whether there is internet connection
+# Check whether there is internet connection
 breedR_online <- function() {
   tf <- tempfile()
   !inherits(
     suppressWarnings(
-      try(download.file('http://famuvie.github.io/breedR/', tf, quiet = TRUE))
+      try(utils::download.file(
+        'http://famuvie.github.io/breedR/', tf, quiet = TRUE
+      ),
+      silent = TRUE)
     ), 
     'try-error'
   )

R/breedr_effect.R

@@ -1,4 +1,4 @@
-#' Constructor for a generic effect
+#' Constructor for a generic breedR effect
 #' 
 #' The breedr_effect-class is virtual. No object should be directly created with
 #' this constructor. This constructor is to be called from within non-virtual 
@@ -24,6 +24,19 @@ breedr_effect <- function(incidence) {
   return(ans)
 }
 
+
+# @describeIn breedr_effect Dimension of a \code{breedr_effect}: 0 for a fixed 
+#   effect, 1 for a random effect
+#' @rdname breedr_effect
+#' @param x A \code{breedr_effect}.
+#' @export
+dim.breedr_effect <- function(x) {
+  siz <- ifelse(inherits(x, 'random'), 1, 0)
+  return(c(size = siz, ntraits = NA))
+}
+
+
+
 #' Constructor for a group of effects
 #' 
 #' Builds an \code{effect_group} from a list of \code{breer_effect} elements.
@@ -32,28 +45,28 @@ breedr_effect <- function(incidence) {
 #' object. In the future, the initial covariance matrix will be a matter of the
 #' inference engine, not inherent to the model.
 #' 
+#' The `ntraits` is used to check the dimension of the initial variance matrix.
+#' 
 #' @param x list of breedr_effect elements
 #' @param cov.ini initial covariance matrix for the estimation algorithm
+#' @param ntraits number of traits in the model
 #' 
 #' @return A list of \code{breedr_effect} elements.
-effect_group <- function(x, cov.ini) {
+effect_group <- function(x, cov.ini, ntraits) {
 
   ## Checks ==========================================
   ## x is a list and cov.ini a SPD matrix
   stopifnot(is.list(x))
   cov.ini <- as.matrix(cov.ini)
-  stopifnot(is.numeric(cov.ini))
-  stopifnot(isSymmetric.matrix(cov.ini, check.attributes = FALSE))
-  ev <- eigen(cov.ini, symmetric = TRUE, only.values = TRUE)$values
-  stopifnot(all(ev > 0))
+  validate_variance(cov.ini)
 
   ## all elements are breedr_effects
   if (!all(sapply(x, inherits, 'breedr_effect')))
     stop('All of the effects must be of class breedr_effect.')
 
   ## cov.ini is square and of size equal to number of effects
   nx <- length(x)
-  if (!all(dim(cov.ini) == nx))
+  if (!all(dim(cov.ini) == nx*ntraits))
     stop('Dimension of the initial covariance matrix do not conform with
          number of effects in the group.')
 
@@ -63,10 +76,12 @@ effect_group <- function(x, cov.ini) {
   return(ans)
 }
 
-#' Size of a group of effects
-#' 
-#' @param x object of class \code{effect_group}
-group_size <- function(x) {
-  stopifnot(inherits(x, 'effect_group'))
-  length(x$effects)
+# @describeIn effect_group Returns the dimension of an \code{effect_group}
+#   factored by its size and number of traits
+#' @rdname effect_group
+#' @export
+dim.effect_group <- function(x) {
+  siz <- length(x$effects)
+  ntr <- dim(as.matrix(x$cov.ini))[1] / siz
+  return(c(size = siz, ntraits = ntr))
 }