Skip to content

Commit

Permalink
Set make_tar_of_dir archive_control parameter a list.
Browse files Browse the repository at this point in the history
  • Loading branch information
@brgew
brgew committed Jan 5, 2024
1 parent 797918e commit c7828ab
Show file tree
Hide file tree
Showing 2 changed files with 87 additions and 33 deletions.
88 changes: 71 additions & 17 deletions R/io.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1092,8 +1092,64 @@ check_monocle_object_files <- function( directory_path, file_index, read_test=FA
}


# Check archive_control list.
check_archive_control <- function(archive_control=list()) {
allowed_control_parameters <- c('archive_type',
'archive_compression',
'archive_extra_flags')

allowed_archive_type <- c('tar',
'none')
allowed_archive_compression <- c('none',
'gzip',
'bzip2',
'xz')

error_string <- ''

if(!all(names(archive_control) %in% allowed_control_parameters)) {
error_string <- paste0(error_string, '\n', 'invalid control parameter')
}

if(!is.null(archive_control[['archive_type']]) &&
!(archive_control[['archive_type']] %in% allowed_archive_type)) {
error_string <- paste0(error_string, '\n', 'invalid archive_type "', archive_control[['archive_type']], '"')
}

if(!is.null(archive_control[['archive_compression']]) &&
!(archive_control[['archive_compression']] %in% allowed_archive_compression)) {
error_string <- paste0(error_string, '\n', 'invalid archive_compression "', archive_control[['archive_compression']], '"')
}

if(error_string != '') {
stop(paste0(stringr::str_trim(error_string), '\n'))
}
}


# Set and check archive_control list.
set_archive_control <- function(archive_control=list()) {

archive_control_out = archive_control

if(is.null(archive_control[['archive_type']])) {
archive_control_out[['archive_type']] <- 'tar'
}
if(is.null(archive_control[['archive_compression']])) {
archive_control_out[['archive_compression']] <- 'none'
}
if(is.null(archive_control[['archive_extra_flags']])) {
archive_control_out[['archive_extra_flags']] <- '--format=pax'
}

check_archive_control(archive_control_out)

return(archive_control_out)
}


# Make a tar file of an output directory.
make_tar_of_dir <- function(func_name, directory_path, archive_control) {
make_tar_of_dir <- function(func_name, directory_path, archive_control=list()) {
message('Info: making a tar file of the output directory...')
# Make a tar file of output directory, if requested.
if(archive_control[['archive_compression']] == 'gzip') {
Expand All @@ -1113,7 +1169,8 @@ make_tar_of_dir <- function(func_name, directory_path, archive_control) {
tryCatch({
tar(tarfile=archive_name,
files=directory_path,
compression=archive_control[['archive_compression']])
compression=archive_control[['archive_compression']],
extra_flags=archive_control[['archive_extra_flags']])
},
error=function(cond) {
stop(func_name, ': unable to write the archive file \'', archive_name, '\': ', cond, call.=FALSE)
Expand Down Expand Up @@ -1174,6 +1231,9 @@ make_tar_of_dir <- function(func_name, directory_path, archive_control) {
#' compression applied to the archive file. The acceptable
#' values are "none", "gzip", "bzip2", and "xz". The
#' default is "none".}
#' \item{archive_extra_flags}{a string with flags that are
#' passed to the operating system tar utility. The
#' default is "--format=pax".}
#' }
#'
#' @return none.
Expand All @@ -1189,14 +1249,10 @@ make_tar_of_dir <- function(func_name, directory_path, archive_control) {
#' @export
# Bioconductor forbids writing to user directories so examples
# is not run.
save_transform_models <- function( cds, directory_path, comment="", verbose=TRUE, archive_control=list(archive_type="tar", archive_compression="none")) {
if(is.null(archive_control[['archive_type']])) archive_control[['archive_type']] <- 'tar'
if(is.null(archive_control[['archive_compression']])) archive_control[['archive_compression']] <- 'none'
save_transform_models <- function( cds, directory_path, comment="", verbose=TRUE, archive_control=list()) {

assertthat::assert_that(archive_control[['archive_type']] %in% c('tar', 'none'),
msg=paste0("archive_type must be either \'none\' or \'tar\'"))
assertthat::assert_that(archive_control[['archive_compression']] %in% c('gzip', 'bzip2', 'xz', 'none'),
msg=paste0("archive_compression must be \'none\', \'gzip\', \'bzip2\', or \'xz\'."))
# Set and check archive control list.
archive_control <- set_archive_control(archive_control)

# Make a 'normalized' path string. The annoy index save function does not
# recognize tildes.
Expand Down Expand Up @@ -1645,6 +1701,9 @@ test_hdf5_assays <- function(cds) {
#' compression applied to the archive file. The acceptable
#' values are "none", "gzip", "bzip2", and "xz". The
#' default is "none".}
#' \item{archive_extra_flags}{a string with flags that are
#' passed to the operating system tar utility. The
#' default is "--format=pax".}
#' }
#' @section Notes:
#' \itemize{
Expand Down Expand Up @@ -1742,15 +1801,10 @@ test_hdf5_assays <- function(cds) {
# *** break load_transform_models() because load_transform_models() ***
# *** can read a save_monocle_objects() output directory. ***
#
save_monocle_objects <- function(cds, directory_path, hdf5_assays=FALSE, comment="", verbose=TRUE, archive_control=list(archive_type="tar", archive_compression="none")) {

if(is.null(archive_control[['archive_type']])) archive_control[['archive_type']] <- 'tar'
if(is.null(archive_control[['archive_compression']])) archive_control[['archive_compression']] <- 'none'
save_monocle_objects <- function(cds, directory_path, hdf5_assays=FALSE, comment="", verbose=TRUE, archive_control=list()) {

assertthat::assert_that(archive_control[['archive_type']] %in% c('tar', 'none'),
msg=paste0("archive_type must be either \'none\' or \'tar\'"))
assertthat::assert_that(archive_control[['archive_compression']] %in% c('gzip', 'bzip2', 'xz', 'none'),
msg=paste0("archive_compression must be \'none\', \'gzip\', \'bzip2\', or \'xz\'."))
# Set and check the archive control list.
archive_control <- set_archive_control(archive_control)

# Make a 'normalized' path string. The annoy index save function does not
# recognize tildes.
Expand Down
32 changes: 16 additions & 16 deletions R/matrix.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -144,13 +144,13 @@ check_matrix_control <- function(matrix_control=list(), control_type=c('unrestri
error_string <- ''

if(!all(names(matrix_control) %in% allowed_control_parameters)) {
error_string <- paste0('invalid control parameter')
error_string <- paste0(error_string, '\n', 'invalid control parameter')
}

if(check_conditional == FALSE) {
if(!(is.null(matrix_control[['matrix_class']])) &&
!(matrix_control[['matrix_class']] %in% allowed_matrix_class)) {
error_string <- paste0('\ninvalid matrix_class "', matrix_control[['matrix_class']], '"')
error_string <- paste0(error_string, '\n', 'invalid matrix_class "', matrix_control[['matrix_class']], '"')
}

if(matrix_control[['matrix_class']] == 'BPCells') {
Expand All @@ -163,7 +163,7 @@ check_matrix_control <- function(matrix_control=list(), control_type=c('unrestri
stop('check_matrix_control: unknown control type \'', control_type, '\'')
if(!(is.null(matrix_control[['matrix_mode']])) &&
!(matrix_control[['matrix_mode']] %in% allowed_values)) {
error_string <- paste0('\ninvalid matrix_mode "', matrix_control[['matrix_mode']], '"')
error_string <- paste0(error_string, '\n', 'invalid matrix_mode "', matrix_control[['matrix_mode']], '"')
}

if(control_type == 'unrestricted')
Expand All @@ -175,38 +175,38 @@ check_matrix_control <- function(matrix_control=list(), control_type=c('unrestri
stop('check_matrix_control: unknown control type \'', control_type, '\'')
if(!(is.null(matrix_control[['matrix_type']])) &&
!(matrix_control[['matrix_type']] %in% allowed_values)) {
error_string <- paste0('\ninvalid matrix_type "', matrix_control[['matrix_type']], '"')
error_string <- paste0(error_string, '\n', 'invalid matrix_type "', matrix_control[['matrix_type']], '"')
}

if(!(is.null(matrix_control[['matrix_compress']])) &&
!(is.logical(matrix_control[['matrix_compress']]))) {
error_string <- paste0('\nmatrix_compress value must be a logical type')
error_string <- paste0(error_string, '\n', 'matrix_compress value must be a logical type')
}

if(!(is.null(matrix_control[['matrix_path']])) &&
!(is.character(matrix_control[['matrix_path']]))) {
error_string <- paste0('\nmatrix_path value must be a character type')
error_string <- paste0(error_string, '\n', 'matrix_path value must be a character type')
}

if(!(is.null(matrix_control[['matrix_buffer_size']])) &&
!(is.integer(matrix_control[['matrix_buffer_size']]))) {
error_string <- paste0('\nmatrix_buffer_size value must be an integer type')
error_string <- paste0(error_string, '\n', 'matrix_buffer_size value must be an integer type')
}

if(!(is.null(matrix_control[['matrix_bpcells_copy']])) &&
!(is.logical(matrix_control[['matrix_bpcells_copy']]))) {
error_string <- paste0('\nmatrix_bpcells_copy value must be a logical type')
error_string <- paste0(error_string, '\n', 'matrix_bpcells_copy value must be a logical type')
}
}
}
else {
# Check matrix_class value.
if(is.null(matrix_control[['matrix_class']])) {
error_string <- '\nmatrix_class not set'
error_string <- paste0(error_string, '\n', 'matrix_class not set')
}
else
if(!(matrix_control[['matrix_class']] %in% allowed_matrix_class)) {
error_string <- paste0('\ninvalid matrix_class "', matrix_control[['matrix_class']], '\n')
error_string <- paste0(error_string, '\n', 'invalid matrix_class "', matrix_control[['matrix_class']], '"')
}

if(matrix_control[['matrix_class']] == 'BPCells') {
Expand All @@ -219,12 +219,12 @@ check_matrix_control <- function(matrix_control=list(), control_type=c('unrestri
else
stop('check_matrix_control: unknown control type \'', control_type, '\'')
if(!(matrix_control[['matrix_type']] %in% allowed_values)) {
error_string <- paste0('\nbad matrix_type "', matrix_control[['matrix_type']], '"\n')
error_string <- paste0(error_string, '\n', 'bad matrix_type "', matrix_control[['matrix_type']], '"')
}

# Check matrix_compress value.
if(!is.logical(matrix_control[['matrix_compress']])) {
error_string <- '\nmatrix_compress must be as logical type'
error_string <- paste0(error_string, '\n', 'matrix_compress must be as logical type')
}

# Check matrix_mode value.
Expand All @@ -236,22 +236,22 @@ check_matrix_control <- function(matrix_control=list(), control_type=c('unrestri
else
stop('check_matrix_control: unknown control type \'', control_type, '\'')
if(!(matrix_control[['matrix_mode']] %in% allowed_values)) {
error_string <- paste0('\ninvalid matrix_mode "', matrix_control[['matrix_mode']], '"')
error_string <- paste0(error_string, '\n', 'invalid matrix_mode "', matrix_control[['matrix_mode']], '"')
}

if(matrix_control[['matrix_mode']] == 'dir') {
# Check matrix_path value.
if(!(is.character(matrix_control[['matrix_path']]))) {
error_string <- paste0('\nbad matrix_path "', matrix_control[['matrix_path']], '"')
error_string <- paste0(error_string, '\n', 'bad matrix_path "', matrix_control[['matrix_path']], '"')
}

# Check matrix_buffer_size.
if(!(is.integer(matrix_control[['matrix_buffer_size']]))) {
error_string <- paste0('\nmatrix_buffer_size must be an integer')
error_string <- paste0(error_string, '\n', 'matrix_buffer_size must be an integer')
}
}
if(!is.logical(matrix_control[['matrix_bpcells_copy']])) {
error_string <- paste0('\nmatrix_bpcells_copy value must be a logical type')
error_string <- paste0(error_string, '\n', 'matrix_bpcells_copy value must be a logical type')
}
}
}
Expand Down

0 comments on commit c7828ab

Please sign in to comment.