add stuff

- completeness in ici_kt
- more testing
- fixes check_timing (was broken, and never tested)

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ICIKendallTau
 Title: Calculates information-content-informed Kendall-tau
-Version: 1.2.4
+Version: 1.2.5
 Authors@R: c(
     person(
       given = c("Robert", "M"), 

NEWS.md

@@ -1,3 +1,9 @@
+# ICIKendallTau 1.2.5
+
+- Fixed a bug where the `check_timing` wasn't taking the right arguments, and wasn't actually calculating what it should.
+- Added the `completeness` metric to the output of `ici_kt` (and therefore to `ici_kendalltau`) (closes #23).
+- Added more tests (closes #22 for now).
+
 # ICIKendallTau 1.2.2
 
 - Fixed a bug where passing a two vector list is **supposed** to restrict the comparisons to just those provided, but instead did all possible pairwise comparisons between the two things and all others available.

R/RcppExports.R

@@ -1,10 +1,6 @@
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
-pairwiseComparisons <- function(entries, n_cores, include_self = FALSE) {
-    .Call('_ICIKendallTau_pairwiseComparisons', PACKAGE = 'ICIKendallTau', entries, n_cores, include_self)
-}
-
 sortedIndex <- function(x) {
     .Call('_ICIKendallTau_sortedIndex', PACKAGE = 'ICIKendallTau', x)
 }
@@ -32,14 +28,13 @@ count_rank_tie <- function(ranks) {
 #' Calculates ici-kendall-tau
 #' 
 #' Calculates kendall-tau, with consideration of missingness providing information.
-#' Uses the calculation of tau-b, and always uses the asymptotic approximation of 
-#' the p-value.
+#' Uses the calculation of tau-b.
 #' 
 #' @param x numeric vector
 #' @param y numeric vector
 #' @param perspective should we consider the "local" or "global" perspective?
 #' @param alternative what is the alternative for the p-value test?
-#' @param continuity logical: if true, a continuity correction is used
+#' @param continuity logical: if true, a continuity correction is applied to the p-value
 #' @param output used to control reporting of values for debugging
 #' 
 #' @details Calculates the information-content-informed Kendall-tau correlation measure.

R/kendalltau.R

@@ -139,8 +139,9 @@ ici_kendalltau = function(data_matrix,
   n_todo = sum(purrr::map_int(split_comparisons, nrow))
 
   if (check_timing) {
+
     sample_compare = sample(nrow(split_comparisons[[1]]), 5)
-    tmp_pairwise = split_comparisons[[1]][, sample_compare]
+    tmp_pairwise = split_comparisons[[1]][sample_compare, , drop = FALSE]
 
     run_tmp = check_icikt_timing(exclude_data, tmp_pairwise, perspective, n_todo, computation$ncore)
     return(run_tmp)
@@ -229,7 +230,7 @@ setup_comparisons = function(samples,
       } else {
         cli::cli_abort(message = c(
           '{.arg {include_arg}} must be a vector, a data.frame with two columns, or list of two vectors.',
-          'x' = 'Currently, {.code {length({include_arg})} returns \\
+          'x' = 'Currently, {.code {length({include_arg})}} returns \\
           {length(include_only)}'
         ))
       }
@@ -240,7 +241,7 @@ setup_comparisons = function(samples,
   if (n_todo == 0) {
     cli::cli_abort(message = c(
       'No comparisons to do.',
-      'i' = '{.arg {include_arg}} defines {.val {n_include}} possible comparisons.'
+      'i' = 'Check the list of column names in {.arg {include_arg}} vs those in the samples.'
     ))
 
   }
@@ -629,14 +630,14 @@ missing_either = function(in_x, in_y){
 
 check_icikt_timing = function(exclude_data, tmp_pairwise, perspective, n_todo, ncore){
   t_start = Sys.time()
-  for (icol in seq_len(ncol(tmp_pairwise))) {
-    iloc = tmp_pairwise[1, icol]
-    jloc = tmp_pairwise[2, icol]
+  for (irow in seq_len(nrow(tmp_pairwise))) {
+    iloc = tmp_pairwise[irow, 1]
+    jloc = tmp_pairwise[irow, 2]
     tmp_val = ici_kt(exclude_data[, iloc], exclude_data[, jloc], perspective = perspective)
   }
   t_stop = Sys.time()
   t_total = as.numeric(difftime(t_stop, t_start, units = "secs"))
-  n_comp = ncol(tmp_pairwise)
+  n_comp = nrow(tmp_pairwise)
 
   t_each = t_total / n_comp
 

R/logging.R

@@ -23,13 +23,13 @@ log_memory = function(){
       swapfree_to_swap = 0
     }
 
-    swapfree_to_swap = (memory_numbers["SwapTotal"] - memory_numbers["SwapFree"]) / memory_numbers["SwapTotal"]
-    if (is.nan(swapfree_to_swap)) {
-      swapfree_to_swap = 0
+    swapused_to_swap = (memory_numbers["SwapTotal"] - memory_numbers["SwapFree"]) / memory_numbers["SwapTotal"]
+    if (is.nan(swapused_to_swap)) {
+      swapused_to_swap = 0
     }
 
 
-    if ((active_to_total >= 0.95) || (swapfree_to_swap >= 0.7)) {
+    if ((active_to_total >= 0.95) || (swapused_to_swap >= 0.7)) {
       memory_string2 = paste0("HIGH MEMORY USAGE!!! ", memory_string)
       if (get("logger", envir = icikt_logger)) {
         logger::log_warn(memory_string2, namespace = "ICIKendallTau")
@@ -97,7 +97,10 @@ disable_logging = function(){
 enable_logging = function(log_file = NULL, memory = FALSE){
   has_logger = requireNamespace("logger", quietly = TRUE)
   if (!has_logger) {
-    stop("logger package is not available. Please install it to enable logging!\ninstall.packages('logger')")
+    cli::cli_abort(message = c(
+      'Logging requested, but the {.pkg logger} package is not installed.',
+      'i' = '{.code install.packages("logger")}'
+    ))
   } else {
     assign("logger", TRUE, envir = icikt_logger)
     # if no log file supplied, and we see an old one, just use it

src/RcppExports.cpp

@@ -10,19 +10,6 @@ Rcpp::Rostream<true>&  Rcpp::Rcout = Rcpp::Rcpp_cout_get();
 Rcpp::Rostream<false>& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get();
 #endif
 
-// pairwiseComparisons
-DataFrame pairwiseComparisons(CharacterVector entries, int n_cores, bool include_self);
-RcppExport SEXP _ICIKendallTau_pairwiseComparisons(SEXP entriesSEXP, SEXP n_coresSEXP, SEXP include_selfSEXP) {
-BEGIN_RCPP
-    Rcpp::RObject rcpp_result_gen;
-    Rcpp::RNGScope rcpp_rngScope_gen;
-    Rcpp::traits::input_parameter< CharacterVector >::type entries(entriesSEXP);
-    Rcpp::traits::input_parameter< int >::type n_cores(n_coresSEXP);
-    Rcpp::traits::input_parameter< bool >::type include_self(include_selfSEXP);
-    rcpp_result_gen = Rcpp::wrap(pairwiseComparisons(entries, n_cores, include_self));
-    return rcpp_result_gen;
-END_RCPP
-}
 // sortedIndex
 IntegerVector sortedIndex(NumericVector x);
 RcppExport SEXP _ICIKendallTau_sortedIndex(SEXP xSEXP) {
@@ -124,7 +111,6 @@ END_RCPP
 }
 
 static const R_CallMethodDef CallEntries[] = {
-    {"_ICIKendallTau_pairwiseComparisons", (DL_FUNC) &_ICIKendallTau_pairwiseComparisons, 3},
     {"_ICIKendallTau_sortedIndex", (DL_FUNC) &_ICIKendallTau_sortedIndex, 1},
     {"_ICIKendallTau_compare_self", (DL_FUNC) &_ICIKendallTau_compare_self, 1},
     {"_ICIKendallTau_compare_both", (DL_FUNC) &_ICIKendallTau_compare_both, 2},

src/kendallc.cpp

@@ -131,14 +131,13 @@ inline double signC(double x) {
 //' Calculates ici-kendall-tau
 //' 
 //' Calculates kendall-tau, with consideration of missingness providing information.
-//' Uses the calculation of tau-b, and always uses the asymptotic approximation of 
-//' the p-value.
+//' Uses the calculation of tau-b.
 //' 
 //' @param x numeric vector
 //' @param y numeric vector
 //' @param perspective should we consider the "local" or "global" perspective?
 //' @param alternative what is the alternative for the p-value test?
-//' @param continuity logical: if true, a continuity correction is used
+//' @param continuity logical: if true, a continuity correction is applied to the p-value
 //' @param output used to control reporting of values for debugging
 //' 
 //' @details Calculates the information-content-informed Kendall-tau correlation measure.

tests/testthat/test-kendall-tau.R

@@ -126,6 +126,12 @@ test_that("include_only works as intended", {
 
   small_include6 = ici_kendalltau(x, include_only = include_test, diag_good = FALSE, return_matrix = FALSE)
   expect_equal(nrow(small_include6$cor), 2)
+
+  include_3 = list(s1 = "s1", s2 = c("s2", "s3"), s3 = "s4")
+  expect_error(ici_kendalltau(x, include_only = include_3, diag_good = FALSE, return_matrix = FALSE), "list of two vectors")
+
+  include_none = list(s1 = "s102", s2 = "s105")
+  expect_error(ici_kendalltau(x, include_only = include_none, diag_good = FALSE, return_matrix = FALSE), "No comparisons to do.")
 })
 
 test_that("completeness works correctly",{
@@ -245,3 +251,14 @@ test_that("errors and messages appear", {
   expect_message(ici_kendalltau(x_df), '`x_df` is a data.frame, converting to matrix ...')
   expect_message(pairwise_completeness(x_df), '`x_df` is a data.frame, converting to matrix ...')
 })
+
+test_that("check timing works", {
+  set.seed(1234)
+  x = matrix(rnorm(4000), nrow = 100, ncol = 40)
+  colnames(x) = paste0("s", seq(1, ncol(x)))
+
+  small_check = ici_kendalltau(x, check_timing = TRUE)
+  expect_equal(small_check$value[1], 5)
+  expect_equal(small_check$value[2], 780)
+  expect_lt(small_check$value[7], 0.05)
+})

tests/testthat/test-logging.R

@@ -0,0 +1,37 @@
+test_that("logger detection works", {
+  new_lib = tempfile()
+  dir.create(new_lib)
+  withr::with_libpaths(new_lib, {
+    expect_error(enable_logging(), "Logging requested")
+  })
+  unlink(new_lib, recursive = TRUE)
+})
+
+test_that("logging works", {
+  enable_logging("nomemory_logs.log")
+
+  set.seed(1234)
+  x = matrix(rnorm(5000), nrow = 50, ncol = 100)
+  colnames(x) = paste0("s", seq(1, ncol(x)))
+  ici_res = ici_kendalltau(x)
+
+  log_contents = readLines("nomemory_logs.log")
+
+  expect_false(all(grepl("Memory", log_contents)))
+
+  enable_logging("withmemory_logs.log", memory = TRUE)
+  ici_res = ici_kendalltau(x)
+  log_contents = readLines("withmemory_logs.log")  
+  expect_true(any(grepl("Memory", log_contents)))
+  unlink("nomemory_logs.log", recursive = TRUE)
+  unlink("withmemory_logs.log", recursive = TRUE)
+})
+
+test_that("progress works", {
+  show_progress()
+
+  set.seed(1234)
+  x = matrix(rnorm(5000), nrow = 50, ncol = 100)
+  colnames(x) = paste0("s", seq(1, ncol(x)))
+  expect_message(ici_kendalltau(x), "Processing missing values")
+})