diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index e7bad16..f4b17a4 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -1,84 +1,29 @@ -# For help debugging build failures open an issue on the RStudio community with the 'github-actions' tag. -# https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help on: push: - branches: - - main - - master + branches: [main, master] pull_request: - branches: - - main - - master + branches: [main, master] name: R-CMD-check jobs: R-CMD-check: - runs-on: ${{ matrix.config.os }} - - name: ${{ matrix.config.os }} (${{ matrix.config.r }}) - - strategy: - fail-fast: false - matrix: - config: - - {os: windows-latest, r: 'release'} - - {os: macOS-latest, r: 'release'} - - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - + runs-on: ubuntu-latest env: - R_REMOTES_NO_ERRORS_FROM_WARNINGS: true - RSPM: ${{ matrix.config.rspm }} GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - + R_KEEP_PKG_SOURCE: yes steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - - uses: r-lib/actions/setup-r@v1 + - uses: r-lib/actions/setup-r@v2 with: - r-version: ${{ matrix.config.r }} - - - uses: r-lib/actions/setup-pandoc@v1 + use-public-rspm: true - - name: Query dependencies - run: | - install.packages('remotes') - saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) - writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") - shell: Rscript {0} - - - name: Cache R packages - if: runner.os != 'Windows' - uses: actions/cache@v2 + - uses: r-lib/actions/setup-r-dependencies@v2 with: - path: ${{ env.R_LIBS_USER }} - key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} - restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- - - - name: Install system dependencies - if: runner.os == 'Linux' - run: | - while read -r cmd - do - eval sudo $cmd - done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))') - - - name: Install dependencies - run: | - remotes::install_deps(dependencies = TRUE) - remotes::install_cran("rcmdcheck") - shell: Rscript {0} + extra-packages: any::rcmdcheck + needs: check - - name: Check - env: - _R_CHECK_CRAN_INCOMING_REMOTE_: false - run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check") - shell: Rscript {0} - - - name: Upload check results - if: failure() - uses: actions/upload-artifact@main - with: - name: ${{ runner.os }}-r${{ matrix.config.r }}-results - path: check + - uses: r-lib/actions/check-r-package@v2 diff --git a/DESCRIPTION b/DESCRIPTION index 6cb3bbc..dac7a72 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: adept Type: Package Title: Adaptive Empirical Pattern Transformation -Version: 1.2 +Version: 1.3.0 Authors@R: c( person("Marta", "Karas", email = "marta.karass@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-5889-3970")), @@ -19,7 +19,7 @@ Description: Designed for optimal use in performing fast, License: GPL-3 Encoding: UTF-8 LazyData: true -RoxygenNote: 7.1.1 +RoxygenNote: 7.3.2 URL: https://github.com/martakarass/adept BugReports: https://github.com/martakarass/adept/issues Depends: R (>= 2.10) @@ -41,5 +41,8 @@ Imports: magrittr, dvmisc, parallel, - pracma + pracma, + assertthat, + future, + furrr Language: en-US diff --git a/R/maxAndTune.R b/R/maxAndTune.R index c4da073..158de0a 100644 --- a/R/maxAndTune.R +++ b/R/maxAndTune.R @@ -115,7 +115,9 @@ finetune_maxima <- function(s.TMP, tau2.nbh.x <- finetune.maxima.x[tau2.nbh] x.mat <- outer(tau2.nbh.x, tau1.nbh.x, FUN = "+") x.mat.VALID <- x.mat * tau12.mat.VALID - which.out <- which(x.mat.VALID == max(x.mat.VALID), arr.ind = TRUE)[1,] + which.out <- which.max(x.mat.VALID) + which.out = arrayInd(which.out, + .dim = dim(x.mat.VALID)) ## Define "tuned" start and end index point of identified pattern occurence ## within a time-series \code{x} @@ -219,10 +221,12 @@ maxAndTune <- function(x, out.list <- list() x.Fitted <- rep(NA, x.vl) + run_template_idx = !(is.null(template.idx.mat)) + finetune_is_maxima = !is.null(finetune) && finetune == "maxima" ## ------------------------------------------------------------------------- ## Fine-tuning components - if (!is.null(finetune) && finetune == "maxima"){ + if (finetune_is_maxima) { nbh.wing <- floor((finetune.maxima.nbh.vl + (finetune.maxima.nbh.vl %% 2) - 1)/2) } ## ------------------------------------------------------------------------- @@ -235,28 +239,37 @@ maxAndTune <- function(x, # if (max.empty < template.vl.min){ # break # } - if (all(is.na(similarity.mat))){ - break - } + # if (all(is.na(similarity.mat))){ + # break + # } - ## Determine current maximum value in similarity matrix - similarity.mat.MAX <- max(similarity.mat, na.rm = TRUE) - if (similarity.mat.MAX < similarity.measure.thresh) { - break - } ## Identify parameters s and tau corresponding to maximum of covariance matrix ## s: expressed as vector length ## tau: expressed as index of x vector ## Mar 5, 2019 @MK: fix the discrepancies caused by floating precision ## May 5, 2019 @MK: restore the previous code line here - similarity.mat.MAX.IDX <- which(similarity.mat == similarity.mat.MAX, arr.ind = TRUE)[1, ] + # get the index first, then check + similarity.mat.MAX.IDX <- which.max(similarity.mat) + similarity.mat.MAX = similarity.mat[similarity.mat.MAX.IDX] + ## Determine current maximum value in similarity matrix + # similarity.mat.MAX <- max(similarity.mat, na.rm = TRUE) + if (length(similarity.mat.MAX) == 0 || + length(similarity.mat.MAX.IDX) == 0 || + similarity.mat.MAX < similarity.measure.thresh) { + break + } + + # turn into row/column + similarity.mat.MAX.IDX = arrayInd(similarity.mat.MAX.IDX, + .dim = dim(similarity.mat)) # similarity.mat.MAX.IDX <- which(similarity.mat + tol > similarity.mat.MAX, arr.ind = TRUE)[1, ] tau.TMP <- similarity.mat.MAX.IDX[2] s.TMP <- template.vl[similarity.mat.MAX.IDX[1]] + ## Identify - if (!(is.null(template.idx.mat))){ + if (run_template_idx){ template.idx.TMP <- template.idx.mat[similarity.mat.MAX.IDX[1], similarity.mat.MAX.IDX[2]] } @@ -264,7 +277,7 @@ maxAndTune <- function(x, ## ------------------------------------------------------------------------- ## Fine-tuning - if (!is.null(finetune) && finetune == "maxima"){ + if (finetune_is_maxima){ finetune.out <- finetune_maxima(s.TMP, tau.TMP, nbh.wing, @@ -278,13 +291,14 @@ maxAndTune <- function(x, ## ------------------------------------------------------------------------- + # get the max cols, outside loop because does not use i or s.i + NArepl.cols.max <- tau.TMP + s.TMP - 2 + NArepl.cols.max <- min(max(1, NArepl.cols.max), x.vl) ## Fill similarity matrix with NA's at locations populated by an identified pattern for (i in 1:mat.nrow){ s.i <- template.vl[i] NArepl.cols.min <- tau.TMP - s.i + 2 NArepl.cols.min <- min(max(1, NArepl.cols.min), x.vl) - NArepl.cols.max <- tau.TMP + s.TMP - 2 - NArepl.cols.max <- min(max(1, NArepl.cols.max), x.vl) NArepl.cols <- NArepl.cols.min:NArepl.cols.max # print(NArepl.cols) similarity.mat[i, NArepl.cols] <- NA @@ -294,13 +308,17 @@ maxAndTune <- function(x, x.Fitted[(tau.TMP + 1):(tau.TMP + s.TMP - 2)] <- 1 ## Store current iteration-specific results - out.list[[length(out.list) + 1]] <- c(tau.TMP, s.TMP, similarity.mat.MAX, template.idx.TMP) + out.list[[length(out.list) + 1]] <- data.frame( + tau_i = tau.TMP, T_i = s.TMP, + sim_i = similarity.mat.MAX, + template_i = template.idx.TMP) } ## List to data frame - out.df <- as.data.frame(do.call(rbind, out.list)) - if (nrow(out.df) > 0) names(out.df) <- c("tau_i", "T_i", "sim_i", "template_i") + # out.df <- as.data.frame(do.call(rbind, out.list)) + out.df <- dplyr::bind_rows(out.list) + # if (nrow(out.df) > 0) names(out.df) <- c("tau_i", "T_i", "sim_i", "template_i") return(out.df) diff --git a/R/segmentPattern.R b/R/segmentPattern.R index c9e28ab..50b1232 100644 --- a/R/segmentPattern.R +++ b/R/segmentPattern.R @@ -63,6 +63,7 @@ #' which of the provided pattern templates yielded a similarity matrix value #' that corresponds to an identified pattern occurrence. #' Setting to \code{TRUE} may increase computation time. Default is \code{FALSE}. +#' @param verbose print diagnostic messages. #' #' @details #' Function implements Adaptive Empirical Pattern Transformation (ADEPT) method for pattern segmentation @@ -99,7 +100,7 @@ #' Karas, M., Straczkiewicz, M., Fadel, W., Harezlak, J., Crainiceanu, C.M., #' Urbanek, J.K. (2019). Adaptive empirical pattern #' transformation (ADEPT) with application to walking stride segmentation. -#' Biostatistics. https://doi.org/10.1093/biostatistics/kxz033 +#' Biostatistics. \doi{10.1093/biostatistics/kxz033} #' #' @examples #' ## Example 1: Simulate a time-series `x`. Assume that @@ -220,7 +221,7 @@ segmentPattern <- function(x, x.fs, template, pattern.dur.seq, - similarity.measure = "cov", + similarity.measure = c("cov", "cor"), similarity.measure.thresh = 0.0, x.adept.ma.W = NULL, finetune = NULL, @@ -230,29 +231,78 @@ segmentPattern <- function(x, run.parallel.cores = 1L, x.cut = TRUE, x.cut.vl = 6000, - compute.template.idx = FALSE){ + compute.template.idx = FALSE, + verbose = TRUE){ ## --------------------------------------------------------------------------- ## Check if correct objects were passed to the function - x.cut.vl <- as.integer(x.cut.vl) - if(!is.null(run.parallel.cores)) run.parallel.cores <- as.integer(run.parallel.cores) - if (!(all(is.numeric(x)) & is.atomic(x))) stop("x must be a numeric (atomic) vector.") - if (!(length(x.fs) == 1 & is.numeric(x.fs) & x.fs > 0 & is.atomic(x.fs))) stop("x.fs must be a positive numeric scalar.") - template.cond1 <- all(is.numeric(template)) & is.atomic(template) - template.cond2 <- is.list(template) & all(sapply(template, function(vec) all(is.numeric(vec)) & is.atomic(vec))) - if (!(template.cond1 || template.cond2)) stop("template must be a numeric (atomic) vector, or a list of numeric (atomic) vectors.") - if (!(all(is.numeric(pattern.dur.seq)) & is.atomic(pattern.dur.seq) & all(pattern.dur.seq > 0))) stop("pattern.dur.seq must be a numeric (atomic) vector of positive values.") - if (!(similarity.measure %in% c("cov", "cor"))) stop("similarity.measure must be one of: 'cov', 'cor'.") - if (!(is.null(x.adept.ma.W) || (length(x.adept.ma.W) == 1 & is.numeric(x.adept.ma.W) & x.adept.ma.W > 0))) stop("x.adept.ma.W must be NULL or a positive numeric scalar.") - if (!(is.null(finetune) || finetune == "maxima")) stop("finetune must be NULL or 'maxima'.") - if (!(is.null(finetune.maxima.ma.W) || (length(finetune.maxima.ma.W) == 1 & is.numeric(finetune.maxima.ma.W) & finetune.maxima.ma.W > 0))) stop("finetune.maxima.ma.W must be NULL or a positive numeric scalar.") - if (!(is.null(finetune.maxima.nbh.W) || (length(finetune.maxima.nbh.W) == 1 & is.numeric(finetune.maxima.nbh.W) & finetune.maxima.nbh.W > 0))) stop("finetune.maxima.nbh.W must be NULL or a positive numeric scalar.") - if (!(run.parallel %in% c(TRUE, FALSE))) stop("run.parallel must be a logical scalar.") - if (!(is.null(run.parallel.cores) || (length(run.parallel.cores) == 1 & is.integer(run.parallel.cores) & run.parallel.cores > 0))) stop("run.parallel.cores must me NULL or a positive integer scalar") - if (!(length(x.cut) == 1 & x.cut %in% c(TRUE, FALSE))) stop("x.cut must be a logical scalar.") - if (!(is.null(x.cut.vl) || (length(x.cut.vl) == 1 & is.integer(x.cut.vl) & x.cut.vl > 0))) stop("x.cut.vl must me NULL or a positive integer scalar") - if (!(length(compute.template.idx) == 1 & compute.template.idx %in% c(TRUE, FALSE))) stop("compute.template.idx must be a logical scalar.") + assertthat::assert_that( + is.numeric(x), + is.vector(x), + assertthat::is.number(x.fs), + x.fs > 0 + ) + + assertthat::assert_that( + is.numeric(pattern.dur.seq), + is.vector(pattern.dur.seq) + ) + + + assertthat::assert_that( + is.list(template) || is.vector(template) + ) + check_template_vector = function(template_vector) { + assertthat::assert_that( + is.vector(template_vector), + is.numeric(template_vector) + ) + } + if (is.list(template)) { + lapply(template, check_template_vector) + } else { + check_template_vector(template) + } + + similarity.measure = match.arg(similarity.measure) + assertthat::assert_that( + assertthat::is.number(similarity.measure.thresh) + ) + + assertthat::assert_that( + is.null(x.adept.ma.W) || assertthat::is.number(x.adept.ma.W) + ) + + assertthat::assert_that( + is.null(finetune) || + (assertthat::is.string(finetune) && + finetune == "maxima"), + is.null(finetune.maxima.ma.W) || + (assertthat::is.number(finetune.maxima.ma.W) && + finetune.maxima.ma.W > 0), + is.null(finetune.maxima.nbh.W) || + (assertthat::is.number(finetune.maxima.nbh.W) && + finetune.maxima.nbh.W > 0) + ) + + + assertthat::assert_that( + assertthat::is.flag(run.parallel), + is.null(run.parallel.cores) || assertthat::is.count(run.parallel.cores) + ) + + assertthat::assert_that( + assertthat::is.count(x.cut.vl), + x.cut.vl > 0, + assertthat::is.flag(x.cut) + ) + + + assertthat::assert_that( + assertthat::is.flag(compute.template.idx) + ) + ## --------------------------------------------------------------------------- @@ -273,9 +323,21 @@ segmentPattern <- function(x, if (!is.null(x.adept.ma.W)){ # W.vl <- x.adept.ma.W * x.fs + if (verbose) { + message( + "Smoothing x signal" + ) + } x.smoothed <- get.x.smoothed(x = x, W = x.adept.ma.W, x.fs = x.fs) + if (verbose) { + message( + paste0("Smoothed x signal for similarity matrix computation with ", + "moving average window of length: ", + round(x.adept.ma.W * x.fs)) + ) + } } else { x.smoothed <- x } @@ -289,9 +351,21 @@ segmentPattern <- function(x, ## Signal smoothing for fine tunning if (!is.null(finetune.maxima.ma.W) && finetune.maxima.ma.W > 0){ # W.vl <- finetune.maxima.ma.W * x.fs + if (verbose) { + message( + "Smoothing finetune signal" + ) + } finetune.maxima.x <- get.x.smoothed(x = x, W = finetune.maxima.ma.W, x.fs = x.fs) + if (verbose) { + message( + paste0("Smoothed x signal for similarity matrix computation with ", + "moving average window of length: ", + round(x.adept.ma.W * x.fs)) + ) + } } else { finetune.maxima.x <- x } @@ -325,18 +399,50 @@ segmentPattern <- function(x, # define number of cores to use in parallel mc.cores.val <- ifelse (run.parallel & (!(is.null(run.parallel.cores))), run.parallel.cores, 1L) - out.list <- parallel::mclapply(x.cut.seq, function(i){ + if (verbose) { + message("Calculating similarityMatrix") + } + mc.cores = getOption("mc.cores", mc.cores.val) + if (mc.cores > 0) { + future::plan(future::multisession, workers = mc.cores) + } + + out.list <- purrr::map(x.cut.seq, function(i){ ## Define current x part indices idx.i <- i : min((i + x.cut.vl + x.cut.margin), length(x)) - ## If we cannot fit the longest pattern, return NULL if (length(idx.i) <= max(template.vl)) return(NULL) + + list( + index_first = i, + x = x[idx.i], + x.smoothed = x.smoothed[idx.i], + finetune.maxima.x = finetune.maxima.x[idx.i] + ) + }, .progress = verbose) + if (verbose) { + message( + paste0( + "Data subset made for parallel processing, ", + length(out.list), " subsets") + ) + } + + # out.list <- parallel::mclapply(x.cut.seq, function(i){ + out.list <- furrr::future_map(out.list, function(val_list){ + i = val_list$index_first + id_x <- val_list$x + id_x.smoothed = val_list$x.smoothed + x_finetune.maxima.x = val_list$finetune.maxima.x + rm(val_list) + if (is.null(id_x)) return(NULL) + ## Compute similarity matrix - similarity.mat.i <- similarityMatrix(x = x.smoothed[idx.i], + similarity.mat.i <- similarityMatrix(x = id_x.smoothed, template.scaled = template.scaled, similarity.measure = similarity.measure) ## Compute template index matrix if (compute.template.idx){ - template.idx.mat.i <- templateIdxMatrix(x = x.smoothed[idx.i], + template.idx.mat.i <- templateIdxMatrix(x = id_x.smoothed, template.scaled = template.scaled, similarity.measure = similarity.measure) } @@ -345,13 +451,13 @@ segmentPattern <- function(x, template.idx.mat.i <- NULL } ## Run max and tine procedure - out.df.i <- maxAndTune(x = x[idx.i], + out.df.i <- maxAndTune(x = id_x, template.vl = template.vl, similarity.mat = similarity.mat.i, similarity.measure.thresh = similarity.measure.thresh, template.idx.mat = template.idx.mat.i, finetune = finetune, - finetune.maxima.x = finetune.maxima.x[idx.i], + finetune.maxima.x = x_finetune.maxima.x, finetune.maxima.nbh.vl = finetune.maxima.nbh.vl) ## Shift \tau parameter according to which part of signal x we are currently working with @@ -366,7 +472,7 @@ segmentPattern <- function(x, sim_i = numeric(), template_i = numeric())) } - }, mc.cores = getOption("mc.cores", mc.cores.val)) + }, .progress = verbose) ## --------------------------------------------------------------------------- ## Clear up after possibly multiple stride occurrences diff --git a/R/segmentWalking.R b/R/segmentWalking.R index 1e767c4..e22b737 100644 --- a/R/segmentWalking.R +++ b/R/segmentWalking.R @@ -70,11 +70,11 @@ RunningMean <- function(x, W, circular = FALSE){ #' (r_t)_t vector magnitude data #' of a stride. Default used is 0.5. #' @param mean_abs_diff_med_p_MAX A numeric scalar. Maximum value of MAD* of -#' Azimuth (az_)_t median for 3 subsequent valid strides. +#' Azimuth (`az_`)`_t` median for 3 subsequent valid strides. #' Here, MAD* stands for mean #' of 2 absolute differences between 3 subsequent values. Default used is 0.5. #' @param mean_abs_diff_med_t_MAX A numeric scalar. Maximum value of MAD* of -#' Elevation (el_)_t median for 3 subsequent valid strides. +#' Elevation (`el_`)`_t` median for 3 subsequent valid strides. #' Here, MAD* stands for mean #' of 2 absolute differences between 3 subsequent values. Default used is 0.2. #' @param mean_abs_diff_dur_MAX A numeric scalar. Maximum value of MAD* of @@ -93,6 +93,7 @@ RunningMean <- function(x, W, circular = FALSE){ #' that corresponds to an identified pattern occurrence. #' Setting to \code{TRUE} may increase computation time. #' Default is \code{FALSE}. +#' @param verbose print diagnostic messages. #' #' @return A \code{data.frame} with segmentation results. Each row #' describes one identified pattern occurrence: @@ -153,12 +154,16 @@ segmentWalking <- function(xyz, mean_abs_diff_dur_MAX = 0.2, compute.template.idx = FALSE, run.parallel = FALSE, - run.parallel.cores = 1){ + run.parallel.cores = 1, + verbose = TRUE){ # compute all spherical xyz <- as.matrix(xyz) - xyzptr <- as.data.frame(cbind(xyz, cart2sph(xyz))) - vm <- xyzptr[, 6] + stopifnot(ncol(xyz) == 3) + xyzptr <- as.data.frame(cart2sph(xyz)) + colnames(xyzptr) = c("theta", "phi", "r") + vm <- xyzptr[, "r"] + rm(xyz) # run adept pattern identification out <- segmentPattern( @@ -176,7 +181,10 @@ segmentWalking <- function(xyz, run.parallel.cores = run.parallel.cores, x.cut = TRUE, x.cut.vl = 6000, - compute.template.idx = compute.template.idx) + compute.template.idx = compute.template.idx, + verbose = verbose) + rm(vm) + # generate detailed summary of ADEPT-identified patterns out_desc <- matrix(nrow = nrow(out), ncol = 5) @@ -190,10 +198,10 @@ segmentWalking <- function(xyz, xyzptr_stride1 <- xyzptr[idx_i, ] # summarize i-th identified pattern data current out_desc[i, ] <- c( - median(xyzptr_stride1[,4]), # "med_p" - median(xyzptr_stride1[,5]), # "med_t" - diff(range(xyzptr_stride1[, 6])), # "ptp_r" - mean(abs(xyzptr_stride1[, 6] - mean(xyzptr_stride1[, 6]))), # vmc_r + median(xyzptr_stride1[,"theta"]), # "med_p" + median(xyzptr_stride1[,"phi"]), # "med_t" + diff(range(xyzptr_stride1[, "r"])), # "ptp_r" + mean(abs(xyzptr_stride1[, "r"] - mean(xyzptr_stride1[, "r"]))), # vmc_r T_i / xyz.fs # dur ) } diff --git a/README.Rmd b/README.Rmd index e285be9..a3076f0 100644 --- a/README.Rmd +++ b/README.Rmd @@ -4,12 +4,13 @@ output: fig_width: 3 --- - + [![CRAN status](https://www.r-pkg.org/badges/version/adept)](https://CRAN.R-project.org/package=adept) [![](https://cranlogs.r-pkg.org/badges/grand-total/adept)](https://cran.r-project.org/package=adept) [![](https://cranlogs.r-pkg.org/badges/last-month/adept)](https://cran.r-project.org/package=adept) -[![R build status](https://github.com/martakarass/adept/workflows/R-CMD-check/badge.svg)](https://github.com/martakarass/adept/actions) +[![R-CMD-check](https://github.com/martakarass/adept/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/martakarass/adept/actions/workflows/R-CMD-check.yaml) [![Codecov test coverage](https://codecov.io/gh/martakarass/adept/branch/master/graph/badge.svg)](https://codecov.io/gh/martakarass/adept?branch=master) + ```{r setup, include = FALSE} knitr::opts_chunk$set( diff --git a/README.md b/README.md index 79e350e..cdab684 100644 --- a/README.md +++ b/README.md @@ -1,20 +1,20 @@ - + [![CRAN status](https://www.r-pkg.org/badges/version/adept)](https://CRAN.R-project.org/package=adept) [![](https://cranlogs.r-pkg.org/badges/grand-total/adept)](https://cran.r-project.org/package=adept) [![](https://cranlogs.r-pkg.org/badges/last-month/adept)](https://cran.r-project.org/package=adept) -[![R build -status](https://github.com/martakarass/adept/workflows/R-CMD-check/badge.svg)](https://github.com/martakarass/adept/actions) +[![R-CMD-check](https://github.com/martakarass/adept/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/martakarass/adept/actions/workflows/R-CMD-check.yaml) [![Codecov test coverage](https://codecov.io/gh/martakarass/adept/branch/master/graph/badge.svg)](https://codecov.io/gh/martakarass/adept?branch=master) + ### Overview The `adept` package implements ADaptive Empirical Pattern Transformation -(ADEPT) method\[1\] for pattern segmentation from a time-series. ADEPT -is optimized to perform fast, accurate walking strides segmentation from +(ADEPT) method[^1] for pattern segmentation from a time-series. ADEPT is +optimized to perform fast, accurate walking strides segmentation from high-density data collected with a wearable accelerometer during walking. The method was validated using data collected with sensors worn at left wrist, left hip and both ankles. @@ -76,11 +76,11 @@ segmentPattern( The segmentation result is a data frame, where each row describes one identified pattern occurrence: - - `tau_i` - index of `x` where pattern starts, - - `T_i` - pattern duration, expressed in `x` vector length, - - `sim_i` - similarity between a template and `x`, - - `template_i` - index of a template best matched to a time-series `x` - (here: one template was used, hence all `template_i`’s equal 1). +- `tau_i` - index of `x` where pattern starts, +- `T_i` - pattern duration, expressed in `x` vector length, +- `sim_i` - similarity between a template and `x`, +- `template_i` - index of a template best matched to a time-series `x` + (here: one template was used, hence all `template_i`’s equal 1). We then assume a grid of potential pattern durations which contains the duration of the true pattern used in data simulation. A perfect match @@ -230,6 +230,7 @@ segmentPattern( similarity.measure = "cor", x.adept.ma.W = 0.1, compute.template.idx = TRUE) +#> Smoothing x signal for similarity matrix computation with moving average window of length: 10 #> tau_i T_i sim_i template_i #> 1 1 70 0.9865778 1 #> 2 70 70 0.9533684 2 @@ -266,14 +267,14 @@ Vignettes are available to better demonstrate package methods usage. precise walking stride segmentation from data collected during a combination of running, walking and resting exercises. We introduce how to segment data: - + 1. with the use of stride templates that were pre-computed based on data from an external study (attached to `adeptdata` package), 2. by deriving new stride templates in a semi-manual manner. ### References -1. Karas, M., Straczkiewicz, M., Fadel, W., Harezlak, J., Crainiceanu, - C., Urbanek, J.K. *Adaptive empirical pattern transformation (ADEPT) - with application to walking stride segmentation*, Submitted to - *Biostatistics*, 2018. +[^1]: Karas, M., Straczkiewicz, M., Fadel, W., Harezlak, J., + Crainiceanu, C., Urbanek, J.K. *Adaptive empirical pattern + transformation (ADEPT) with application to walking stride + segmentation*, Submitted to *Biostatistics*, 2018. diff --git a/adept.Rproj b/adept.Rproj index 345d2c7..593a68e 100644 --- a/adept.Rproj +++ b/adept.Rproj @@ -1,4 +1,5 @@ Version: 1.0 +ProjectId: acf7dd22-b696-48e6-a477-093261663a29 RestoreWorkspace: Default SaveWorkspace: Default diff --git a/man/figures/README-unnamed-chunk-2-1.png b/man/figures/README-unnamed-chunk-2-1.png index 69a2225..7db8bdd 100644 Binary files a/man/figures/README-unnamed-chunk-2-1.png and b/man/figures/README-unnamed-chunk-2-1.png differ diff --git a/man/figures/README-unnamed-chunk-5-1.png b/man/figures/README-unnamed-chunk-5-1.png index 98b14e2..be3d54b 100644 Binary files a/man/figures/README-unnamed-chunk-5-1.png and b/man/figures/README-unnamed-chunk-5-1.png differ diff --git a/man/figures/README-unnamed-chunk-5-2.png b/man/figures/README-unnamed-chunk-5-2.png index 8654af6..97b539c 100644 Binary files a/man/figures/README-unnamed-chunk-5-2.png and b/man/figures/README-unnamed-chunk-5-2.png differ diff --git a/man/figures/README-unnamed-chunk-5-3.png b/man/figures/README-unnamed-chunk-5-3.png index 886c662..099dbb5 100644 Binary files a/man/figures/README-unnamed-chunk-5-3.png and b/man/figures/README-unnamed-chunk-5-3.png differ diff --git a/man/figures/README-unnamed-chunk-8-1.png b/man/figures/README-unnamed-chunk-8-1.png index 21b7a98..6eb4017 100644 Binary files a/man/figures/README-unnamed-chunk-8-1.png and b/man/figures/README-unnamed-chunk-8-1.png differ diff --git a/man/segmentPattern.Rd b/man/segmentPattern.Rd index 7ec6112..bbb4a25 100644 --- a/man/segmentPattern.Rd +++ b/man/segmentPattern.Rd @@ -9,7 +9,7 @@ segmentPattern( x.fs, template, pattern.dur.seq, - similarity.measure = "cov", + similarity.measure = c("cov", "cor"), similarity.measure.thresh = 0, x.adept.ma.W = NULL, finetune = NULL, @@ -19,7 +19,8 @@ segmentPattern( run.parallel.cores = 1L, x.cut = TRUE, x.cut.vl = 6000, - compute.template.idx = FALSE + compute.template.idx = FALSE, + verbose = TRUE ) } \arguments{ @@ -94,6 +95,8 @@ Default is \code{6000} (recommended).} which of the provided pattern templates yielded a similarity matrix value that corresponds to an identified pattern occurrence. Setting to \code{TRUE} may increase computation time. Default is \code{FALSE}.} + +\item{verbose}{print diagnostic messages.} } \value{ A \code{data.frame} with segmentation results. Each row @@ -245,5 +248,5 @@ out Karas, M., Straczkiewicz, M., Fadel, W., Harezlak, J., Crainiceanu, C.M., Urbanek, J.K. (2019). Adaptive empirical pattern transformation (ADEPT) with application to walking stride segmentation. -Biostatistics. https://doi.org/10.1093/biostatistics/kxz033 +Biostatistics. \doi{10.1093/biostatistics/kxz033} } diff --git a/man/segmentWalking.Rd b/man/segmentWalking.Rd index f31e6b4..64da46e 100644 --- a/man/segmentWalking.Rd +++ b/man/segmentWalking.Rd @@ -20,7 +20,8 @@ segmentWalking( mean_abs_diff_dur_MAX = 0.2, compute.template.idx = FALSE, run.parallel = FALSE, - run.parallel.cores = 1 + run.parallel.cores = 1, + verbose = TRUE ) } \arguments{ @@ -64,12 +65,12 @@ of a stride. Default used is 0.05.} of a stride. Default used is 0.5.} \item{mean_abs_diff_med_p_MAX}{A numeric scalar. Maximum value of MAD* of -Azimuth (az_)_t median for 3 subsequent valid strides. +Azimuth (`az_`)`_t` median for 3 subsequent valid strides. Here, MAD* stands for mean of 2 absolute differences between 3 subsequent values. Default used is 0.5.} \item{mean_abs_diff_med_t_MAX}{A numeric scalar. Maximum value of MAD* of -Elevation (el_)_t median for 3 subsequent valid strides. +Elevation (`el_`)`_t` median for 3 subsequent valid strides. Here, MAD* stands for mean of 2 absolute differences between 3 subsequent values. Default used is 0.2.} @@ -92,6 +93,8 @@ DOES NOT WORK ON WINDOWS.} \item{run.parallel.cores}{An integer scalar. The number of cores to use for parallel execution. Defaults to 1L (no parallel). DOES NOT WORK ON WINDOWS.} + +\item{verbose}{print diagnostic messages.} } \value{ A \code{data.frame} with segmentation results. Each row