Merge branch 'devel' of https://github.com/jonesor/Rcompadre into devel

.Rbuildignore

@@ -1,3 +1,4 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
 ^data-raw$
+^\.travis\.yml$

.travis.yml

@@ -0,0 +1,37 @@
+# Language is R
+language: r
+
+
+# R versions to build with ------ 
+# R-devel has a new method of building vignettes that breaks backward
+# compatability. I will exclude it from the build matrix for now so 
+# workshop participants aren't confused by the build error badge. 
+# See below for more details on the development branch
+# http://r.789695.n4.nabble.com/R-CMD-build-then-check-fails-on-R-devel-due-to-serialization-version-td4747582.html
+
+r:
+  - oldrel
+  - release
+
+# Operating systems to build on ------
+os:
+  - linux
+  - osx
+
+# Linux options ---------
+sudo: false
+dist: trusty
+cache: packages
+
+# Branches
+branches:
+  only:
+  - master
+  - devel
+
+# If anyone else would like to be added to notifications,
+# just add your email below!
+notifications:
+  email:
+    - jones@biology.sdu.dk
+    - levisc8@gmail.com

NAMESPACE

@@ -1,10 +1,11 @@
 # Generated by roxygen2: do not edit by hand
 
+export(DBToFlat)
 export(checkSpecies)
-export(cleanDatabase)
+export(cleanDB)
 export(collapseMatrix)
-export(convert2flat)
-export(dbCompare)
+export(compareDBs)
+export(findSpecies)
 export(getMeanMatF)
 export(identifyReproStages)
 export(mergeDBs)
@@ -14,7 +15,6 @@ export(stringToMatrix)
 export(subsetDB)
 importFrom(methods,callNextMethod)
 importFrom(methods,new)
-importFrom(methods,slotNames)
 importFrom(methods,validObject)
 importFrom(popdemo,is.matrix_ergodic)
 importFrom(popdemo,is.matrix_irreducible)

R/CompadreM.R

@@ -34,9 +34,10 @@ setMethod("initialize", "CompadreM",
           function(.Object, ...) {
             .Object <- methods::callNextMethod()
             if(length(.Object@matrixClass) == 0) {
-              .Object@matrixClass$MatrixClassOrganized <- character(0)
-              .Object@matrixClass$MatrixClassAuthor <- character(0)
-              .Object@matrixClass$MatrixClassNumber <- double(0)
+              .Object@matrixClass <- data.frame(MatrixClassOrganized = character(0),
+                                                MatrixClassAuthor = character(0),
+                                                MatrixClassNumber = double(0)
+              )
             }
             methods::validObject(.Object)
             .Object

R/DBToFlat.R

@@ -0,0 +1,64 @@
+#' Convert a list-structured COM(P)ADRE database object to a flat data frame
+#'
+#' This function converts a list-structured COM(P)ADRE database object to a flat
+#' data frame, by converting each matrix and associated matrixClass information
+#' to a string.
+#'
+#' @param db A COM(P)ADRE database object. Databases will be will be coerced
+#'  from the old 'list' format where appropriate (compadre_v4.0.1 and below; 
+#' comadre_v2.0.1 and below).
+#' @param onlyMatA A logical value (TRUE/FALSE) indicating whether ONLY the full
+#'   projection matrix \code{matA} should be included in the flattened data
+#'   frame
+#' 
+#' @return The \code{data.frame} from the metadata slot of \code{db}, but with
+#'   additional columns appended for the matrix stage information and the
+#'   matrices themselves, both in string format.
+#' 
+#' @details \code{DBToFlat} is preferred, but \code{convert2flat} is provided 
+#' for legacy purposes.
+#'
+#' @author Owen R. Jones <jones@@biology.sdu.dk>
+#' 
+#' @seealso stringToMatrix
+#' 
+#' @examples
+#' \dontrun{
+#' compadreFlat <- DBToFlat(compadre, onlyMatA = FALSE)
+#' }
+#' 
+#' @export DBToFlat
+#' 
+DBToFlat <- function(db, onlyMatA = FALSE){
+  if (class(db) == "list"){
+    if( "Animalia" %in% db$metadata$Kingdom ) vlim <- 201
+    if( "Plantae" %in% db$metadata$Kingdom ) vlim <- 401
+    if (as.numeric(gsub("\\.", "", sub("(\\s.*$)", "", db$version$Version))) <= vlim){
+      db <- as(db, "CompadreData")
+    }
+  }
+
+  db@metadata$Amatrix <- NULL
+  for (i in 1:nrow(db@metadata)){
+    db@metadata$classnames[i] <- paste(db@mat[[i]]@matrixClass$MatrixClassAuthor,
+                                       collapse = " | ")
+    db@metadata$matrixA[i] <- paste("[", paste(t(db@mat[[i]]@matA), collapse=" "), "]",
+                                    sep = "")
+  }
+
+  if(onlyMatA == FALSE) {
+    for (i in 1:nrow(db@metadata)){
+      db@metadata$matrixU[i] <- paste("[", paste(t(db@mat[[i]]@matU), collapse=" "),
+                                      "]", sep = "")
+      db@metadata$matrixF[i] <- paste("[", paste(t(db@mat[[i]]@matF), collapse=" "),
+                                      "]", sep = "")
+      db@metadata$matrixC[i] <- paste("[", paste(t(db@mat[[i]]@matC), collapse=" "),
+                                      "]", sep = "")
+    }
+  }
+
+  return(db@metadata)
+}
+
+#' @rdname DBToFlat
+convert2flat <- function(db, onlyMatA = FALSE){ DBToFlat(db, onlyMatA) }

R/checkspecies.R

@@ -9,28 +9,37 @@
 #' @param species A character vector of binomial species names, with the
 #'   genus and specific epithet separated by either an underscore or a space (
 #'   e.g. c("Acipenser_fulvescens", "Borrelia_burgdorferi"))
-#' @param db A COM(P)ADRE database.
-#' @param returnDatabase A logical argument indicating whether a database should be returned.
-#' @return If returnDatabase = FALSE, returns a data frame with a column of
-#'   species names and a column indicating whether a species occurs in the
-#'   database. If returnDatabase == TRUE, returns  a subset of db containing
-#'   only those species within argument \code{species}
+#' @param db A COM(P)ADRE database object. Databases will be will be coerced
+#'  from the old 'list' format where appropriate (compadre_v4.0.1 and below; 
+#' comadre_v2.0.1 and below).
+#' @param returnDatabase A logical argument indicating whether a database 
+#' should be returned.
+#' 
+#' @return If returnDatabase = FALSE, \code{checkSpecies} returns a data frame 
+#'   with a column of species names and a column indicating whether a species 
+#'   occurs in the database. If returnDatabase == TRUE, returns  a subset of db 
+#'   containing only those species within argument \code{species}. 
+#'   \code{findSpecies} returns TRUE if a species is found in the database, 
+#'   FALSE if not, and is called by \code{checkSpecies}.
+#' 
 #' @author Danny Buss <dlb50@@cam.ac.uk>
 #' @author Owen R. Jones <jones@@biology.sdu.dk>
 #' @author Rob Salguero-Gómez <rob.salguero@@zoo.ox.ac.uk>
 #' @author Patrick Barks <patrick.barks@@gmail.com>
+#' 
 #' @examples
 #' \dontrun{
 #' species <- c("Mammillaria gaumeri", "Euterpe edulis", "Homo sapiens")
 #' checkSpecies(species, compadre)
 #' compadre_subset <- checkSpecies(species, compadre, returnDatabase = TRUE)
 #' }
-#' @importFrom rlang .data
+#' 
 #' @export checkSpecies
+#' 
 checkSpecies <- function(species, db, returnDatabase = FALSE) {
   # create dataframe with column for species, and column for whether they are
   #   present in database
-
+  
   inDatabase <- sapply(species, findSpecies, db = db, USE.NAMES = FALSE)
   df <- data.frame(species, inDatabase)
 
@@ -39,18 +48,33 @@ checkSpecies <- function(species, db, returnDatabase = FALSE) {
   }
 
   if (returnDatabase == TRUE) {
-    ssdb <- subsetDB(db, .data$SpeciesAccepted %in% species)
+    ssdb <- subsetDB(db, SpeciesAccepted %in% species)
     return(ssdb)
   } else {
     return(df)
   }
 }
 
 #' Utility function for checkSpecies
-#' @param x A character vector of species names
-#' @param db The COM(P)ADRE database object to search in
+#'
+#' @rdname checkSpecies
+#' 
+#' @param species A character vector of species names.
+#' @param db A COM(P)ADRE database object. Databases will be will be coerced
+#'  from the old 'list' format where appropriate (compadre_v4.0.1 and below; 
+#' comadre_v2.0.1 and below).
+#' 
 #' @return A logical indicating whether the species name is in the 
-#' COM(P)ADRE object
-findSpecies <- function(x, db) {
-  tolower(x) %in% tolower(gsub('_', ' ', db$metadata$SpeciesAccepted))
-}
+#' COM(P)ADRE object.
+#' 
+#' @export findSpecies
+findSpecies <- function(species, db) {
+  if (class(db) == "list"){
+    if( "Animalia" %in% db$metadata$Kingdom ) vlim <- 201
+    if( "Plantae" %in% db$metadata$Kingdom ) vlim <- 401
+    if (as.numeric(gsub("\\.", "", sub("(\\s.*$)", "", db$version$Version))) <= vlim){
+      db <- as(db, "CompadreData")
+    }
+  }
+  tolower(species) %in% tolower(gsub('_', ' ', db@metadata$SpeciesAccepted))
+}

R/cleanDB.R

@@ -0,0 +1,84 @@
+#' Flag potential issues in matrices of a COM(P)ADRE database.
+#' 
+#' This function adds columns to the metatadata slot of a COM(P)ADRE database
+#' object that flag potential problems in the matrices, such as when matrices
+#' contain missing values. These columns can subsequently can be used to subset
+#' the COM(P)ADRE database by logical argument.
+#'
+#' @param db A COM(P)ADRE database object. Databases will be will be coerced
+#'  from the old 'list' format where appropriate (compadre_v4.0.1 and below; 
+#' comadre_v2.0.1 and below).
+#' 
+#' @return Returns db with extra columns appended to the metadata to indicate
+#'   (TRUE/FALSE) whether there are potential problems with the matrices
+#'   corresponding to a given row of the metadata, including whether matA is
+#'   ergodic, primitive, and irreducible.
+#' 
+#' @details \code{cleanDB} is preferred, but \code{cleanDatabase} is provided 
+#' for legacy purposes.
+#' 
+#' @author Julia Jones <juliajones@@biology.sdu.dk>
+#' @author Roberto Salguero-Goméz <rob.salguero@@zoo.ox.ac.uk>
+#' @author Danny Buss <dlb50@@cam.ac.uk>
+#' @author Patrick Barks <patrick.barks@@gmail.com>
+#' 
+#' @keywords utilities
+#' 
+#' @examples
+#' \dontrun{
+#' compadre_clean <- cleanDB(compadre)
+#' }
+#'
+#' @importFrom popdemo is.matrix_ergodic is.matrix_primitive is.matrix_irreducible
+#' @importFrom rlang .data
+#' 
+#' @export cleanDB
+#' 
+cleanDB <- function(db) {
+  if (class(db) == "list"){
+    if( "Animalia" %in% db$metadata$Kingdom ) vlim <- 201
+    if( "Plantae" %in% db$metadata$Kingdom ) vlim <- 401
+    if (as.numeric(gsub("\\.", "", sub("(\\s.*$)", "", db$version$Version))) <= vlim){
+      db <- as(db, "CompadreData")
+    }
+  }
+
+  # create row index
+  db@metadata$index <- 1:nrow(db@metadata)
+
+  # check matA, matU, matF, and matC for any values of NA
+  db@metadata$check_NA_A <- sapply(db@mat, function(x) any(is.na(x@matA)))
+  db@metadata$check_NA_U <- sapply(db@mat, function(x) any(is.na(x@matU)))
+  db@metadata$check_NA_F <- sapply(db@mat, function(x) any(is.na(x@matF)))
+  db@metadata$check_NA_C <- sapply(db@mat, function(x) any(is.na(x@matC)))
+
+  # check whether any columns of matU have sums exceeding 1
+  checkColsums <- function(x) any(colSums(x@matU, na.rm = T) > 1)
+  db@metadata$check_colsums_U <- sapply(db@mat, checkColsums)
+
+  # check properties of matA using functions in popdemo
+  # these checks require matA with no values of NA
+  db_sub <- subsetDB(db, check_NA_A == F) # subset db to matA with no NAs
+
+  checkErgodic <- function(x) popdemo::is.matrix_ergodic(x@matA)
+  checkPrimitive <- function(x) popdemo::is.matrix_primitive(x@matA)
+  checkIrreducible <- function(x) popdemo::is.matrix_irreducible(x@matA)
+
+  db_sub@metadata$check_ergodic <- sapply(db_sub@mat, checkErgodic)
+  db_sub@metadata$check_primitive <- sapply(db_sub@mat, checkPrimitive)
+  db_sub@metadata$check_irreducible <- sapply(db_sub@mat, checkIrreducible)
+
+  # merge checks into full db
+  db_sub@metadata <- subset(db_sub@metadata, select = c('index',
+                                                        'check_ergodic',
+                                                        'check_primitive',
+                                                        'check_irreducible'))
+  db@metadata <- merge(db@metadata, db_sub@metadata, by = 'index', all.x = T)
+  db@metadata <- subset(db@metadata, select = -index)
+
+  # return
+  return(db)
+}
+
+#' @rdname cleanDB
+cleanDatabase <- function(db) { cleanDB(db) }