Merge pull request #1 from INBO-Natura2000/develop

Version 0.0

Author: ThierryO

.Rbuildignore

@@ -0,0 +1,6 @@
+^.*\.Rproj$
+^\.Rproj\.user$
+^data-raw$
+^\.git$
+^wercker\.yml$
+^\.lintr$

.lintr

@@ -0,0 +1 @@
+linters: with_defaults(camel_case_linter = NULL, multiple_dots_linter = NULL)

DESCRIPTION

@@ -0,0 +1,61 @@
+Package: n2khelper
+Title: Auxiliary Functions for the Analysis and Reporting of the Natura 2000
+    Monitoring
+Version: 0.0
+Authors@R: c(person("Thierry", "Onkelinx", email = "thierry.onkelinx@inbo.be", role = c("aut", "cre")))
+Description: Functions for importing the raw data, creating analysis dataset
+    and running the analysis for the Common Breeding Bird Survey in Flanders.
+Depends:
+    R (>= 3.2.0)
+Imports:
+    git2r,
+    digest,
+    dplyr,
+    plyr,
+    lubridate,
+    methods,
+    assertthat,
+    RODBC
+License: GPL-3
+LazyData: true
+Suggests:
+    testthat
+Collate:
+    'gitConnection_class.R'
+    'auto_commit.R'
+    'check_character.R'
+    'check_dataframe_covariate.R'
+    'check_dataframe_variable.R'
+    'check_dbtable.R'
+    'check_dbtable_variable.R'
+    'check_git_repo.R'
+    'check_id.R'
+    'check_path.R'
+    'check_single_character.R'
+    'check_single_logical.R'
+    'check_single_numeric.R'
+    'check_single_posix.R'
+    'check_single_probability.R'
+    'check_single_strictly_positive_integer.R'
+    'connect_result.R'
+    'cut_date.R'
+    'get_nbn_key.R'
+    'get_nbn_key_multi.R'
+    'get_nbn_name.R'
+    'get_sha1.R'
+    'git_connect.R'
+    'git_connection.R'
+    'git_recent.R'
+    'git_sha.R'
+    'is_git_repo.R'
+    'list_files_git.R'
+    'match_nbn_key.R'
+    'num_32_64.R'
+    'odbc_connect.R'
+    'odbc_get_id.R'
+    'odbc_get_multi_id.R'
+    'odbc_insert.R'
+    'read_delim_git.R'
+    'read_object_environment.R'
+    'remove_files_git.R'
+    'write_delim_git.R'

NAMESPACE

@@ -0,0 +1,84 @@
+# Generated by roxygen2 (4.1.1): do not edit by hand
+
+export(check_character)
+export(check_dataframe_covariate)
+export(check_dataframe_variable)
+export(check_dbtable)
+export(check_dbtable_variable)
+export(check_git_repo)
+export(check_id)
+export(check_path)
+export(check_single_character)
+export(check_single_logical)
+export(check_single_numeric)
+export(check_single_posix)
+export(check_single_probability)
+export(check_single_strictly_positive_integer)
+export(connect_result)
+export(cut_date)
+export(get_nbn_key)
+export(get_nbn_key_multi)
+export(get_nbn_name)
+export(git_connect)
+export(git_connection)
+export(is_git_repo)
+export(match_nbn_key)
+export(num_32_64)
+export(odbc_connect)
+export(odbc_get_id)
+export(odbc_get_multi_id)
+export(odbc_insert)
+export(read_object_environment)
+export(sha1_digits)
+exportClasses(gitConnection)
+exportMethods(auto_commit)
+exportMethods(get_sha1)
+exportMethods(git_recent)
+exportMethods(git_sha)
+exportMethods(list_files_git)
+exportMethods(read_delim_git)
+exportMethods(remove_files_git)
+exportMethods(write_delim_git)
+importClassesFrom(git2r,cred_ssh_key)
+importClassesFrom(git2r,cred_user_pass)
+importClassesFrom(git2r,git_repository)
+importFrom(RODBC,odbcClose)
+importFrom(RODBC,odbcDriverConnect)
+importFrom(RODBC,sqlClear)
+importFrom(RODBC,sqlColumns)
+importFrom(RODBC,sqlQuery)
+importFrom(RODBC,sqlTables)
+importFrom(assertthat,assert_that)
+importFrom(assertthat,has_name)
+importFrom(assertthat,is.count)
+importFrom(assertthat,is.flag)
+importFrom(assertthat,is.string)
+importFrom(assertthat,noNA)
+importFrom(digest,digest)
+importFrom(dplyr,"%>%")
+importFrom(dplyr,data_frame)
+importFrom(dplyr,funs)
+importFrom(dplyr,group_by_)
+importFrom(dplyr,mutate_)
+importFrom(dplyr,mutate_each_)
+importFrom(dplyr,select_)
+importFrom(dplyr,summarise_)
+importFrom(git2r,add)
+importFrom(git2r,commit)
+importFrom(git2r,config)
+importFrom(git2r,cred_ssh_key)
+importFrom(git2r,cred_user_pass)
+importFrom(git2r,hashfile)
+importFrom(git2r,head)
+importFrom(git2r,push)
+importFrom(git2r,repository)
+importFrom(lubridate,is.Date)
+importFrom(lubridate,is.POSIXt)
+importFrom(lubridate,year)
+importFrom(methods,new)
+importFrom(methods,setClass)
+importFrom(methods,setClassUnion)
+importFrom(methods,setGeneric)
+importFrom(methods,setMethod)
+importFrom(methods,setValidity)
+importFrom(plyr,ddply)

R/auto_commit.R

@@ -0,0 +1,98 @@
+#' Commit staged changes in a git repository with automated message
+#'
+#' The mesagge is based on the information returned by \code{\link[utils]{sessionInfo}}
+#' @param package The name of the package from which we autocommit
+#' @param connection The path of the repository. Default to \code{rawdata.path}
+#' @param ... parameters passed to \code{git_connection} when relevant
+#' @name auto_commit
+#' @rdname auto_commit
+#' @exportMethod auto_commit
+#' @docType methods
+#' @importFrom methods setGeneric
+#' @include gitConnection_class.R
+setGeneric(
+  name = "auto_commit",
+  def = function(
+    package, connection, ...
+  ){
+    standard.generic("autocommit")
+  }
+)
+
+#' @rdname auto_commit
+#' @aliases auto_commit,gitConnection-methods
+#' @importFrom methods setMethod
+#' @importFrom git2r repository commit cred_user_pass head push
+setMethod(
+  f = "auto_commit",
+  signature = signature(connection = "ANY"),
+  definition = function(
+    package,
+    connection,
+    ...
+  ){
+    auto_commit(
+      package = package,
+      connection = git_connection(repo.path = connection, ...)
+    )
+  }
+)
+
+
+#' @rdname auto_commit
+#' @aliases auto_commit,git_connection-methods
+#' @importFrom methods setMethod
+#' @importFrom git2r commit cred_user_pass head push
+setMethod(
+  f = "auto_commit",
+  signature = signature(connection = "gitConnection"),
+  definition = function(package, connection, ...){
+    package <- check_single_character(package)
+
+    #format commit message based on sessionInfo()
+    info <- sessionInfo()
+    format.other <- function(x){
+      paste0(x$Package, " ", x$Version, " built ", x$Built, "\n")
+    }
+    message <- paste0(
+      "Automatic commit from ", package, "\n\n",
+      info$R.version$version.string, " revision ", info$R.version$"svn rev",
+      " on ", info$R.version$platform, "\n",
+      "\nBase packages: ",
+        paste0(info$basePkgs, collapse = ", "), "\n",
+      "\nOther package(s):\n",
+        paste(sapply(info$otherPkgs, format.other), collapse = ""),
+      "\nLoaded via a namespace:\n",
+        paste(sapply(info$loadedOnly, format.other), collapse = "")
+    )
+
+    committed <- tryCatch(
+      commit(repo = connection@Repository, message = message),
+      error = function(e){
+        if (e$message == "Error in 'git2r_commit': Nothing added to commit\n") {
+          FALSE
+        } else {
+          e
+        }
+      }
+    )
+    if ("error" %in% class(committed)) {
+      stop(committed)
+    }
+    if (class(committed) != "git_commit") {
+      return(invisible(TRUE))
+    }
+    if (is.null(connection@Credentials)) {
+      warning("changes committed but not pushed")
+    } else {
+      message("Pushing changes to remote repository")
+      tryCatch(
+        push(head(connection@Repository), credentials = connection@Credentials),
+        error = function(e){
+          warning(e)
+        }
+      )
+    }
+    return(invisible(TRUE))
+  }
+)

R/check_character.R

@@ -0,0 +1,21 @@
+#' Check if the object is a character
+#' 
+#' Factors are converted to character.
+#' @param x the object to check
+#' @param name the name of the object to use in the error message
+#' @param na.action \code{link[stats]{na.fail}} throws an error in case of \code{NA} (default). \code{link[stats]{na.omit}} will return \code{x} without the \code{NA} values. \code{link[stats]{na.pass}} will return \code{x} with the \code{NA} values.
+#' @return The function gives the character back. it throws an error when the input is not a character.
+#' @export
+#' @examples
+#' check_character(c("20", "b"))
+check_character <- function(x, name = "x", na.action = na.fail){
+  if(!class(x) %in% c("character", "factor")){
+    stop(name, " must be character")
+  }
+  x <- na.action(x)
+  if(is.factor(x)){
+    return(levels(x)[x])
+  } else {
+    return(x)
+  }
+}

R/check_dataframe_covariate.R

@@ -0,0 +1,23 @@
+#' Check if the covariates are available in a dataframe
+#' @inheritParams check_dataframe_variable
+#' @param covariate The right hand side of the model as a character
+#' @param response The left hand side of the model as a character
+#' @export
+check_dataframe_covariate <- function(
+  df,
+  covariate,
+  response = "Count",
+  error = TRUE
+){
+  covariate <- check_single_character(covariate, name = "covariate")
+  response <- check_single_character(response, name = "response")
+  error <- check_single_logical(error)
+
+  formula <- as.formula(paste(response, "~ ", covariate))
+  output <- check_dataframe_variable(
+    df = df[1, ],
+    variable = all.vars(formula),
+    error = error
+  )
+  return(output)
+}

R/check_dataframe_variable.R

@@ -0,0 +1,81 @@
+#' Check if a data.frame contains variables
+#'
+#' @param df the \code{data.frame} to check
+#' @param variable either a character vector with the names of the variable to
+#'    check or a named list. The names of the list must match the names of the
+#'    required variables in the data.frame. The elements of the list contain the
+#'    accepted classes for each varaible.
+#' @param name the name of the \code{data.frame} to use in the error message
+#' @param error When TRUE (default), the function returns an error when a
+#'    variable is missing. Otherwise it returns a warning.
+#' @return The function returns TRUE when all variables are present. If returns
+#'    FALSE when a variable is missing and \code{error = FALSE}.
+#' @export
+#' @examples
+#' check_dataframe_variable(
+#'  df = data.frame(a = integer(0)),
+#'  variable = "a"
+#' )
+#' check_dataframe_variable(
+#'  df = data.frame(a = integer(0)),
+#'  variable = list(a = c("integer", "numeric"))
+#' )
+#' @importFrom assertthat assert_that is.string is.flag noNA
+check_dataframe_variable <- function(df, variable, name = "df", error = TRUE){
+  assert_that(is.string(name))
+  assert_that(inherits(df, "data.frame") | inherits(df, "matrix"))
+  assert_that(is.flag(error))
+  assert_that(noNA(error))
+  assert_that(is.list(variable) | is.character(variable))
+
+  if (inherits(variable, "list")) {
+    required.class <- variable
+    variable <- names(required.class)
+  } else {
+    required.class <- NULL
+  }
+
+  assert_that(length(variable) > 0)
+  assert_that(noNA(variable))
+
+  available <- variable %in% colnames(df)
+  if (!all(available)) {
+    missing.var <- paste(variable[!available], collapse = ", ")
+    if (error) {
+      stop("Variables missing in ", name, ": ", missing.var)
+    } else {
+      warning("Variables missing in ", name, ": ", missing.var)
+      return(FALSE)
+    }
+  }
+
+  if (is.null(required.class)) {
+    return(TRUE)
+  }
+
+  all.NA <- sapply(
+    df[, variable],
+    function(x){
+      all(is.na(x))
+    }
+  )
+  current.class <- sapply(df[, variable[!all.NA]], class)
+  correct.class <- sapply(seq_along(current.class), function(i){
+    any(current.class[[i]] %in% required.class[!all.NA][[i]])
+  })
+  if (!all(correct.class)) {
+    wrong.class <- current.class[!correct.class]
+    wrong.class <- sapply(wrong.class, paste, collapse = "', '")
+    expected.class <- required.class[!all.NA][names(wrong.class)]
+    expected.class <- sapply(expected.class, paste, collapse = "', '")
+    stop(
+      "Wrong class for following variable(s)\n",
+      paste0(
+        names(wrong.class), ": got '", wrong.class,
+        "', expected '", expected.class, "'\n",
+        collapse = ", "
+      )
+    )
+  }
+  return(TRUE)
+}