new seqGetData(, .tolist=NA)

Author: zhengxwen

DESCRIPTION

@@ -2,11 +2,11 @@ Package: SeqArray
 Type: Package
 Title: Data management of large-scale whole-genome sequence variant calls
         using GDS files
-Version: 1.47.7
+Version: 1.47.8
 Date: 2025-03-31
 Depends: R (>= 3.5.0), gdsfmt (>= 1.31.1)
-Imports: methods, parallel, digest, IRanges, GenomicRanges, GenomeInfoDb,
-        Biostrings, S4Vectors
+Imports: methods, parallel, digest, S4Vectors, IRanges, GenomicRanges,
+        GenomeInfoDb, Biostrings
 LinkingTo: gdsfmt
 Suggests: Biobase, BiocGenerics, BiocParallel, RUnit, Rcpp, SNPRelate, crayon,
         knitr, markdown, rmarkdown, Rsamtools, VariantAnnotation

NAMESPACE

@@ -36,8 +36,8 @@ importFrom(utils, read.table, flush.console, write.table, str, tail,
 
 importFrom(S4Vectors, DataFrame, SimpleList)
 importClassesFrom(IRanges, IRanges)
-importFrom(IRanges, IRanges, IntegerList, NumericList, CharacterList,
-    DataFrameList)
+importFrom(IRanges, IRanges, LogicalList, IntegerList, NumericList,
+    CharacterList, RawList, FactorList, DataFrameList)
 importClassesFrom(GenomicRanges, GRanges, GRangesList)
 importFrom(GenomicRanges, GRanges)
 importMethodsFrom(GenomicRanges, granges)

NEWS

@@ -1,23 +1,28 @@
 CHANGES IN VERSION 1.48.0
 -------------------------
 
-UTILITIES
-
-    o Tweak display in `seqResetVariantID()`
-
-    o new argument 'start' in `seqResetVariantID()`
+NEW FEATURES
 
     o `seqAddValue()`: use bit1 for a logical vector; new argument
       'use_float32' for storing double
 
-    o use `crayon::silver()` instead of `crayon::blurred()` in the display since
-      RStudio blurs the screen output
+    o new argument 'start' in `seqResetVariantID()`
 
     o new argument 'digest' in `seqRecompress()` to add MD5 hash codes
 
     o `seqGetData(, "$chromosome")` returns chromosome codes in an object of
       'S4Vectors::Rle'
 
+    o `seqGetData(, .tolist=NA)` returns an extended list defined in IRanges
+      (e.g., IntegerList) when it is applicable
+
+UTILITIES
+
+    o Tweak display in `seqResetVariantID()`
+
+    o use `crayon::silver()` instead of `crayon::blurred()` in the display since
+      RStudio blurs the screen output
+
 BUG FIXES
 
     o `seqBlockApply()` should recover the filter when the user-specified

R/Utilities.R

@@ -10,13 +10,21 @@
 #######################################################################
 
 # R expressions called in C internally
-lang_eval <- list(
+.lang_eval <- list(
     new_rle = quote(new("Rle", values=values, lengths=lengths))
 )
 
+# Compressed Lists in IRanges
+.List_IRanges_value <- list(
+    LogicalList(), IntegerList(), NumericList(),
+    CharacterList(), RawList(), FactorList(),
+    "unlistData", "partitioning", "end"
+)
+
 .onLoad <- function(lib, pkg)
 {
-    .Call(SEQ_Pkg_Init, .dim_name, process_count, process_index, lang_eval)
+    .Call(SEQ_Pkg_Init, .dim_name, process_count, process_index,
+        .lang_eval, .List_IRanges_value)
     TRUE
 }
 

man/seqBlockApply.Rd

@@ -40,7 +40,9 @@ seqBlockApply(gdsfile, var.name, FUN, margin=c("by.variant"),
     \item{.padNA}{\code{TRUE}, pad a variable-length vector with NA if the
         number of data points for each variant is not greater than 1}
     \item{.tolist}{if \code{TRUE}, return a list of vectors instead of the
-        structure \code{list(length, data)} for variable-length data}
+        structure \code{list(length, data)} for variable-length data; \code{NA}
+        , return a compressed \code{List} defined in \pkg{IRanges} when it is
+        applicable}
     \item{.progress}{if \code{TRUE}, show progress information}
     \item{...}{optional arguments to \code{FUN}}
 }

man/seqGetData.Rd

@@ -19,7 +19,9 @@ seqGetData(gdsfile, var.name, .useraw=FALSE, .padNA=TRUE, .tolist=FALSE,
     \item{.padNA}{\code{TRUE}, pad a variable-length vector with NA if the
         number of data points for each variant is not greater than 1}
     \item{.tolist}{if \code{TRUE}, return a list of vectors instead of the
-        structure \code{list(length, data)} for variable-length data}
+        structure \code{list(length, data)} for variable-length data; \code{NA}
+        , return a compressed \code{List} defined in \pkg{IRanges} when it is
+        applicable}
     \item{.envir}{\code{NULL}, an environment object, a list or a
         \code{data.frame}}
 }
@@ -146,6 +148,10 @@ seqGetData(f, "annotation/info/AA", .padNA=FALSE)
 # or return a simplified vector
 seqGetData(f, "annotation/info/AA", .padNA=TRUE)
 
+# return a compressed list (CharacterList)
+seqGetData(f, "annotation/info/AA", .padNA=FALSE, .tolist=NA)
+
+
 # get annotation/format/DP, a variable-length dataset
 seqGetData(f, "annotation/format/DP")
 # $length              <- indicating the length of each variable-length data

src/GetData.cpp

@@ -855,14 +855,53 @@ static SEXP get_list(SEXP len, SEXP val, size_t elmsize, bool is_factor)
 				memcpy(RAW(vv), &RAW(val)[pt], nn);
 				break;
 			default:
-				throw ErrSeqArray("Not support data type for .tolist=TRUE.");
+				throw ErrSeqArray("Not support data type when '.tolist=TRUE'.");
 			}
 			pt += nn;
 		}
 	}
 	return rv_ans;
 }
 
+
+// .List_IRanges_value
+extern "C" SEXP OBJ_CompressedList = NULL;
+
+/// convert to a compressed list in IRanges
+static SEXP get_list2(SEXP len, SEXP val, bool is_factor)
+{
+	// get data type
+	int type_idx = -1;
+	switch (TYPEOF(val))
+	{
+		case LGLSXP:  type_idx = 0; break;
+		case INTSXP:  type_idx = 1; break;
+		case REALSXP: type_idx = 2; break;
+		case STRSXP:  type_idx = 3; break;
+		case RAWSXP:  type_idx = 4; break;
+		default:
+			throw ErrSeqArray("Not support data type when '.tolist=NA'.");
+	}
+	if (is_factor) type_idx = 5;
+	// new object
+	SEXP rv_ans = Rf_duplicate(VECTOR_ELT(OBJ_CompressedList, type_idx));
+	PROTECT(rv_ans);
+	// set @unlistData (OBJ_CompressedList[6]="unlistData")
+	R_do_slot_assign(rv_ans, VECTOR_ELT(OBJ_CompressedList, 6), val);
+	// get @partitioning (OBJ_CompressedList[7]="partitioning")
+	SEXP pt = R_do_slot(rv_ans, VECTOR_ELT(OBJ_CompressedList, 7));
+	// set @partitioning@end (OBJ_CompressedList[8]="end")
+	const int n = Rf_length(len);
+	SEXP end = PROTECT(NEW_INTEGER(n));
+	const int *s = INTEGER(len);
+	int *p = INTEGER(end), ed = 0;
+	for (int i=0; i < n; i++) p[i] = (ed += s[i]);
+	R_do_slot_assign(pt, VECTOR_ELT(OBJ_CompressedList, 8), end);
+	UNPROTECT(1);
+	// output
+	return rv_ans;
+}
+
 /// get data from annotation/info/VARIABLE, TODO
 static SEXP get_info(CFileInfo &File, TVarMap &Var, void *param)
 {
@@ -969,11 +1008,14 @@ static SEXP get_info(CFileInfo &File, TVarMap &Var, void *param)
 			default:
 				throw ErrSeqArray("Not support data type for .padNA=TRUE.");
 			}
-		} else if (P->tolist)
+		} else if (P->tolist)  // TRUE or NA
 		{
 			// convert to a list
 			size_t d2 = (Var.NDim < 2) ? 1 : dimcnt[1];
-			rv_ans = get_list(I32, val, d2, is_factor);
+			if ((P->tolist == TRUE) || (d2 != 1))
+				rv_ans = get_list(I32, val, d2, is_factor);
+			else
+				rv_ans = get_list2(I32, val, is_factor);
 		} else {
 			// create `list(length, data)`
 			rv_ans = PROTECT(NEW_LIST(2));
@@ -1369,9 +1411,9 @@ COREARRAY_DLL_EXPORT SEXP SEQ_GetData(SEXP gdsfile, SEXP var_name, SEXP UseRaw,
 	if (padNA == NA_LOGICAL)
 		Rf_error("'.padNA' must be TRUE or FALSE.");
 	// .tolist
+	if (!Rf_isLogical(ToList) || Rf_length(ToList)!=1)
+		Rf_error("'.tolist' must be TRUE, FALSE or NA.");
 	const int tolist = Rf_asLogical(ToList);
-	if (tolist == NA_LOGICAL)
-		Rf_error("'.tolist' must be TRUE or FALSE.");
 	// .envir
 	if (!Rf_isNull(Env))
 	{

src/SeqArray.cpp

@@ -1567,9 +1567,10 @@ COREARRAY_DLL_EXPORT SEXP SEQ_ProgressAdd(SEXP ref, SEXP inc)
 // ===========================================================
 
 extern SEXP LANG_NEW_RLE;
+extern SEXP OBJ_CompressedList;
 
 COREARRAY_DLL_EXPORT SEXP SEQ_Pkg_Init(SEXP dim_name, SEXP proc_cnt,
-	SEXP proc_idx, SEXP lang_eval)
+	SEXP proc_idx, SEXP lang_eval, SEXP list_val)
 {
 	// .dim_name
 	R_Geno_Dim2_Name = VECTOR_ELT(dim_name, 0);
@@ -1583,6 +1584,8 @@ COREARRAY_DLL_EXPORT SEXP SEQ_Pkg_Init(SEXP dim_name, SEXP proc_cnt,
 	R_Process_Index = INTEGER(proc_idx);
 	// lang_eval
 	LANG_NEW_RLE = VECTOR_ELT(lang_eval, 0);
+	// Compressed Lists in IRanges
+	OBJ_CompressedList = list_val;
 	// return
 	return R_NilValue;
 }
@@ -1651,7 +1654,7 @@ COREARRAY_DLL_EXPORT void R_init_SeqArray(DllInfo *info)
 
 	static R_CallMethodDef callMethods[] =
 	{
-		CALL(SEQ_Pkg_Init, 4),
+		CALL(SEQ_Pkg_Init, 5),
 		CALL(SEQ_ExternalName0, 0),         CALL(SEQ_ExternalName1, 1),
 		CALL(SEQ_ExternalName2, 2),         CALL(SEQ_ExternalName3, 3),
 		CALL(SEQ_ExternalName4, 4),         CALL(SEQ_ExternalName5, 5),