Merge pull request #116 from statgenlmu/fix_type_error

Fix type error

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: jaatha
-Version: 3.0.0.9007
-Date: 2016-01-06
+Version: 3.0.0.9008
+Date: 2016-01-25
 License: GPL (>= 3)
 Title: Simulation-Based Maximum Likelihood Parameter Estimation
 Authors@R: c(

R/coala_interface.R

@@ -185,9 +185,9 @@ coarsen_jsfs <- function(ja, part, part_hi = NULL) {
     part[[i]] <- c(0, part[[i]], dim(ja)[i])
   }
 
-  z <- numeric(length = prod(sapply(part, length) - 1))
+  z <- numeric(length = prod(vapply(part, length, numeric(1)) - 1))
   combinations <- 
-    expand.grid(lapply(sapply(part, length) - 1, ":", 1))[length(z):1, ]
+    expand.grid(lapply(vapply(part, length, numeric(1)) - 1, ":", 1))[length(z):1, ]
 
   for (i in 1:length(z)) {
     comb <- combinations[i, ]

R/likelihood.R

@@ -42,9 +42,9 @@ approximate_llh.jaatha_model <- function(x, data, param, glm_fitted, sim) {
 approximate_llh.jaatha_stat_basic  <- function(x, data, param, glm_fitted, 
                                                sim, scaling_factor) {
 
-  loglambda <- sapply(glm_fitted[[x$get_name()]], function(glm_obj) {
+  loglambda <- vapply(glm_fitted[[x$get_name()]], function(glm_obj) {
     glm_obj$coefficients %*% c(1, param)
-  })
+  }, numeric(1))
 
   # Calculate the Poission log-likelihood
   calc_poisson_llh(data, x, loglambda, sim, scaling_factor)

R/stat_cube.R

@@ -29,7 +29,7 @@ stat_cube_class <- R6Class("stat_cube", inherit = stat_basic_class,
       }
 
       # Count the classes and return as vector
-      dims <- sapply(break_values, length) + 1
+      dims <- vapply(break_values, length, numeric(1)) + 1
       factors <- cumprod(c(1, dims[-length(dims)]))
       classes_int <- apply(locus_class, 1, function(x) sum((x - 1)*factors) + 1)
       tabulate(classes_int, nbins = prod(dims))

tests/testthat/test-jaatha-function.R

@@ -34,14 +34,3 @@ test_that("it supports a one parameter model", {
   expect_equal(results$args$cores, 1)
   expect_equal(results$args$max_steps, 15)
 })
-
-
-test_that("An error is thrown if all glms fail to converge", {
-  model <-   create_jaatha_model(function(x) rpois(10, x),
-                                 par_ranges = matrix(c(0.1, 0.1, 10, 10), 2, 2),
-                                 sum_stats = list(create_jaatha_stat("null", function(x, y) 0)),
-                                 test = FALSE)
-  data <- create_test_data(model)
-
-  expect_error(jaatha(model, data, repetitions = 2, sim = 10, cores = 1))
-})