Merge pull request #56 from mandymejia/12.0

12.0

.Rbuildignore

@@ -2,7 +2,6 @@
 ^\.Rproj\.user$
 ^README\.Rmd$
 ^\.github$
-^appveyor\.yml$
 ^vignettes$
 ^LICENSE\.md$
 ^CRAN-RELEASE$

.github/workflows/R-CMD-check.yaml

@@ -1,4 +1,4 @@
-# Workflow derived from https://github.com/r-lib/actions/tree/master/examples
+# 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:
@@ -8,51 +8,22 @@ on:
 
 name: R-CMD-check
 
-jobs:
+jobs: 
   R-CMD-check:
-    runs-on: ${{ matrix.config.os }}
-
-    name: ${{ matrix.config.os }} (${{ matrix.config.r }})
-
-    strategy:
-      fail-fast: false
-      matrix:
-        config:
-          - {os: macOS-latest,   r: 'release'}
-          - {os: windows-latest, r: 'release'}
-          - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
-          - {os: ubuntu-latest,   r: 'release'}
-          - {os: ubuntu-latest,   r: 'oldrel-1'}
-
+    runs-on: ubuntu-latest
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
       R_KEEP_PKG_SOURCE: yes
-
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v3
 
-      - uses: r-lib/actions/setup-pandoc@v1
-
-      - uses: r-lib/actions/setup-r@v1
+      - uses: r-lib/actions/setup-r@v2
         with:
-          r-version: ${{ matrix.config.r }}
-          http-user-agent: ${{ matrix.config.http-user-agent }}
           use-public-rspm: true
 
-      - uses: r-lib/actions/setup-r-dependencies@v1
+      - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          extra-packages: rcmdcheck
-
-      - uses: r-lib/actions/check-r-package@v1
+          extra-packages: any::rcmdcheck
+          needs: check
 
-      - name: Show testthat output
-        if: always()
-        run: find check -name 'testthat.Rout*' -exec cat '{}' \; || true
-        shell: bash
-
-      - 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

CRAN-SUBMISSION

@@ -0,0 +1,3 @@
+Version: 0.12.2
+Date: 2023-08-12 20:49:46 UTC
+SHA: c99106242136b9f2e9b6c06726df52a3937caac5

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: ciftiTools
 Type: Package
 Title: Tools for Reading, Writing, Viewing and Manipulating CIFTI Files
-Version: 0.11.0
+Version: 0.12.2
 Authors@R: c(
     person(given = "Amanda",
            family = "Mejia",

NAMESPACE

@@ -15,6 +15,7 @@ S3method(summary,surf)
 S3method(summary,xifti)
 export(ROY_BIG_BL)
 export(add_surf)
+export(apply_parc)
 export(apply_xifti)
 export(as.cifti)
 export(as.xifti)
@@ -30,6 +31,7 @@ export(convert_xifti)
 export(dilate_mask_surf)
 export(edit_mask_surf)
 export(erode_mask_surf)
+export(even_vert_samp)
 export(expand_color_pal)
 export(fix_xifti)
 export(get_wb_cmd_path)
@@ -76,6 +78,7 @@ export(select_xifti)
 export(separateCIfTI)
 export(separate_cifti)
 export(separatecii)
+export(set_names_xifti)
 export(smoothCIfTI)
 export(smoothGIfTI)
 export(smooth_cifti)

NEWS.md

@@ -1,3 +1,15 @@
+# 12.0 (Jul 28, 2023)
+
+New features
+* Proper writing out of `dlabel` CIFTI data. Fixed problems if multiple columns or with subcortical data.
+* Add `even_vert_samp`.
+* Add `apply_parc`.
+* Add `set_names_xifti`.
+* Add `NA_color` argument to `view_xifti_surface`.
+* Add `shadows` argument to `view_xifti_surface`.
+* `mask_surf` takes in a `"surf"` object now.
+* Misc. documentation and warning improvements.
+
 # 11.0 (Jan 23, 2023)
 
 Changes to default behaviors

R/apply_parc.R

@@ -0,0 +1,69 @@
+#' Apply function over locations in each parcel
+#'
+#' Apply a function across all locations in each parcel. By default, the mean
+#' value in each parcel is calculated.
+#'
+#' @param xii The \code{"xifti"} data to apply the function over, within each
+#'  parcel.
+#' @param parc The \code{"xifti"} "dlabel" parcellation. Each parcel is defined
+#'  by a unique key in the label table. If there are multiple columns, only the
+#'  first column will be used. Alternatively, \code{parc} can just be a vector
+#'  of keys whose length is the number of data locations in \code{"xii"}.
+#' @param FUN A function that takes as input an \eqn{M \times N} matrix (\eqn{M}
+#'  locations in a given parcel, and \eqn{N} measurements/columns in \code{xii})
+#'  and outputs a constant-sized (\eqn{Q}) numeric vector.
+#' @param mwall_value If there is a medial wall in \code{xii}, what should value
+#'  should medial wall locations be replaced with prior to calculation?
+#'  Default: \code{NA}.
+#' @param ... Additional arguments to \code{FUN}.
+#'
+#' @return A \eqn{P \times Q} matrix, where \eqn{P} is the number of parcels and
+#'  \eqn{Q} is the length of the output of \code{FUN}. (For \code{mean},
+#'  \eqn{Q = 1}).
+#'
+#' @export
+#'
+apply_parc <- function(xii, parc, FUN=mean, mwall_value=NA, ...){
+  # Arg checks
+  stopifnot(is.xifti(xii))
+  stopifnot(is.xifti(parc))
+
+  # Replace medial wall and convert `xifti` to matrix.
+  xii <- move_from_mwall(xii, value=mwall_value)
+  if (nrow(xii) != nrow(parc)) {
+    stop(
+      "`xii` has ", nrow(xii), " locations (including any medial wall), but ",
+      "`parc` has ", nrow(parc), " locations. They need to have the same resolution."
+    )
+  }
+  xii <- as.matrix(xii)
+
+  # Convert `parc` to vector.
+  if (ncol(parc) > 1) { ciftiTools_warn("Using the first column of `parc`.") }
+  parc_names <- rownames(parc$meta$cifti$labels[[1]])
+  parc_keys <- parc$meta$cifti$labels[[1]]$Key
+  parc <- as.matrix(parc)[,1]
+
+  nP <- length(parc_keys)
+  nV <- nrow(xii)
+  nT <- ncol(xii)
+
+  # In case the keys are not 1 through nP
+  parc <- as.numeric(factor(parc, levels=parc_keys))
+
+  # Compute function for each parcel.
+  out <- vector("list", nP)
+  names(out) <- parc_names
+  for (ii in seq(length(parc_keys))) {
+    out[ii] <- FUN(xii[parc==ii,], ...)
+  }
+
+  # Check that the output length is the same for each parcel.
+  stopifnot(length(unique(lapply(out, dim)))==1)
+
+  # Return.
+  do.call(rbind, out)
+
+  # [TO DO]: could consider using matrix multiplication, instead, for mean/avg.
+  # Scrubbing paper should have code for this.
+}

R/convert_xifti.R

@@ -235,12 +235,12 @@ convert_to_dscalar <- function(x, cifti_target_fname=NULL, names=NULL) {
 
     cmd <- paste(
       "-cifti-change-mapping", x,
-      "ROW", cifti_target_fname, "-scalar"
+      "ROW", sys_path(cifti_target_fname), "-scalar"
     )
 
     names_fname <- tempfile()
-    cat(names, file = names_fname, sep = "\n")
-    cmd <- paste(cmd, "-name-file", names_fname)
+    writeLines(names, names_fname)
+    cmd <- paste(cmd, "-name-file", sys_path(names_fname))
     run_wb_cmd(cmd)
 
     return(cifti_target_fname)
@@ -305,8 +305,8 @@ convert_to_dtseries <- function(
     stopifnot(file.exists(x))
 
     cmd <- paste(
-      "-cifti-change-mapping", x,
-      "ROW", cifti_target_fname, "-series",
+      "-cifti-change-mapping", sys_path(x),
+      "ROW", sys_path(cifti_target_fname), "-series",
       time_step, time_start, "-unit", toupper(time_unit)
     )
 

R/even_vert_samp.R

@@ -0,0 +1,34 @@
+#' Evenly sample vertices of mesh
+#'
+#' Get a subset of the mesh vertices that are spatially evenly-sampled, by
+#'  resampling the mesh and choosing the original vertices closest (Euclidian
+#'  distance) to the new vertices.
+#'
+#' @param surf A \code{"surf"} object
+#' @param n_vert The desired number of vertices in the evenly-spaced sample.
+#'  Note that the actual size of the subset will likely be close to but not
+#'  exactly \code{n_vert} because it depends on the size of the resampled
+#'  surface.
+#'
+#' @return An integer vector giving the indices of the vertices in the subset.
+#'
+#' @export
+even_vert_samp <- function(surf, n_vert) {
+  stopifnot(is.surf(surf))
+  stopifnot(is.numeric(n_vert) && length(n_vert)==1)
+  stopifnot(n_vert>0 && n_vert==round(n_vert))
+
+  vert_og <- t(surf$vertices) # 3 x original_res
+  vert_rs <- t(resample_surf(surf, n_vert)$vertices) # 3 x n_vert
+
+  # The size of the resampled surface is not exactly `n_vert`.
+  n_vert <- ncol(vert_rs)
+
+  vmask <- rep(NA, n_vert)
+  for (ii in seq(n_vert)) {
+    vdist <- colSums((vert_og - vert_rs[,ii])^2)
+    vmask[ii] <- which.min(vdist)
+  }
+
+  vmask
+}

R/info_cifti.R

@@ -149,7 +149,7 @@ get_misc_meta_from_cifti_xml <- function(xml, intent=3000) {
 #'
 #' Extract intent-specific Metadata from CIFTI header XML (first "MatrixIndicesMap" entry)
 #'
-#' @param x List representing "MatrixIndicesMap" entry XML
+#' @param xml List representing "MatrixIndicesMap" entry XML
 #'  (\code{xifti$CIFTI$Matrix[[2]]})
 #' @param intent The CIFTI's NIFTI intent code
 #'
@@ -201,7 +201,7 @@ get_intn_meta_from_cifti_xml <- function(xml, intent=3000) {
 #'
 #' Extract data-related metadata from CIFTI header XML (second "MatrixIndicesMap" entry)
 #'
-#' @param x List representing "MatrixIndicesMap" entry XML
+#' @param xml List representing "MatrixIndicesMap" entry XML
 #'  (\code{xifti$CIFTI$Matrix[[3]]})
 #' @param intent The CIFTI's NIFTI intent code. Not used right now, but might be
 #'  used later. Default: \code{3000} (NIFTI_INTENT_UNKNOWN)
@@ -341,7 +341,9 @@ header_cifti <- function(cifti_fname){
   if (length(out) == 0) {
     stop(
       "Workbench command '", paste(sys_path(ciftiTools.getOption("wb_path")), cmd), 
-      "' failed."
+      "' failed. This might happen when trying to read a CIFTI file located ",
+      "on the cloud, in which case you can try downloading the CIFTI locally, ",
+      "reading it in, and then deleting the local copy."
     )
   }
   out

R/is.xifti.R

@@ -432,7 +432,7 @@ is.xifti_meta <- function(x) {
 is.xifti <- function(x, messages=TRUE) {
   if (!messages) { return(suppressMessages(is.xifti(x, messages=TRUE))) }
 
-  if (!is.list(x)) { message("x must be a list.\n"); return(FALSE) }
+  if (!is.list(x)) { message("`x` must be a list.\n"); return(FALSE) }
 
   y <- template_xifti()
   if (!match_exactly(names(x), names(y))) { 

R/make_xifti_components.R

@@ -103,7 +103,8 @@ make_cortex <- function(
       }
 
       run_wb_cmd(paste(
-        "-metric-merge", cortex, "-metric", cortex_original, idx_string
+        "-metric-merge", sys_path(cortex), 
+        "-metric", sys_path(cortex_original), idx_string
       ))
     }
 

R/newdata_xifti.R

@@ -6,7 +6,7 @@
 #'  \code{newdata} should be a \eqn{V \times Q} matrix. If \eqn{Q}
 #'  is not equal to \eqn{T}, then any column names or label tables will be
 #'  removed. (A "dlabel" will be converted to a "dscalar".)
-#' @param xifti The \code{"xifti"}
+#' @inheritParams xifti_Param
 #' @param newdata The \eqn{V \times T} matrix of data values to replace those
 #'  in \code{xifti} with. The left cortex vertices should be at the top, right
 #'  cortex vertices in the middle, and subcortex vertices at the bottom (when

R/read_cifti_flat.R

@@ -92,7 +92,8 @@ read_cifti_flat <- function(
     )
 
     run_wb_cmd(paste(
-      "-metric-merge", gifti_fname, "-metric", gifti_fname_original, idx_string
+      "-metric-merge", sys_path(gifti_fname), 
+      "-metric", sys_path(gifti_fname_original), idx_string
     ))
   }
 

R/resample_cifti.R

@@ -91,6 +91,10 @@ resample_cifti_wrapper <- function(
 #'  putting them together. (The subcortex is not resampled.)
 #'
 #'  Can accept a \code{"xifti"} object as well as a path to a CIFTI-file.
+#' 
+#'  If surface data is included, it will be resampled with the barycentric
+#'  method even if \code{resamp_method=="adaptive"} because the barycentric
+#'  method is recommended for surface geometry data.  
 #'
 #' @param x The CIFTI file name or \code{"xifti"} object to resample. If
 #'  \code{NULL}, the result will be a \code{"xifti"} with resampled surfaces

R/resample_cifti_from_template.R

@@ -75,10 +75,16 @@ resample_cifti_from_template <- function(
     write_spheres(sphereL_target_fname, sphereR_target_fname, resamp_res)
 
     if ("left" %in% brainstructures) {
-      cmd <- paste(cmd, "-left-spheres", sphereL_original_fname, sphereL_target_fname)
+      cmd <- paste(
+        cmd, "-left-spheres", 
+        sys_path(sphereL_original_fname), sys_path(sphereL_target_fname)
+      )
     }
     if ("right" %in% brainstructures) {
-      cmd <- paste(cmd, "-right-spheres", sphereR_original_fname, sphereR_target_fname)
+      cmd <- paste(
+        cmd, "-right-spheres", 
+        sys_path(sphereR_original_fname), sys_path(sphereR_target_fname)
+      )
     }
   }
 

R/resample_surf.R

@@ -1,11 +1,11 @@
 #' Resample a \code{"surf"} object
 #'
-#' Resample a \code{"surf"} by writing it to a GIFTI, using the Connectome
+#' Resample a \code{"surf"} object by writing it to a GIFTI, using the Connectome
 #'  Workbench to resample it, and then reading the new file. The barycentric 
 #'  resampling method, which is recommended for anatomical surfaces, will be 
 #'  used. 
 #'
-#' @param surf A \code{"surf"}
+#' @param surf A \code{"surf"} object
 #' @param resamp_res The desired resolution
 #' @param hemisphere \code{"left"} or \code{"right"}. Only used if not indicated by 
 #'  \code{surf$hemisphere}. An error will be raised if it does not match the 

R/rox_args_docs.R

@@ -375,6 +375,8 @@ NULL
 #' @param bg Background color. \code{NULL} will use \code{"white"}. Does not affect
 #'  the color legend or color bar if printed separately: those will always have
 #'  white backgrounds.
+#' @param NA_color The color for the medial wall and \code{NA} values. Default:
+#'  \code{"white"}. Also used to color the entire surface for `view_surf`.
 #' @param alpha Transparency value for mesh coloring, between 0 and 1. Default:
 #'  \code{1.0} (no transparency).
 #' @param edge_color Outline each edge in this color. Default: \code{NULL} (do