Merge pull request #36 from mandymejia/9.0

9.0

.Rbuildignore

@@ -18,3 +18,4 @@
 ^inst/extdata/MNI152_T1_2mm\.nii\.gz$
 ^README_media$
 ^tests/run_ciftiTools_tests\.R$
+^codecov\.yml$

.github/workflows/test-coverage.yaml

@@ -0,0 +1,30 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/master/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+
+name: test-coverage
+
+jobs:
+  test-coverage:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: r-lib/actions/setup-r@v1
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v1
+        with:
+          extra-packages: covr
+
+      - name: Test coverage
+        run: covr::codecov()
+        shell: Rscript {0}

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: ciftiTools
 Type: Package
 Title: Tools for Reading, Writing, Viewing and Manipulating CIFTI Files
-Version: 0.8.1
+Version: 0.9.0
 Authors@R: c(
     person(given = "Amanda",
            family = "Mejia",
@@ -52,7 +52,6 @@ Suggests:
     manipulateWidget,
     knitr,
     rmarkdown,
-    papayar,
     png,
     testthat (>= 3.0.0)
 Roxygen: list(markdown = TRUE)

NAMESPACE

@@ -1,34 +1,16 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method("!=",xifti)
-S3method("%%",xifti)
-S3method("%/%",xifti)
-S3method("*",xifti)
-S3method("+",xifti)
-S3method("-",xifti)
-S3method("/",xifti)
-S3method("<",xifti)
-S3method("<=",xifti)
-S3method("==",xifti)
-S3method(">",xifti)
-S3method(">=",xifti)
-S3method("^",xifti)
-S3method(abs,xifti)
+S3method(Math,xifti)
+S3method(Ops,xifti)
+S3method(Summary,xifti)
 S3method(as.matrix,xifti)
-S3method(ceiling,xifti)
 S3method(dim,xifti)
-S3method(exp,xifti)
-S3method(floor,xifti)
-S3method(log,xifti)
 S3method(plot,surf)
 S3method(plot,xifti)
 S3method(print,summary.surf)
 S3method(print,summary.xifti)
 S3method(print,surf)
 S3method(print,xifti)
-S3method(round,xifti)
-S3method(sign,xifti)
-S3method(sqrt,xifti)
 S3method(summary,surf)
 S3method(summary,xifti)
 export(ROY_BIG_BL)

NEWS.md

@@ -1,3 +1,23 @@
+# 9.0 (TBD)
+
+* Replace coveralls with codecov
+* Add `convention` and `orientation_labels` to `view_xifti_volume` (default: neurological, instead of radiological)
+* Add `together_ncol` to `view_xifti_*`
+* Add citation to welcome message
+* Better file path management for system commands
+* Allow `"xifti"` objects to have different resolutions in the left and right cortex
+* Better use of S3 group methods for Math, Ops, Summary functions
+* Add `fname` to `view_comp`
+* Misc. patches
+
+# 8.0 (February 1, 2022)
+
+* Add more support for reading in v1 CIFTI files
+* Better handling of file paths
+* Better handling of optional `"xifti"` metadata
+* `remove_xifti` can delete individual subcortical structures now
+* Add `scale_xifti` which works like `scale`
+
 # 7.0 (November 16, 2021)
 
 * Add `view_comp`, and the argument `together` to `view_xifti_surface` and `view_xifti_volume`

R/add_surf.R

@@ -19,32 +19,57 @@ add_surf <- function(xifti, surfL=NULL, surfR=NULL) {
   if (!is.xifti(xifti)) { stop("The input \"xifti\" object is invalid.") }
 
   resamp_res <- infer_resolution(xifti)
+  if (all(resamp_res %in% c(NA, NaN))) { 
+    resamp_res <- NULL
+  }
 
   # Left.
   if (!is.null(surfL)) {
     if (!is.null(xifti$surf$cortex_left)) { 
       ciftiTools_msg("Overwriting existing geometry for left cortex.\n") 
     }
-    if (is.character(surfL) && length(surfL)==1 && surfL %in% c("very inflated", "inflated", "midthickness")) {
-      xifti$surf$cortex_left <- load_surf("left", surfL, resamp_res)
+    rr1 <- resamp_res[1]
+    if (is.null(resamp_res) || rr1 %in% c(NA, NaN)) {
+      warning("Could not infer left cortex resolution, so the left surface cannot be added.")
     } else {
-      z <- read_surf(surfL, "left")
-      if (!is.null(resamp_res) && nrow(z$vertices) != resamp_res) { z <- resample_surf(z, resamp_res, "left") }
-      xifti$surf$cortex_left <- z
+      if (rr1==0) { rr1 <- NULL }
+      if (is.character(surfL) && length(surfL)==1 && surfL %in% c("very inflated", "inflated", "midthickness")) {
+        xifti$surf$cortex_left <- load_surf("left", surfL, rr1)
+      } else {
+        z <- read_surf(surfL, "left")
+        if (!is.null(rr1) && (nrow(z$vertices) != rr1)) { 
+          z <- resample_surf(z, rr1, "left") 
+        }
+        xifti$surf$cortex_left <- z
+      }
+      if (!is.null(rr1) && (nrow(z$vertices) != rr1)) { 
+        warning("The left surface might not match the data resolution, even after any resampling.")
+      }
     }
   }
 
-  # Right.
+  # right.
   if (!is.null(surfR)) {
     if (!is.null(xifti$surf$cortex_right)) { 
       ciftiTools_msg("Overwriting existing geometry for right cortex.\n") 
     }
-    if (is.character(surfR) && length(surfR)==1 && surfR %in% c("very inflated", "inflated", "midthickness")) {
-      xifti$surf$cortex_right <- load_surf("right", surfR, resamp_res=resamp_res)
+    rr2 <- resamp_res[2]
+    if (is.null(resamp_res) || rr2 %in% c(NA, NaN)) {
+      warning("Could not infer right cortex resolution, so the right surface cannot be added.")
     } else {
-      z <- read_surf(surfR, "right")
-      if (!is.null(resamp_res) && nrow(z$vertices) != resamp_res) { z <- resample_surf(z, resamp_res, "right") }
-      xifti$surf$cortex_right <- z
+      if (rr2==0) { rr2 <- NULL }
+      if (is.character(surfR) && length(surfR)==1 && surfR %in% c("very inflated", "inflated", "midthickness")) {
+        xifti$surf$cortex_right <- load_surf("right", surfR, rr2)
+      } else {
+        z <- read_surf(surfR, "right")
+        if (!is.null(rr2) && (nrow(z$vertices) != rr2)) { 
+          z <- resample_surf(z, rr2, "right") 
+        }
+        xifti$surf$cortex_right <- z
+      }
+      if (!is.null(rr2) && (nrow(z$vertices) != rr2)) { 
+        warning("The right surface might not match the data resolution, even after any resampling.")
+      }
     }
   }
 

R/apply_xifti.R

@@ -48,10 +48,9 @@ apply_xifti <- function(xifti, margin=c(1,2), FUN, ...) {
     }
 
     # Convert to dscalar. 
-    # [TO DO]: consider keeping dlabel if all values are labels?
     out <- xifti
-    if (xifti$meta$cifti$intent != 3006) {
-      out <- convert_to_dscalar(out)
+    if (is.null(xifti$meta$cifti$intent) || xifti$meta$cifti$intent != 3006) {
+      out <- convert_xifti(out, "dscalar")
     }
 
     # Use names from applied function (e.g. quantiles) if consistent

R/combine_xifti.R

@@ -1,8 +1,8 @@
 #' Combine \code{"xifti"}s with non-overlapping brain structures
 #' 
 #' Combine two to three \code{"xifti"}s with non-overlapping brain structures into
-#'  a single \code{"xifti"}. The names and intent of the first will be used (if 
-#'  present).
+#'  a single \code{"xifti"}. The names, intent, and surfaces of the first will be used,
+#'  if present. To add more surfaces to the result, use \code{\link{add_surf}}.
 #' 
 #' @param ... The \code{"xifti"} objects
 #' @param xii_list Alternatively, a list of \code{"xifti"} objects. If specified,

R/convert_xifti.R

@@ -11,7 +11,11 @@
 #'  be unique. They may not all occur in the \code{"xifti"} data, but every
 #'  datapoint in the \code{"xifti"} must occur in \code{values}. Data will be 
 #'  mapped to integers from $0$ to $N-1$ (the "keys"), with $N$ being the
-#'  number of \code{values}.
+#'  number of \code{values}. They will be sorted.
+#' 
+#'  If \code{values} is a named vector, the rownames of the label table in the resulting
+#'  \code{"xifti"} will be those names. Otherwise, the rownames will be the values
+#'  themselves.  
 #' @param nsig Take this many significant digits for the data values. If 
 #'  \code{Inf} (default), do not round.
 #' @param colors (Optional) "ROY_BIG_BL", the name of a ColorBrewer palette 
@@ -26,8 +30,6 @@
 convert_to_dlabel <- function(x, cifti_target_fname=NULL,
   values=NULL, nsig=Inf, colors="Set2", add_white=TRUE, return_conversion_table=FALSE) {
 
-  # [TO DO] use names(values) as rownames of label table
-
   # If the input is a CIFTI file name, we need to read it into R.
   input_is_xifti <- is.xifti(x, messages=FALSE)
   if (!input_is_xifti) { 
@@ -68,8 +70,8 @@ convert_to_dlabel <- function(x, cifti_target_fname=NULL,
     }
   } else {
     # Check the new values.
-    if (any(duplicated(values))) { warning("Removing duplicate `values`.\n") }
-    values <- sort(unique(values))
+    if (any(duplicated(values))) { warning("Removing duplicate `values`.\n"); values <- unique(values) }
+    values <- sort(values)
   }
   if (length(values) > 1000) { warning("Over 1000 unique `values` in the `xifti`.\n") }
   conversion_table <- data.frame(values=values, label=seq(length(values))-1)
@@ -122,12 +124,11 @@ convert_to_dlabel <- function(x, cifti_target_fname=NULL,
   col_table <- rbind(seq(N_)-1, col_table)
   rownames(col_table) <- c("Key", "Red", "Green", "Blue", "Alpha")
   col_table <- as.data.frame(t(col_table))
-  rownames(col_table) <- values
+  rownames(col_table) <- if (!is.null(names(values))) { names(values) } else { values }
 
   # Add components to xifti
   T_ <- ncol_xifti(x)
   if (is.null(x$meta$cifti$names)) {
-    # [TO DO]: Double check this is correct default name?
     x$meta$cifti$names <- paste("Column", seq(T_))
   }
   x$meta$cifti$labels <- rep(list(col_table), T_)
@@ -196,7 +197,6 @@ convert_to_dscalar <- function(x, cifti_target_fname=NULL, names=NULL) {
       }
       x$meta$cifti$names <- as.character(names)
     } else {
-      # [TO DO]: Double check this is correct default name?
       x$meta$cifti$names <- paste("Column", seq(T_))
     }
 

R/expect_equal_xifti.R

@@ -29,9 +29,4 @@ expect_equal_xifti <- function(xii1, xii2) {
   if (!is.null(xii1$meta$cifti$intent) && !is.null(xii2$meta$cifti$intent)) {
     testthat::expect_equal(xii1$meta$cifti$intent, xii2$meta$cifti$intent)
   }
-
-  # [TO DO]: Define this?
-  # if (!is.null(xii1$meta$cifti$brainstructure) && !is.null(xii2$meta$cifti$brainstructure)) {
-  #   testthat::expect_equal(xii1$meta$cifti$brainstructure, xii2$meta$cifti$brainstructure)
-  # }
 }

R/fix_gifti_mwalls.R

@@ -1,26 +1,26 @@
 #' Fix GIFTI medial wall
-#' 
-#' Replace implicit medial wall values (not indicated in ROI, but are in 
+#'
+#' Replace implicit medial wall values (not indicated in ROI, but are in
 #'  \code{mwall_values}) with explicit medial wall values (indicated in ROI)
 #'  in a metric GIFTI file.
-#' 
+#'
 #' @param metric_fname File path to the data GIFTI
 #' @param fixed_metric_fname File path to the revised data GIFTI
 #' @param ROI_fname File path to the ROI GIFTI
 #' @param fixed_ROI_fname File path to the revised ROI GIFTI
-#' @param mwall_values The values to use to infer the medial wall. Default: 
+#' @param mwall_values The values to use to infer the medial wall. Default:
 #'  \code{c(NA, NaN)}.
-#' 
+#'
 #' @return \code{NULL}, invisibly
-#' 
+#'
 #' @importFrom gifti readgii writegii
-#' 
+#'
 #' @keywords internal
-#' 
+#'
 fix_gifti_mwall <- function(
-  metric_fname, fixed_metric_fname, 
+  metric_fname, fixed_metric_fname,
   ROI_fname, fixed_ROI_fname, mwall_values=c(NA, NaN)){
-  
+
   stopifnot(length(mwall_values) > 0)
 
   gii_ROIcortex <- readgii(ROI_fname)
@@ -30,9 +30,9 @@ fix_gifti_mwall <- function(
     gii_cortex <- readgii(metric_fname)
     new_mwall <- !apply(
       matrix(
-        do.call(cbind, gii_cortex$data) %in% mwall_values, 
+        do.call(cbind, gii_cortex$data) %in% mwall_values,
         ncol=length(gii_cortex$data)
-      ), 
+      ),
       1, all
     )
 
@@ -46,12 +46,20 @@ fix_gifti_mwall <- function(
       for (ii in seq_len(length(gii_cortex$data))) {
         gii_cortex$data[[ii]][,][!new_mwall] <- 0
       }
+
+      # `gifti` cannot work with this combo.
+      if (all(gii_cortex$data_info$DataType=="NIFTI_TYPE_INT32")) {
+        if (all(gii_cortex$data_info$Encoding=="GZipBase64Binary")) {
+          gii_cortex$data_info$Encoding <- rep("ASCII", length(gii_cortex$data_info$Encoding))
+        }
+      }
+
       writegii(gii_cortex, fixed_metric_fname)
     } else {
       warn_msg <- paste(warn_msg, "The data did not have any vertices with values constantly in `mwall_values`. Leaving the ROI/medial wall mask empty.")
     }
     ciftiTools_warn(warn_msg)
   }
 
-  invisible(NULL) 
-}
+  invisible(NULL)
+}

R/is.xifti.R

@@ -278,11 +278,10 @@ is.xifti_meta <- function(x) {
   }
   if ((!is.null(x$cortex$medial_wall_mask$left)) && !is.null(x$cortex$medial_wall_mask$right)) {
     if (length(x$cortex$medial_wall_mask$left) != length(x$cortex$medial_wall_mask$right)) {
-      message(paste(
-        "The medial wall masks must be the same lengths, because the cortices",
-        "must have the same number of vertices."
-      ))
-      return(FALSE)
+      # warning(
+      #   'Support for `"xifti"` objects in which the cortices do not have the same number of vertices is limited.'
+      # )
+      #return(FALSE)
     }
   }
 
@@ -338,8 +337,6 @@ is.xifti_meta <- function(x) {
         ))
         return(FALSE)
       }
-      # [TO DO]: check `bs_expected`
-      # I forget if `brainstructures` are those originally in the `xifti`, or just those present now?
     }
 
     if (!is.null(x$cifti$intent)) {

R/make_xifti.R

@@ -102,6 +102,9 @@
 #'  This argument is probably not necessary for end users: reading a CIFTI
 #'  should be done by providing \code{cifti_fname}, and for reading separate
 #'  GIFTI/NIFTI components \code{cifti_info} is not applicable.
+#' 
+#'  Column names from \code{cortexL} and \code{cortexR} take precedence over column
+#'  names from \code{cifti_info}.
 #' @param surfL,surfR (Optional) Surface geometries for the left or right cortex. 
 #'  Can be a surface GIFTI file path or \code{"surf"} object; see 
 #'  \code{\link{make_surf}} for a full description of valid inputs.
@@ -171,7 +174,6 @@ make_xifti <- function(
 
     ## Column names and label table, if intent is not dtseries.
     if (is.null(xifti$meta$cifti$intent) || xifti$meta$cifti$intent != 3002) {
-      # [TO DO]: Explain that the names are being overwritten?
       xifti$meta$cifti$names <- x$col_names
       if (!is.null(x$label_table)) {
         xifti$meta$cifti$labels <- rep(list(x$label_table), ncol(x$data))

R/make_xifti_components.R

@@ -97,7 +97,6 @@ make_cortex <- function(
         )
       } else {
         # Guess func.
-        # [TO DO] warn user?
         cortex <- file.path(
           tempdir(), paste0(basename(cortex_original), ".func.gii")
         )