fix linter notifications

.Rbuildignore

@@ -1,3 +1,4 @@
+^\.lintr$
 ^Meta$
 ^doc$
 ^LICENSE\.md$

.lintr

@@ -0,0 +1,4 @@
+linters: with_defaults(line_length_linter = line_length_linter(90), 
+                       closed_curly_linter = NULL, 
+                       open_curly_linter = NULL, 
+                       trailing_whitespace_linter = NULL)

R/RcppExports.R

@@ -4,4 +4,3 @@
 compute_stats <- function(observed, predicted) {
     .Call(`_rEDM_compute_stats`, observed, predicted)
 }
-

R/block_GP.R

@@ -131,15 +131,15 @@ block_gp <- function(block, lib = c(1, NROW(block)), pred = lib,
         col_names <- paste("ts_", seq_len(NCOL(block)))
     }
     if (is.null(columns)) {
-        columns <- list(1:NCOL(block))
+        columns <- list(seq_len(NCOL(block)))
     } else if (is.list(columns)) {
         columns <- lapply(columns, function(embedding) {
             convert_to_column_indices(embedding, block)
         })
     } else if (is.vector(columns)) {
         columns <- list(convert_to_column_indices(columns, block))
     } else if (is.matrix(columns)) {
-        columns <- lapply(1:NROW(columns), function(i) {
+        columns <- lapply(seq_len(NROW(columns)), function(i) {
             convert_to_column_indices(columns[i, ], block)})
     }
 
@@ -156,7 +156,7 @@ block_gp <- function(block, lib = c(1, NROW(block)), pred = lib,
                           eta = eta, 
                           embedding_index = seq_along(columns))
 
-    output <- do.call(rbind, lapply(1:NROW(params), function(i) {
+    output <- do.call(rbind, lapply(seq_len(NROW(params)), function(i) {
         tp <- params$tp[i]
         phi <- params$phi[i]
         v_e <- params$v_e[i]
@@ -184,9 +184,9 @@ block_gp <- function(block, lib = c(1, NROW(block)), pred = lib,
                  "(after correcting for tp)")
 
         # set indices for lib and pred
-        lib_idx <- sort(unique(do.call(c, lapply(1:NROW(lib), function(i) {
+        lib_idx <- sort(unique(do.call(c, lapply(seq_len(NROW(lib)), function(i) {
             seq(from = lib[i, 1], to = lib[i, 2])}))))
-        pred_idx <- sort(unique(do.call(c, lapply(1:NROW(pred), function(i) {
+        pred_idx <- sort(unique(do.call(c, lapply(seq_len(NROW(pred)), function(i) {
             seq(from = pred[i, 1], to = pred[i, 2])}))))
 
         # define inputs to fitting of GP (data, and params)
@@ -459,8 +459,8 @@ compute_gp <- function(x_lib, y_lib,
     if (!is.null(x_pred)) # compute full distance matrix using lib and pred
     {
         dist_xy <- as.matrix(dist(rbind(x_lib, x_pred)))
-        lib_idx <- 1:NROW(x_lib)
-        pred_idx <- NROW(x_lib) + 1:NROW(x_pred)
+        lib_idx <- seq_len(NROW(x_lib))
+        pred_idx <- NROW(x_lib) + seq_len(NROW(x_pred))
 
         squared_dist_lib_lib <- dist_xy[lib_idx, lib_idx] ^ 2
         K_pred_pred <- eta_scaled * 
@@ -522,4 +522,4 @@ compute_gp <- function(x_lib, y_lib,
     }
 
     return(out)
-}
+}

R/block_lnlp_interface.R

@@ -154,16 +154,16 @@ block_lnlp <- function(block, lib = c(1, NROW(block)), pred = lib,
     }
     if (is.null(columns))
     {
-        columns <- list(1:NCOL(block))
+        columns <- list(seq_len(NCOL(block)))
     } else if (is.list(columns)) {
         columns <- lapply(columns, function(embedding) {
             convert_to_column_indices(embedding, block, silent = silent)
         })
     } else if (is.vector(columns)) {
         columns <- list(convert_to_column_indices(columns, block, silent = silent))
     } else if (is.matrix(columns)) {
-        columns <- lapply(1:NROW(columns), function(i) {
-            convert_to_column_indices(columns[i,], block, silent = silent)})
+        columns <- lapply(seq_len(NROW(columns)), function(i) {
+            convert_to_column_indices(columns[i, ], block, silent = silent)})
     }
     embedding_index <- seq_along(columns)
 
@@ -172,24 +172,25 @@ block_lnlp <- function(block, lib = c(1, NROW(block)), pred = lib,
     {
         params <- expand.grid(tp, num_neighbors, theta, embedding_index)
         names(params) <- c("tp", "nn", "theta", "embedding")
-        params <- params[,c("embedding", "tp", "nn", "theta")]
+        params <- params[, c("embedding", "tp", "nn", "theta")]
         e_plus_1_index <- match(num_neighbors, 
                                 c("e+1", "E+1", "e + 1", "E + 1"))
         if (any(e_plus_1_index, na.rm = TRUE))
-            params$nn <- 1 + sapply(columns, length)
+            params$nn <- 1 + vapply(columns, length, 0)
         params$nn <- as.numeric(params$nn)
 
         # check params
-        idx <- sapply(seq(NROW(params)), function(i) {
-            check_params_against_lib(1, 0, params$tp[i], lib, silent = silent)})
+        idx <- vapply(seq(NROW(params)), function(i) {
+            check_params_against_lib(1, 0, params$tp[i], lib, silent = silent)}, 
+            FALSE)
         if (!any(idx))
         {
             stop("No valid parameter combinations to run, stopping.")
         }
         params <- params[idx, ]
 
         # apply model prediction function to params
-        output <- lapply(1:NROW(params), function(i) {
+        output <- lapply(seq_len(NROW(params)), function(i) {
             model$set_embedding(columns[[params$embedding[i]]])
             model$set_params(params$tp[i], params$nn[i])
             model$set_theta(params$theta[i])
@@ -218,20 +219,21 @@ block_lnlp <- function(block, lib = c(1, NROW(block)), pred = lib,
         e_plus_1_index <- match(num_neighbors, 
                                 c("e+1", "E+1", "e + 1", "E + 1"))
         if (any(e_plus_1_index, na.rm = TRUE))
-            params$nn <- 1 + sapply(columns, length)
+            params$nn <- 1 + vapply(columns, length, 0)
         params$nn <- as.numeric(params$nn)
 
         # check params
-        idx <- sapply(seq(NROW(params)), function(i) {
-            check_params_against_lib(1, 0, params$tp[i], lib, silent = silent)})
+        idx <- vapply(seq(NROW(params)), function(i) {
+            check_params_against_lib(1, 0, params$tp[i], lib, silent = silent)}, 
+            FALSE)
         if (!any(idx))
         {
             stop("No valid parameter combinations to run, stopping.")
         }
         params <- params[idx, ]
 
         # apply model prediction function to params
-        output <- lapply(1:NROW(params), function(i) {
+        output <- lapply(seq_len(NROW(params)), function(i) {
             model$set_embedding(columns[[params$embedding[i]]])
             model$set_params(params$tp[i], params$nn[i])
             model$run()
@@ -247,7 +249,7 @@ block_lnlp <- function(block, lib = c(1, NROW(block)), pred = lib,
     }
 
     # create embedding column in params
-    params$embedding <- sapply(params$embedding, function(i) {
-        paste(columns[[i]], sep = "", collapse = ", ")})
+    params$embedding <- vapply(params$embedding, function(i) {
+        paste(columns[[i]], sep = "", collapse = ", ")}, "")
     return(cbind(params, do.call(rbind, output), row.names = NULL))
-}
+}

R/ccm_interface.R

@@ -179,4 +179,4 @@ ccm_means <- function(ccm_df, FUN = mean, ...)
                        lib_column = lib, target_column = target, 
                        ccm_means[, col_idx:NCOL(ccm_means)])
     return(ccm_means[, -1]) # drop Group.1 column
-}
+}

R/data_transformations.R

@@ -276,7 +276,7 @@ identify_twins <- function(block,
                      "length(twins) = ", length(twins), "\n", 
                      "names(twins) = ", names(twins))
             }
-            break()
+            break
         }
     }
 
@@ -383,7 +383,7 @@ make_block <- function(block, t = NULL, max_lag = 3, tau = 1, lib = NULL,
                        restrict_to_lib = TRUE)
 {
     # be sure to convert block if input is a vector
-    if(is.vector(block))
+    if (is.vector(block))
         block <- matrix(block, ncol = 1)
     num_vars <- NCOL(block)
     num_rows <- NROW(block)
@@ -411,7 +411,7 @@ make_block <- function(block, t = NULL, max_lag = 3, tau = 1, lib = NULL,
     for (j in 1:num_vars)
     {
         ts <- block[, j]
-        if(is.list(ts))
+        if (is.list(ts))
         {
             ts <- unlist(ts)
         }
@@ -429,7 +429,7 @@ make_block <- function(block, t = NULL, max_lag = 3, tau = 1, lib = NULL,
                 # make sure we pad beginning of lib segments with tau x NAs
                 if (!is.null(lib))
                 {
-                    for (k in 1:NROW(lib))
+                    for (k in seq_len(NROW(lib)))
                     {
                         ts[lib[k, 1] - 1 + (1:tau)] <- NA
                     }

R/interface_helper_functions.R

@@ -7,8 +7,8 @@ rEDM_warning <- function(..., silent = FALSE)
 
 check_params_against_lib <- function(E, tau, tp, lib, silent = FALSE)
 {
-    vector_start <- max(-(E - 1) * tau, 0, tp)
-    vector_end <- min(-(E - 1) * tau, 0, tp)
+    vector_start <- max(- (E - 1) * tau, 0, tp)
+    vector_end <- min(- (E - 1) * tau, 0, tp)
     vector_length <- abs(vector_start - vector_end) + 1
 
     max_lib_segment <- max(lib[, 2] - lib[, 1] + 1)
@@ -141,4 +141,4 @@ setup_model_flags <- function(model, exclusion_radius, epsilon, silent)
         model$suppress_warnings()
     }
     return()
-}
+}

R/lnlp_interface.R

@@ -116,9 +116,9 @@ simplex <- function(time_series, lib = c(1, NROW(time_series)), pred = lib,
     params$nn <- as.numeric(params$nn)
 
     # check params
-    idx <- sapply(seq(NROW(params)), function(i) {
+    idx <- vapply(seq(NROW(params)), function(i) {
         check_params_against_lib(params$E[i], params$tau[i], params$tp[i], lib, 
-                                 silent = silent)})
+                                 silent = silent)}, FALSE)
     if (!any(idx))
     {
         stop("No valid parameter combinations to run, stopping.")
@@ -213,17 +213,17 @@ s_map <- function(time_series, lib = c(1, NROW(time_series)), pred = lib,
     params$nn <- as.numeric(params$nn)
 
     # check params
-    idx <- sapply(seq(NROW(params)), function(i) {
+    idx <- vapply(seq(NROW(params)), function(i) {
         check_params_against_lib(params$E[i], params$tau[i], params$tp[i], lib, 
-                                 silent = silent)})
+                                 silent = silent)}, FALSE)
     if (!any(idx))
     {
         stop("No valid parameter combinations to run, stopping.")
     }
     params <- params[idx, ]
 
     # apply model prediction function to params
-    output <- lapply(1:NROW(params), function(i) {
+    output <- lapply(seq_len(NROW(params)), function(i) {
         model$set_params(params$E[i], params$tau[i], params$tp[i], params$nn[i])
         model$set_theta(params$theta[i])
         model$run()

R/multiview_interface.R

@@ -116,7 +116,7 @@ multiview <- function(block, lib = c(1, floor(NROW(block) / 2)),
     valid_embeddings_idx <- apply(embeddings_list %% max_lag, 1, 
                                   function(x) {1 %in% x})
     embeddings_list <- embeddings_list[valid_embeddings_idx, ]
-    my_embeddings <- lapply(1:NROW(embeddings_list),
+    my_embeddings <- lapply(seq_len(NROW(embeddings_list)),
                             function(i) {embeddings_list[i, ]})
 
     ## make sure that if target_column is given as a column index, it
@@ -204,4 +204,4 @@ multiview <- function(block, lib = c(1, floor(NROW(block) / 2)),
     params <- data.frame(E = E, tau = tau, tp = tp, 
                          nn = num_neighbors, k = k_list)
     return(cbind(params, output, row.names = NULL))
-}
+}

R/statistical_tests.R

@@ -48,4 +48,4 @@ test_nonlinearity <- function(ts, method = "ebisuzaki", num_surr = 200,
             (num_surr + 1), 
         delta_mae_p_value = (sum(null_stats$delta_mae > delta_mae) + 1) / 
             (num_surr + 1)))
-}
+}

R/tde_gp.R

@@ -59,7 +59,7 @@ tde_gp <- function(time_series, lib = c(1, NROW(time_series)), pred = lib,
     time_series <- dat$time_series
 
     params <- expand.grid(E = E, tau = tau)
-    output <- do.call(rbind, lapply(1:NROW(params), function(i) {
+    output <- do.call(rbind, lapply(seq_len(NROW(params)), function(i) {
         E <- params$E[i]
         tau <- params$tau[i]
 

R/zzz.R

@@ -1,11 +1,11 @@
-loadModule("lnlp_module", TRUE)
-loadModule("block_lnlp_module", TRUE)
-loadModule("xmap_module", TRUE)
+Rcpp::loadModule("lnlp_module", TRUE)
+Rcpp::loadModule("block_lnlp_module", TRUE)
+Rcpp::loadModule("xmap_module", TRUE)
 
 .onAttach <- function(...) {
     if (!interactive()) return()
 
     intro_message <- paste("If you're new to the rEDM package, please check out the tutorial:",
                            "> vignette(\"rEDM-tutorial\")", sep = "\n")
     packageStartupMessage(intro_message)
-}
+}

tests/testthat/test_01_datasets.R

@@ -80,4 +80,4 @@ test_that("sockeye_returns is correct", {
                                            "Weaver"))
     expect_equal(digest::digest(sockeye_returns), 
                  "fb910d884cc0bca744bd2cc9979aad0a")
-})
+})

tests/testthat/test_02_helper_functions.R

@@ -99,8 +99,8 @@ test_that("make_block produces desired output", {
     expect_error(out <- make_block(1:100), NA)
     expect_equal(out, out_actual)
 
-    df <- data.frame(x = c(1, 4, 5, 8, 7, 8, 4, 2, 5, 2, 5, 7 ),
-                     y = c(5, 7, 3, 9, 3, 2, 5, 1, 0, 8, 4, 6 ))
+    df <- data.frame(x = c(1, 4, 5, 8, 7, 8, 4, 2, 5, 2, 5, 7),
+                     y = c(5, 7, 3, 9, 3, 2, 5, 1, 0, 8, 4, 6))
     lib <- matrix(c(1, 4, 5, 12), ncol = 2, byrow = TRUE)
 
     lag_one_actual <- data.frame(
@@ -197,8 +197,7 @@ test_that("make_surrogate_twin works", {
     expect_error(dat2 <- make_surrogate_data(ts, "twin", 15, T_period = 12), NA)
     expect_equal(dat, dat2)
     set.seed(42)
-    expect_error(dat3 <- make_surrogate_data(ts, "twin", 15, T_period = 13))
+    expect_error(dat3 <- make_surrogate_data(ts, "twin", 15, T_period = 14))
     set.seed(42)
     expect_error(dat3 <- make_surrogate_data(ts, "twin", 15, T_period = 13, dim = 2))
 })
-

tests/testthat/test_04_s_map.R

@@ -69,7 +69,7 @@ test_that("s-map smap_coefficient_covariances works", {
     expect_equal(length(smap_coeff_covariances), 200)
     expect_null(smap_coeff_covariances[[1]])
     expect_null(smap_coeff_covariances[[200]])
-    expect_equal(sapply(smap_coeff_covariances[2:199], dim), 
+    expect_equal(vapply(smap_coeff_covariances[2:199], dim, c(1, 1)), 
                  matrix(3, nrow = 2, ncol = 198))
     expect_error(covariance_mat <- do.call(rbind, smap_coeff_covariances[2:199]), NA)
     expect_equal(digest::digest(round(covariance_mat, 4)), 
@@ -109,4 +109,4 @@ test_that("s-map error checking works", {
     expect_error(s_map(1:5, E = 2, tau = 4, silent = TRUE))
     expect_error(s_map(1:5, E = 1, tp = 5, silent = TRUE))
     expect_error(s_map(1:5, E = 1, tp = -5, silent = TRUE))
-})
+})

tests/testthat/test_05_simplex_calculation.R

@@ -8,20 +8,20 @@ testthat::test_that("Simplex identifies nearest neighbors correctly", {
             -0.179969867858605, 0.237962494942611, 1.47828327622468, -1.54267507064286,
             -0.180342027136338, 0.238919610831881, 1.06140368490958, -1.06522901782019,
             -0.214923527940395, 0.452847221462308, 2.13053391555372, -2.55145224744286,
-            -0.0307653352327702, 1.1448014288826,-0.0675575239486375, -1.04711881585576,
+            -0.0307653352327702, 1.1448014288826, -0.0675575239486375, -1.04711881585576,
             -0.00910890042051652, 0.726257323277433, 0.732271192186161, -1.35460378982395,
             -0.0322955446760023, 0.507606440290776, 3.73396587274012, -4.19686615950143,
             -0.0997201857962038, 0.753392632401029, 2.41347231553437, -3.03677401452137,
             -0.141112562089696, 0.446002103079665, 0.223768504955365, -0.615452831633047,
             -0.0216659723974975, 0.292246351104258, 0.20006105300258, -0.469596514211075,
             0.0422676544887819, 0.474264989176278, -0.0416811459395667, -0.53555712696719,
-            0.118860281628173, 0.176335117268894,-0.10364820567334, -0.153572235117542,
+            0.118860281628173, 0.176335117268894, -0.10364820567334, -0.153572235117542,
             0.180339482186409, 0.0566876206447625, -0.140537892644139, 0.0252441742388871,
             0.340689505466622, 0.852833653689839, -1.07051231019616, -0.0937704380137284,
             0.460677118593916, 0.37444382348273, -0.83783628206217, -0.0154896108244113,
             1.34259279914848, -0.495978821807168, -0.472464634960208, -0.415481769949074,
-            1.36767605087962, -0.891896943918948,-0.279228283931612, -0.148703043863421,
-            2.04524590138255,-1.98431486665908, 0.0602356391036573, -0.0902730939678147,
+            1.36767605087962, -0.891896943918948, -0.279228283931612, -0.148703043863421,
+            2.04524590138255, -1.98431486665908, 0.0602356391036573, -0.0902730939678147,
             0.243344379963862, -0.074421904114315, -0.309150440565139, 0.43675531763949,
             0.178787692802827, 0.0799271040758849, -0.657946157906476, 1.14668210755046,
             -0.791665479471326, 0.482533897248175, -0.798737571552661, 0.439024256063545,
@@ -32,7 +32,7 @@ testthat::test_that("Simplex identifies nearest neighbors correctly", {
     t <- c(2:63, 65:99)
 
     # lib and pred portions
-    lib_block <- cbind(t + 1, lag_block[t,])
+    lib_block <- cbind(t + 1, lag_block[t, ])
     pred_block <- cbind(65, lag_block[64, , drop = FALSE])
 
     block <- rbind(lib_block, pred_block)
@@ -49,7 +49,7 @@ testthat::test_that("Simplex identifies nearest neighbors correctly", {
 
     # manually calculate distances and neighbors
     dist_mat <- as.matrix(dist(block[, 3:4]))
-    dist_vec <- dist_mat[NROW(dist_mat),]
+    dist_vec <- dist_mat[NROW(dist_mat), ]
     dist_vec[length(dist_vec)] <- NA
     nn <- order(dist_vec)[1:3] # 3 closest neighbors
     weights <- exp(-dist_vec[nn] / dist_vec[nn[1]])