From b9da5dba3ebf4bc3fea97f854b4f90d1b122da8b Mon Sep 17 00:00:00 2001 From: Paul Staab Date: Mon, 9 May 2016 19:25:19 +0200 Subject: [PATCH] use seq_len instead of 1:x --- DESCRIPTION | 2 +- R/block.R | 2 +- R/fit_glm.R | 2 +- R/initialization.R | 2 +- R/jaatha_log.R | 2 +- R/jaatha_model.R | 9 ++++++--- R/stat_cube.R | 2 +- 7 files changed, 12 insertions(+), 9 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c2c0a66..3878aa9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: jaatha -Version: 3.1.1.9007 +Version: 3.1.1.9008 License: GPL (>= 3) Title: Simulation-Based Maximum Likelihood Parameter Estimation Authors@R: c( diff --git a/R/block.R b/R/block.R index b25b1f6..7c68248 100644 --- a/R/block.R +++ b/R/block.R @@ -31,7 +31,7 @@ block_class <- R6::R6Class("Block", m }, get_corners = function() { - corners <- expand.grid(lapply(1:nrow(private$border), function(i) { + corners <- expand.grid(lapply(seq_len(nrow(private$border)), function(i) { private$border[i, , drop = FALSE] #nolint }), KEEP.OUT.ATTRS = FALSE) #nolint colnames(corners) <- rownames(private$border) diff --git a/R/fit_glm.R b/R/fit_glm.R index 5b2633c..c37df82 100644 --- a/R/fit_glm.R +++ b/R/fit_glm.R @@ -18,7 +18,7 @@ fit_glm.jaatha_stat_basic <- function(x, sim_data, ...) { X <- cbind(1, do.call(rbind, lapply(sim_data, function(data) data$pars_normal))) - glms <- lapply(1:ncol(Y), function(i) { + glms <- lapply(seq_len(ncol(Y)), function(i) { suppressWarnings( stats::glm.fit(X, Y[, i], family = stats::poisson("log"), control = list(maxit = 100))[c("coefficients", diff --git a/R/initialization.R b/R/initialization.R index 7059c83..2b4d45e 100644 --- a/R/initialization.R +++ b/R/initialization.R @@ -102,7 +102,7 @@ do_zoom_in_search <- function(model, data, reps, sim, cores, sim_cache, block_width, n_steps = 3) { "Starts with estimating parameters in the complete parameter space, an then iteratively deceases the size of the block" - best_est <- vapply(1:reps, function(i) { + best_est <- vapply(seq_len(reps), function(i) { middle <- rep(.5, model$get_par_number()) block_widths <- utils::head(seq(1, block_width, length.out = n_steps + 1), -1) diff --git a/R/jaatha_log.R b/R/jaatha_log.R index e74df11..7b20ea2 100644 --- a/R/jaatha_log.R +++ b/R/jaatha_log.R @@ -17,7 +17,7 @@ jaatha_log_class <- R6::R6Class("jaatha_log", initialize = function(model, data, reps, max_steps, verbose = TRUE) { par_number <- model$get_par_number() par_names <- model$get_par_ranges()$get_par_names() - private$estimates <- lapply(1:reps, function(i) { + private$estimates <- lapply(seq_len(reps), function(i) { estimates <- matrix(NA, max_steps, par_number + 3) colnames(estimates) <- c("rep", "step", "llh", par_names) as.data.frame(estimates) diff --git a/R/jaatha_model.R b/R/jaatha_model.R index 51daffb..b728eac 100644 --- a/R/jaatha_model.R +++ b/R/jaatha_model.R @@ -36,15 +36,18 @@ jaatha_model_class <- R6::R6Class("jaatha_model", "conducts a simulation for each parameter combination in pars" assert_that(is.matrix(pars)) assert_that(ncol(pars) == private$par_ranges$get_par_number()) + assert_that(nrow(pars) >= 1) assert_that(all(0 - 1e-5 <= pars & pars <= 1 + 1e-5)) assert_that(is_jaatha_data(data)) assert_that(is.count(cores)) # Generate a seed for each simulation - seeds <- sample_seed(length(pars) + 1) + n_pars <- nrow(pars) + seeds <- sample_seed(n_pars + 1) # Simulate - sim_data <- mclapply(1:nrow(pars), function(i) { + sim_data <- mclapply(seq_len(n_pars), function(i) { + assert_that(is.count(i)) set.seed(seeds[i]) sim_pars <- private$par_ranges$denormalize(pars[i, ]) @@ -80,7 +83,7 @@ jaatha_model_class <- R6::R6Class("jaatha_model", stop("Simulations failed, check your model.") } - set.seed(seeds[length(seeds)]) + set.seed(tail(seeds, 1)) sim_data }, get_par_ranges = function() private$par_ranges, diff --git a/R/stat_cube.R b/R/stat_cube.R index 3552cec..2748d76 100644 --- a/R/stat_cube.R +++ b/R/stat_cube.R @@ -58,7 +58,7 @@ stat_cube_class <- R6::R6Class("stat_cube", inherit = stat_basic_class, data_matrix <- private$calculate_matrix(data) assert_that(is.numeric(data_matrix)) if (!is.matrix(data_matrix)) data_matrix <- matrix(data_matrix, ncol = 1) - list(break_values = lapply(1:ncol(data_matrix), function(i) { + list(break_values = lapply(seq_len(ncol(data_matrix)), function(i) { private$calc_break_values(data_matrix[, i], private$break_values) })) }