Skip to content

Commit

Permalink
lint
Browse files Browse the repository at this point in the history
  • Loading branch information
@dipterix
dipterix committed Sep 12, 2024
1 parent f4726dd commit 3a066b6
Show file tree
Hide file tree
Showing 11 changed files with 176 additions and 108 deletions.
9 changes: 6 additions & 3 deletions R/aaa-docs.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,15 +6,18 @@
#' @param x data to write to disk
#' @param method method to read table. For \code{'fst'}, the choices are
#' \describe{
#' \item{\code{'proxy'}}{do not read data to memory, query the table when needed;}
#' \item{\code{'proxy'}}{do not read data to memory, query the table when
#' needed;}
#' \item{\code{'data_table'}}{read as \code{\link[data.table]{data.table}};}
#' \item{\code{'data_frame'}}{read as \code{\link{data.frame}};}
#' \item{\code{'header_only'}}{read \code{'fst'} table header.}
#' }
#' For \code{'mat'}, the choices are
#' \describe{
#' \item{\code{'auto'}}{automatically try the native option, and then \code{'pymatreader'} if fails;}
#' \item{\code{'R.matlab'}}{use the native method (provided by \code{\link[R.matlab]{readMat}}); only support 'MAT 5.0' format;}
#' \item{\code{'auto'}}{automatically try the native option, and then
#' \code{'pymatreader'} if fails;}
#' \item{\code{'R.matlab'}}{use the native method (provided
#' by \code{\link[R.matlab]{readMat}}); only support 'MAT 5.0' format;}
#' \item{\code{'pymatreader'}}{use 'Python' library \code{'pymatreader'};}
#' \item{\code{'mat73'}}{use 'Python' library \code{'mat73'}.}
#' }
Expand Down
113 changes: 81 additions & 32 deletions R/aaa-generics-surface.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,7 +66,8 @@ new_surface <- function(
re$color <- color
contains <- c(contains, "color")
} else {
warning("Vertex `color` attribute has inconsistent length with the expected vertex length. The `color` attribute is discarded.")
warning("Vertex `color` attribute has inconsistent length with the ",
"expected vertex length. The `color` attribute is discarded.")
}
}

Expand All @@ -80,7 +81,9 @@ new_surface <- function(
re$annotations <- annotations
contains <- c(contains, "annotations")
} else {
warning("Vertex `annotations` attribute has inconsistent length with the expected vertex length. The `annotations` attribute is discarded.")
warning("Vertex `annotations` attribute has inconsistent length with ",
"the expected vertex length. ",
"The `annotations` attribute is discarded.")
}
}

Expand All @@ -93,7 +96,9 @@ new_surface <- function(
re$measurements <- measurements
contains <- c(contains, "measurements")
} else {
warning("Vertex `measurements` attribute has inconsistent length with the expected vertex length. The `measurements` attribute is discarded.")
warning("Vertex `measurements` attribute has inconsistent length with ",
"the expected vertex length. The `measurements` attribute is ",
"discarded.")
}
}

Expand All @@ -107,7 +112,9 @@ new_surface <- function(
re$time_series <- time_series
contains <- c(contains, "time_series")
} else {
warning("Vertex `time_series` attribute has inconsistent length with the expected vertex length. The `time_series` attribute is discarded.")
warning("Vertex `time_series` attribute has inconsistent length with ",
"the expected vertex length. The `time_series` attribute ",
"is discarded.")
}
}

Expand Down Expand Up @@ -139,7 +146,8 @@ format.ieegio_surface <- function(x, ...) {
sprintf(" # of Vertex : %d", ncol(x$geometry$vertices)),
sprintf(" # of Face index : %d", length(x$geometry$faces) / 3),
sprintf(" # of transforms : %d", length(x$geometry$transforms)),
sprintf(" Transform Targets : %s", paste(names(x$geometry$transforms), collapse = ", "))
sprintf(" Transform Targets : %s",
paste(names(x$geometry$transforms), collapse = ", "))
)
}
if(!is.null(x$color)) {
Expand All @@ -151,7 +159,8 @@ format.ieegio_surface <- function(x, ...) {
sprintf("`%s`", names(x$annotations$data_table)), collapse = ", "
)))
if(is.data.frame(x$annotations$label_table)) {
ss <- c(ss, sprintf(" # of labels: %d", nrow(x$annotations$label_table)))
ss <- c(ss, sprintf(" # of labels: %d",
nrow(x$annotations$label_table)))
} else {
ss <- c(ss, " No label table found?")
}
Expand Down Expand Up @@ -209,7 +218,8 @@ merge.ieegio_surface <- function(x, y, ...) {
has_grometry <- !is.null(x$geometry)

if(!has_grometry) {
stop("`merge.ieegio_surface`: the first element `x` MUST contain geometry (surface vertex nodes, face indices).")
stop("`merge.ieegio_surface`: the first element `x` MUST contain the ",
"geometry data (surface vertex nodes, face indices).")
}

n_verts <- ncol(x$geometry$vertices)
Expand Down Expand Up @@ -261,10 +271,12 @@ merge.ieegio_surface <- function(x, y, ...) {

if(x$sparse) {
if(length(x$annotations)) {
x$annotations$data_table <- get_annot_or_meas_full(x, TRUE, node_index, "annotations")
x$annotations$data_table <- get_annot_or_meas_full(
x, TRUE, node_index, "annotations")
}
if(length(x$measurements)) {
x$measurements$data_table <- get_annot_or_meas_full(x, TRUE, node_index, "measurements")
x$measurements$data_table <- get_annot_or_meas_full(
x, TRUE, node_index, "measurements")
}
if(length(x$color)) {
x$color <- get_color_fill(x, TRUE, node_index)
Expand All @@ -280,7 +292,9 @@ merge.ieegio_surface <- function(x, y, ...) {
for(y in additional_surfaces) {
if( !is.null(y$geometry) ) {
if(n_verts != ncol(y$geometry$vertices)) {
stop("One of the surface object contains geometry that has inconsistent number of vertices. Please check if the surface objects share the same number of vertex nodes.")
stop("One of the surface object contains geometry that has ",
"inconsistent number of vertices. Please check if the surface ",
"objects share the same number of vertex nodes.")
}
}

Expand Down Expand Up @@ -319,7 +333,10 @@ merge.ieegio_surface <- function(x, y, ...) {
key_x <- merged$Key[sel][[1]]
Label_x <- merged$Label_x[sel][[1]]
Label_y <- merged$Label_y[sel][[1]]
stop("Unable to merge two annotations with the same key but different labels. For example, key [", key_x, "] represents ", sQuote(Label_x), " in one dataset but ", sQuote(Label_y), " in another.")
stop("Unable to merge two annotations with the same key but ",
"different labels. For example, key [", key_x,
"] represents ", sQuote(Label_x), " in one dataset but ",
sQuote(Label_y), " in another.")
}
sel <- !label_table_y$Key %in% merged$Key
x$annotations$label_table <- rbind(x$annotations$label_table, y$annotations$label_table[sel, ])
Expand Down Expand Up @@ -382,7 +399,9 @@ merge.ieegio_surface <- function(x, y, ...) {
}

contains <- names(x)
contains <- contains[contains %in% c("geometry", "measurements", "time_series", "annotations", "color")]
contains <- contains[contains %in% c(
"geometry", "measurements", "time_series", "annotations", "color"
)]
cls <- c(
sprintf("ieegio_surface_contains_%s", contains),
class(x)
Expand Down Expand Up @@ -496,7 +515,8 @@ merge.ieegio_surface <- function(x, y, ...) {
#' @export
plot.ieegio_surface <- function(
x, method = c("basic", "full"), transform = 1L,
name = "auto", vlim = NULL, col = c("black", "white"), slice_index = NULL, ...) {
name = "auto", vlim = NULL, col = c("black", "white"),
slice_index = NULL, ...) {
method <- match.arg(method)

# DIPSAUS DEBUG START
Expand Down Expand Up @@ -579,7 +599,8 @@ plot.ieegio_surface <- function(
} else if (max_val > 1.1) {
max_val <- 255
}
col <- grDevices::rgb(red = rgb[,1], green = rgb[,2], blue = rgb[,3], maxColorValue = max_val)
col <- grDevices::rgb(red = rgb[,1], green = rgb[,2], blue = rgb[,3],
maxColorValue = max_val)
vert_color <- TRUE
}
},
Expand Down Expand Up @@ -610,7 +631,9 @@ plot.ieegio_surface <- function(
col <- grDevices::colorRampPalette(col)(256)
ncols <- 256
}
idx <- floor((val - vlim[[1]]) / (vlim[[2]] - vlim[[1]]) * (ncols - 0.1)) + 1
idx <- floor((val - vlim[[1]]) /
(vlim[[2]] - vlim[[1]]) *
(ncols - 0.1)) + 1
idx[idx <= 1] <- 1
idx[idx >= ncols] <- ncols
col <- col[idx]
Expand Down Expand Up @@ -639,7 +662,9 @@ plot.ieegio_surface <- function(
}
slice_values <- x$time_series$value[, slice_index, drop = FALSE]
slice_dim <- dim(slice_values)
idx <- floor((slice_values - vlim[[1]]) / (vlim[[2]] - vlim[[1]]) * (ncols - 0.1)) + 1
idx <- floor((slice_values - vlim[[1]]) /
(vlim[[2]] - vlim[[1]]) *
(ncols - 0.1)) + 1
idx[idx <= 1] <- 1
idx[idx >= ncols] <- ncols
col <- col[idx]
Expand Down Expand Up @@ -676,7 +701,8 @@ plot.ieegio_surface <- function(
helper_rgl_call("next3d")
helper_rgl_call("shade3d", mesh, col = col[i, ])
helper_rgl_call("next3d")
helper_rgl_call("text3d", 0, 0, 0, sprintf("Slice %d", slice_index[[i]]))
helper_rgl_call("text3d", 0, 0, 0,
sprintf("Slice %d", slice_index[[i]]))
}
# To trigger display

Expand Down Expand Up @@ -708,12 +734,18 @@ plot.ieegio_surface <- function(
helper_rgl_view({
rg <- apply(mesh$vb, 1, range)[, 1:3]
helper_rgl_call("shade3d", mesh, col = col)
helper_rgl_call("arrow3d", rg[1, ], rg[c(2, 3, 5)], s = 0.02, type = "line", col = "red")
helper_rgl_call("arrow3d", rg[1, ], rg[c(1, 4, 5)], s = 0.02, type = "line", col = "green")
helper_rgl_call("arrow3d", rg[1, ], rg[c(1, 3, 6)], s = 0.02, type = "line", col = "blue")
helper_rgl_call("text3d", texts = "Right", x = rg[c(2, 3, 5)], adj = c(1,1,1))
helper_rgl_call("text3d", texts = "Anterior", x = rg[c(1, 4, 5)], adj = c(1,1,1))
helper_rgl_call("text3d", texts = "Superior", x = rg[c(1, 3, 6)], adj = c(1,1,1))
helper_rgl_call("arrow3d", rg[1, ], rg[c(2, 3, 5)], s = 0.02,
type = "line", col = "red")
helper_rgl_call("arrow3d", rg[1, ], rg[c(1, 4, 5)], s = 0.02,
type = "line", col = "green")
helper_rgl_call("arrow3d", rg[1, ], rg[c(1, 3, 6)], s = 0.02,
type = "line", col = "blue")
helper_rgl_call("text3d", texts = "Right", x = rg[c(2, 3, 5)],
adj = c(1,1,1))
helper_rgl_call("text3d", texts = "Anterior", x = rg[c(1, 4, 5)],
adj = c(1,1,1))
helper_rgl_call("text3d", texts = "Superior", x = rg[c(1, 3, 6)],
adj = c(1,1,1))
helper_rgl_call("title3d", main = main, cex = 1.2)
})
}, {
Expand All @@ -739,9 +771,15 @@ plot.ieegio_surface <- function(
#' @param type type of the data; ignored if the file format is 'GIfTI'. For
#' 'FreeSurfer' files, supported types are
#' \describe{
#' \item{\code{'geometry'}}{contains positions of mesh vertex nodes and face indices;}
#' \item{\code{'annotations'}}{annotation file (usually with file extension \code{'annot'}) containing a color look-up table and an array of color keys. These files are used to display discrete values on the surface such as brain atlas;}
#' \item{\code{'measurements'}}{measurement file such as \code{'sulc'} and \code{'curv'} files, containing numerical values (often with continuous domain) for each vertex node}
#' \item{\code{'geometry'}}{contains positions of mesh vertex nodes and face
#' indices;}
#' \item{\code{'annotations'}}{annotation file (usually with file extension
#' \code{'annot'}) containing a color look-up table and an array of color keys.
#' These files are used to display discrete values on the surface such as
#' brain atlas;}
#' \item{\code{'measurements'}}{measurement file such as \code{'sulc'} and
#' \code{'curv'} files, containing numerical values (often with continuous
#' domain) for each vertex node}
#' }
#' @param format format of the file, see 'Arguments' section in
#' \code{\link[freesurferformats]{read.fs.surface}} (when file type is
Expand Down Expand Up @@ -818,8 +856,11 @@ read_surface <- function(file, format = "auto", type = NULL, ...) {

#' @rdname imaging-surface
#' @export
write_surface <- function(x, con, format = c("gifti", "freesurfer"),
type = c("geometry", "annotations", "measurements", "color", "time_series"), ...) {
write_surface <- function(
x, con, format = c("gifti", "freesurfer"),
type = c("geometry", "annotations", "measurements", "color",
"time_series"),
...) {

format <- match.arg(format)

Expand All @@ -831,7 +872,8 @@ write_surface <- function(x, con, format = c("gifti", "freesurfer"),
type <- match.arg(type)

if( type %in% c("color", "time_series") ) {
stop("Saving ", type, " data in FreeSurfer format has not been implemented.")
stop("Saving ", type,
" data in FreeSurfer format has not been implemented.")
}

if(!length(x[[type]])) {
Expand All @@ -846,7 +888,10 @@ write_surface <- function(x, con, format = c("gifti", "freesurfer"),
}

if(x$sparse && type == "measurements") {
warning("Saving ", type, " data with sparse index in FreeSurfer format is not supported. The result might be wrong. Please check it.")
warning("Saving ", type, " data with sparse index in ",
"FreeSurfer format is not supported. ",
"The result might be wrong. ",
"Please check it.")
}


Expand All @@ -860,14 +905,18 @@ write_surface <- function(x, con, format = c("gifti", "freesurfer"),
is.numeric(face_start) && face_start != 1) {
faces <- faces - face_start + 1L
}
freesurferformats::write.fs.surface(filepath = con, vertex_coords = vertices, faces = faces)
freesurferformats::write.fs.surface(
filepath = con, vertex_coords = vertices, faces = faces
)
},
"annotations" = {
n_verts <- 0
if( x$sparse ) {
start_index <- attr(x$sparse_node_index, "start_index")
n_verts <- max(x$sparse_node_index)
if(length(start_index) == 1 && !is.na(start_index) && is.numeric(start_index)) {
if(length(start_index) == 1 &&
!is.na(start_index) &&
is.numeric(start_index)) {
n_verts <- n_verts - start_index + 1
}
}
Expand Down
13 changes: 9 additions & 4 deletions R/aaa-generics-volume.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,11 @@ get_vox2fsl <- function(shape, pixdim, vox2ras) {
new_volume <- function(type, header, transforms, data, shape) {
use_expression <- FALSE
if(is.null(data)) {
class <- c(sprintf("ieegio_%s", type), "ieegio_header_only", "ieegio_volume")
class <- c(
sprintf("ieegio_%s", type),
"ieegio_header_only",
"ieegio_volume"
)
force(shape)
header_only <- TRUE
} else {
Expand Down Expand Up @@ -63,7 +67,7 @@ format.ieegio_volume <- function(x, ...) {
}

if(length(x$transforms)) {
transforms_str <- sapply(names(x$transforms), function(nm) {
transforms_str <- vapply(names(x$transforms), function(nm) {
mat <- x$transforms[[nm]]
mat <- apply(mat, 2, function(x) {
re <- sprintf("%.6f", x)
Expand All @@ -75,7 +79,7 @@ format.ieegio_volume <- function(x, ...) {
sprintf(" [%s]", paste(x, collapse = " "))
})
paste(c(sprintf(" %s:", nm), re), collapse = "\n")
})
}, FUN.VALUE = "")
transforms_str <- c(" Transforms:", transforms_str)
} else {
transforms_str <- " Transforms: none"
Expand Down Expand Up @@ -526,7 +530,8 @@ plot.ieegio_volume <- function(
vox_idx[vox_idx >= x_shape[1:3]] <- NA_integer_
x_shape_cumprod <- cumprod(x_shape)
multi <- c(1, x_shape_cumprod[1:2])
vox_idx <- colSums(vox_idx * multi) + 1L + x_shape_cumprod[[3]] * (slice_index - 1)
vox_idx <- colSums(vox_idx * multi) + 1L +
x_shape_cumprod[[3]] * (slice_index - 1)

vox_data <- array(x_data[vox_idx], dim = c(length(x_axis), length(y_axis)))

Expand Down
10 changes: 7 additions & 3 deletions R/aaa.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,9 +9,11 @@ NIFTI_XFORM_CODE <- list(
"NIFTI_XFORM_MNI_152" = "MNI152"
)

parse_svec <- function(text, sep = ',', connect = '-:|', sort = FALSE, unique = TRUE){
parse_svec <- function(
text, sep = ',', connect = '-:|', sort = FALSE, unique = TRUE){
connect <- unique(unlist(strsplit(connect, '')))
connect[connect %in% c('|', ':', '~')] <- paste0('\\', connect[connect %in% c('|', ':', '~')])
connect[connect %in% c('|', ':', '~')] <-
paste0('\\', connect[connect %in% c('|', ':', '~')])
if('-' %in% connect) {
connect <- c(connect[connect != "-"], "-")
}
Expand Down Expand Up @@ -70,7 +72,9 @@ parse_svec <- function(text, sep = ',', connect = '-:|', sort = FALSE, unique =
return(re)
}

deparse_svec <- function(nums, connect = '-', concatenate = TRUE, collapse = ',', max_lag = 1){
deparse_svec <- function(
nums, connect = '-', concatenate = TRUE, collapse = ',',
max_lag = 1){
nums <- nums[is.finite(nums)]
if(length(nums) == 0){
return('')
Expand Down
6 changes: 2 additions & 4 deletions R/bci2000-cache.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,8 @@ BCI2000Cache <- R6::R6Class(
.filearray = NULL,
assert_valid = function() {
if(!self$valid) {
stop("`BCI2000Cache`: the loaded cache was removed/changed. Please recache the data.")
stop("`BCI2000Cache`: the loaded cache was removed/changed. ",
"Please recache the data.")
}
},
finalize = function() {
Expand Down Expand Up @@ -43,9 +44,6 @@ BCI2000Cache <- R6::R6Class(
}
nchannels <- dim(x)[[2]]

# source_header <- x$get_header("source_header")

# channel_names <- source_header$parameters$Source$`Signal Properties`$DataIOFilter$ChannelNames$value
channel_table <- data.frame(
Channel = seq_len(nchannels),
Label = sprintf("Ch%d", seq_len(nchannels)),
Expand Down
Loading

0 comments on commit 3a066b6

Please # to comment.