fix length(condition) > 1 errors

.travis.yml

@@ -9,9 +9,7 @@ warnings_are_errors: false
 sudo: required
 
 apt_packages:
-  - libgsl0-dbg
-  - libgsl0-dev
-  - libgsl0ldbl
+  - libgsl-dev
   - libcurl4-openssl-dev
   - libxml2-dev
 

R/0_prep_object.R

@@ -10,7 +10,6 @@
 #' @return An object inherting \code{\linkS4class{copula}} corresponding to the
 #' specific family.
 #' @author Benedikt Graeler
-#' @keywords ~kwd1 ~kwd2
 #' @examples
 #'
 #' # normalCopula with parameter 0.5

R/BiCopCheck.R

@@ -286,7 +286,9 @@ adjustPars <- function(family, par, par2) {
 BiCopCheckTaus <- function(family, tau) {
     cl <- match.call()[1]
     ## check for family/tau consistency
-    checkTaus<- function(x) {
+    checkTaus <- function(x) {
+        family <- x[1]
+        tau <- x[2]
         if (family %in% c(3, 13) && tau <= 0)
             stop("\n In ", cl, ": ",
                  "Clayton copula cannot be used for tau<=0.",

R/BiCopCondSim.R

@@ -101,9 +101,9 @@ BiCopCondSim <- function(N, cond.val, cond.var, family, par, par2 = 0,
         cond.val <- rep(cond.val, N)
     if (length(cond.val) != N)
         stop("cond.val must be a numeric vector of length 1 or N")
-    if ((cond.val <= 0)  || (cond.val >= 1))
+    if (any(cond.val <= 0)  || any(cond.val >= 1))
         stop("cond.val must be in the interval (0, 1)")
-    if (!(cond.var %in% 1:2))
+    if (!all(cond.var %in% 1:2))
         stop("cond.var has to be either 1 or 2")
     if (missing(family))
         family <- NA

R/BiCopLambda.R

@@ -133,17 +133,15 @@ BiCopLambda <- function(u1 = NULL, u2 = NULL, family = "emp", par = 0, par2 = 0,
         par2 <- obj$par2
     }
 
-    if (is.null(u1) == TRUE && is.null(u2) == TRUE && (family == 0 || par == 0))
+    if ((is.null(u1) == TRUE) && (is.null(u2) == TRUE) && (family == 0 || par == 0))
         stop("Either 'u1' and 'u2' have to be set for the emp.
              lambda-function or 'family' and 'par' for the theo. lambda-function.")
     if (length(u1) != length(u2))
         stop("Lengths of 'u1' and 'u2' do not match.")
     if (!(family %in% c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, "emp")))
         stop("Copula family not implemented.")
-    if (c(2, 7, 8, 9, 10) %in% family && par2 == 0)
+    if ((family %in% c(2, 7, 8, 9, 10)) && (par2 == 0))
         stop("For t-, BB1 and BB7 copulas, 'par2' must be set.")
-    if (c(1, 3, 4, 5, 6, 13, 14, 16, 23, 24, 26, 33, 34, 36) %in% family && length(par) < 1)
-        stop("'par' not set.")
     if (any(is.na(u1 + u2))) {
         # send warning message
         warning("Some of the data are NA. ",
@@ -153,9 +151,9 @@ BiCopLambda <- function(u1 = NULL, u2 = NULL, family = "emp", par = 0, par2 = 0,
         u1 <- u1[-na.ind]
         u2 <- u2[-na.ind]
     }
-    if (is.null(u1) == FALSE && (any(u1 > 1) || any(u1 < 0)))
+    if ((is.null(u1) == FALSE) && (any(u1 > 1) || any(u1 < 0)))
         stop("Data has be in the interval [0,1].")
-    if (is.null(u2) == FALSE && (any(u2 > 1) || any(u2 < 0)))
+    if ((is.null(u2) == FALSE) && (any(u2 > 1) || any(u2 < 0)))
         stop("Data has be in the interval [0,1].")
 
     if (PLOT != TRUE && PLOT != FALSE)
@@ -221,7 +219,7 @@ BiCopLambda <- function(u1 = NULL, u2 = NULL, family = "emp", par = 0, par2 = 0,
 
     }
 
-    if (is.null(u1) == FALSE)
+    if (all(is.null(u1) == FALSE))
         len <- length(u1) else len <- 1000
 
     if (family == 1) {

R/as.copuladata.R

@@ -15,13 +15,13 @@
 #'
 #' data(daxreturns)
 #'
-#' data <- as(daxreturns, "matrix")
+#' data <- as.matrix(daxreturns)
 #' class(as.copuladata(data))
 #'
-#' data <- as(daxreturns, "data.frame")
+#' data <- as.data.frame(daxreturns)
 #' class(as.copuladata(data))
 #'
-#' data <- as(daxreturns, "list")
+#' data <- as.list(daxreturns)
 #' names(data) <- names(daxreturns)
 #' class(as.copuladata(data))
 #'
@@ -32,19 +32,19 @@ as.copuladata <- function(data) {
 
 as.copuladata.data.frame <- function(data) {
     ## coercion of 'data.frame' to 'copuladata'
-    if (any(sapply(data, mode) != "numeric"))
+    if (!all(sapply(data, is.numeric)))
         stop("Data has to be numeric.")
-    if (any(data > 1 || data < 0))
+    if (any(data > 1 | data < 0))
         stop("Data has to be in the interval [0,1].")
     class(data) <- append("copuladata", class(data))
     return(data)
 }
 
 as.copuladata.matrix <- function(data) {
     ## coercion of 'matrix' to 'copuladata'
-    if (mode(data) != "numeric")
+    if (!all(is.numeric(data)))
         stop("Data has to be numeric.")
-    if (any(data > 1 || data < 0))
+    if (any(data > 1 | data < 0))
         stop("Data has to be in the interval [0,1].")
     data <- data.frame(data)
     class(data) <- append("copuladata", class(data))
@@ -53,12 +53,12 @@ as.copuladata.matrix <- function(data) {
 
 as.copuladata.list <- function(data) {
     ## coercion of 'list' to 'copuladata'
-    if (any(sapply(data, mode) != "numeric"))
+    if (!all(sapply(data, is.numeric)))
         stop("Data has to be numeric.")
     if (any(sapply(data, length) != length(data[[1]])))
         stop("All list entries have to be of same length.")
     data <- data.frame(data)
-    if (any(data > 1 || data < 0))
+    if (any(data > 1 | data < 0))
         stop("Data has to be in the interval [0,1].")
     class(data) <- append("copuladata", class(data))
     return(data)