[med-svn] [r-bioc-s4vectors] 01/04: New upstream version 0.16.0
Andreas Tille
tille at debian.org
Tue Nov 7 17:02:52 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-bioc-s4vectors.
commit 1e3bcb77213a05038866729b20867c3f3177421d
Author: Andreas Tille <tille at debian.org>
Date: Tue Nov 7 17:43:51 2017 +0100
New upstream version 0.16.0
---
DESCRIPTION | 30 ++-
NAMESPACE | 47 +++--
NEWS | 54 ++++-
R/DataFrame-class.R | 15 +-
R/FilterRules-class.R | 13 +-
R/{Linteger-class.R => LLint-class.R} | 151 +++++++-------
R/List-class.R | 107 ++++++----
R/Pairs-class.R | 32 ++-
R/Rle-class.R | 28 +--
R/Rle-utils.R | 6 +-
R/Vector-class.R | 2 +-
R/aggregate-methods.R | 2 +-
R/{str-utils.R => character-utils.R} | 0
R/{int-utils.R => integer-utils.R} | 0
R/logical-utils.R | 32 ---
R/subsetting-utils.R | 49 ++---
R/zzz.R | 6 +-
TODO | 6 +-
inst/doc/RleTricks.pdf | Bin 42909 -> 43115 bytes
inst/doc/S4QuickOverview.pdf | Bin 175848 -> 175848 bytes
inst/include/S4Vectors_defines.h | 2 +-
inst/include/S4Vectors_interface.h | 49 ++++-
inst/include/_S4Vectors_stubs.c | 52 ++++-
inst/unitTests/test_List-class.R | 6 +-
man/{Linteger-class.Rd => LLint-class.Rd} | 152 +++++++-------
man/List-utils.Rd | 4 +
man/Rle-class.Rd | 1 -
man/Rle-runstat.Rd | 6 +-
man/Vector-class.Rd | 2 +
man/{str-utils.Rd => character-utils.Rd} | 2 +-
src/AEbufs.c | 69 ++++---
src/{Linteger_class.c => LLint_class.c} | 190 +++++++++---------
src/R_init_S4Vectors.c | 54 ++---
src/Rle_class.c | 44 ++---
src/Rle_utils.c | 4 +-
src/S4Vectors.h | 87 +++++---
src/{str_utils.c => character_utils.c} | 2 +-
src/{int_utils.c => integer_utils.c} | 0
src/logical_utils.c | 316 +++++++++++++-----------------
src/safe_arithm.c | 24 +--
src/vector_utils.c | 2 +-
41 files changed, 905 insertions(+), 743 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 7434b5b..9f2cc5b 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,5 +1,5 @@
Package: S4Vectors
-Title: S4 implementation of vectors and lists
+Title: S4 implementation of vector-like and list-like objects
Description: The S4Vectors package defines the Vector and List virtual classes
and a set of generic functions that extend the semantic of ordinary
vectors and lists in R. Package developers can easily implement
@@ -8,27 +8,25 @@ Description: The S4Vectors package defines the Vector and List virtual classes
interest (e.g. DataFrame, Rle, and Hits) are implemented in the
S4Vectors package itself (many more are implemented in the IRanges
package and in other Bioconductor infrastructure packages).
-Version: 0.14.7
+Version: 0.16.0
Encoding: UTF-8
Author: H. Pagès, M. Lawrence and P. Aboyoun
Maintainer: Bioconductor Package Maintainer <maintainer at bioconductor.org>
biocViews: Infrastructure, DataRepresentation
Depends: R (>= 3.3.0), methods, utils, stats, stats4, BiocGenerics (>=
- 0.21.1)
-Imports: methods, utils, stats, stats4, BiocGenerics
+ 0.23.3)
Suggests: IRanges, GenomicRanges, Matrix, ShortRead, graph, data.table,
RUnit
License: Artistic-2.0
-Collate: S4-utils.R show-utils.R utils.R normarg-utils.R
- Linteger-class.R isSorted.R subsetting-utils.R vector-utils.R
- logical-utils.R int-utils.R str-utils.R eval-utils.R
- map_ranges_to_runs.R DataTable-class.R Annotated-class.R
- Vector-class.R Vector-comparison.R Vector-setops.R
- Vector-merge.R Hits-class.R Hits-comparison.R Hits-setops.R
- Rle-class.R Rle-utils.R List-class.R List-comparison.R
- List-utils.R SimpleList-class.R HitsList-class.R
- DataFrame-class.R expand-methods.R FilterRules-class.R
- aggregate-methods.R shiftApply-methods.R split-methods.R
- Pairs-class.R zzz.R
+Collate: S4-utils.R show-utils.R utils.R normarg-utils.R LLint-class.R
+ isSorted.R subsetting-utils.R vector-utils.R integer-utils.R
+ character-utils.R eval-utils.R map_ranges_to_runs.R
+ DataTable-class.R Annotated-class.R Vector-class.R
+ Vector-comparison.R Vector-setops.R Vector-merge.R Hits-class.R
+ Hits-comparison.R Hits-setops.R Rle-class.R Rle-utils.R
+ List-class.R List-comparison.R List-utils.R SimpleList-class.R
+ HitsList-class.R DataFrame-class.R expand-methods.R
+ FilterRules-class.R aggregate-methods.R shiftApply-methods.R
+ split-methods.R Pairs-class.R zzz.R
NeedsCompilation: yes
-Packaged: 2017-10-07 23:44:04 UTC; biocbuild
+Packaged: 2017-10-30 23:57:18 UTC; biocbuild
diff --git a/NAMESPACE b/NAMESPACE
index 04d31ac..b8d6c77 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -16,7 +16,7 @@ import(BiocGenerics)
exportClasses(
character_OR_NULL, vector_OR_factor,
- Linteger, integer_OR_Linteger,
+ LLint, integer_OR_LLint,
DataTable,
NSBS,
Annotated,
@@ -40,20 +40,20 @@ S3method(aggregate, Vector)
S3method(anyDuplicated, NSBS)
-S3method(as.character, Linteger)
+S3method(as.character, LLint)
S3method(as.data.frame, Vector)
S3method(as.data.frame, DataTable)
-S3method(as.integer, Linteger)
+S3method(as.integer, LLint)
S3method(as.list, Vector)
-S3method(as.logical, Linteger)
+S3method(as.logical, LLint)
S3method(as.matrix, Vector)
-S3method(as.numeric, Linteger)
+S3method(as.numeric, LLint)
S3method(as.vector, Rle)
@@ -68,7 +68,7 @@ S3method(duplicated, DataTable)
S3method(duplicated, Vector)
S3method(head, DataTable)
-S3method(head, Linteger)
+S3method(head, LLint)
S3method(head, Vector)
S3method(intersect, Vector)
@@ -97,7 +97,7 @@ S3method(t, Hits)
S3method(t, HitsList)
S3method(tail, DataTable)
-S3method(tail, Linteger)
+S3method(tail, LLint)
S3method(tail, Vector)
S3method(union, Vector)
@@ -105,7 +105,7 @@ S3method(union, Vector)
S3method(unique, DataTable)
S3method(unique, Vector)
-S3method(window, Linteger)
+S3method(window, LLint)
S3method(window, Vector)
### We also export them thru the export() directive so that (a) they can be
@@ -116,23 +116,25 @@ export(
anyDuplicated.NSBS,
- as.character.Linteger,
+ as.character.LLint,
as.data.frame.Vector,
as.data.frame.DataTable,
- as.integer.Linteger,
+ as.integer.LLint,
as.list.Vector,
- as.logical.Linteger,
+ as.logical.LLint,
as.matrix.Vector,
- as.numeric.Linteger,
+ as.numeric.LLint,
as.vector.Rle,
+ cbind.DataFrame,
+
diff.Rle,
droplevels.Rle,
@@ -142,7 +144,7 @@ export(
duplicated.Vector,
head.DataTable,
- head.Linteger,
+ head.LLint,
head.Vector,
intersect.Vector,
@@ -155,6 +157,8 @@ export(
quantile.Rle,
+ rbind.DataFrame,
+
rev.Rle,
setdiff.Vector,
@@ -165,8 +169,11 @@ export(
summary.Rle,
+ t.Hits,
+ t.HitsList,
+
tail.DataTable,
- tail.Linteger,
+ tail.LLint,
tail.Vector,
union.Vector,
@@ -174,7 +181,7 @@ export(
unique.DataTable,
unique.Vector,
- window.Linteger,
+ window.LLint,
window.Vector
)
@@ -263,20 +270,20 @@ export(
recycleArg,
fold,
- ## Linteger-class.R:
- is.Linteger, as.Linteger, Linteger,
+ ## LLint-class.R:
+ is.LLint, as.LLint, LLint,
## subsetting-utils.R:
normalizeSingleBracketSubscript,
normalizeDoubleBracketSubscript,
- ## int-utils.R:
+ ## integer-utils.R:
orderIntegerPairs,
matchIntegerPairs, selfmatchIntegerPairs, duplicatedIntegerPairs,
orderIntegerQuads,
matchIntegerQuads, selfmatchIntegerQuads, duplicatedIntegerQuads,
- ## str-utils.R:
+ ## character-utils.R:
safeExplode,
strsplitAsListOfIntegerVectors,
svn.time,
@@ -340,7 +347,7 @@ export(
extractROWS, replaceROWS,
getListElement, setListElement,
- ## str-utils.R:
+ ## character-utils.R:
unstrsplit,
## DataTable-class.R:
diff --git a/NEWS b/NEWS
index f30af04..50bcfe9 100644
--- a/NEWS
+++ b/NEWS
@@ -1,12 +1,62 @@
+CHANGES IN VERSION 0.16.0
+-------------------------
+
+NEW FEATURES
+
+ o Introduce FilterResults as generic parent of FilterMatrix.
+
+
+ o Optimized subsetting of an Rle object by an integer vector. Speed up
+ is about 3x or more for big objects with respect to BioC 3.5.
+
+SIGNIFICANT USER-VISIBLE CHANGES
+
+ o coerce,list,DataFrame generates "valid" names when list has none.
+ This ends up introducing an inconsistency between DataFrame and
+ data.frame but it is arguably a good one. We shouldn't rely on
+ DataFrame() to generate variable names from scratch anyway.
+
+BUG FIXES
+
+ o Fix showAsCell() on data-frame-like and array-like objects with a single
+ column, and on SplitDataFrameList objects.
+
+ o Calling DataFrame() with explict 'row.names=NULL' should block rownames
+ inference.
+
+ o cbind.DataFrame() ensures every argument is a DataFrame, not just first.
+
+ o rbind_mcols() now is robust to missing 'x'.
+
+ o Fix extractROWS() for arrays when subscript is a RangeNSBS.
+
+ o Temporary workaround to make the "union" method for Hits objects work
+ even in the presence of another "union" generic in the cache (which is
+ the case e.g. if the user loads the lubridate package).
+
+ o A couple of (long-time due) tweaks and fixes to "unlist" method for
+ List objects so that it behaves consistently with "unlist" method for
+ CompressedList objects.
+
+ o Modify Mini radix C code to accomodate a bug in Apple LLVM version 6.1.0
+ optimizer.
+ [commit 241150d2b043e8fcf6721005422891baff018586]
+
+ o Fix match,Pairs,Pairs()
+ [commit a08c12bf4c31b7304d25122c411d882ec52b360c]
+
+ o Various other minor fixes.
+
+
CHANGES IN VERSION 0.14.0
-------------------------
NEW FEATURES
- o Add Linteger vectors: similar to ordinary integer vectors (int values at
+ o Add LLint vectors: similar to ordinary integer vectors (int values at
the C level) but store "large integers" i.e. long long int values at the
C level. These are 64-bit on Intel platforms vs 32-bit for int values.
- See ?Linteger for more information. This is in preparation for supporting
+ See ?LLint for more information. This is in preparation for supporting
long Vector derivatives (planned for BioC 3.6).
o Default "rank" method for Vector objects now supports the same ties
diff --git a/R/DataFrame-class.R b/R/DataFrame-class.R
index 118dc60..3c926e5 100644
--- a/R/DataFrame-class.R
+++ b/R/DataFrame-class.R
@@ -160,16 +160,16 @@ DataFrame <- function(..., row.names = NULL, check.names = TRUE)
ncols[i] <- ncol(element)
varlist[[i]] <- as.list(element, use.names = FALSE)
if (!is(listData[[i]], "AsIs")) {
- if (((length(dim(listData[[i]])) > 1) || (ncol(element) > 1)))
+ if (((length(dim(listData[[i]])) > 1L) || (ncol(element) > 1L) ||
+ is.list(listData[[i]])))
{
if (emptynames[i])
varnames[[i]] <- colnames(element)
else
varnames[[i]] <- paste(varnames[[i]], colnames(element), sep = ".")
- } else if (is.list(listData[[i]]) && length(names(listData[[i]])))
- varnames[[i]] <- names(element)
+ }
}
- if (is.null(row.names))
+ if (missing(row.names))
row.names <- rownames(element)
}
nr <- max(nrows)
@@ -624,7 +624,7 @@ setAs("Vector", "DataFrame", .VectorAsDataFrame)
## is this a bug or a feature?
setAs("list", "DataFrame",
function(from) {
- do.call(DataFrame, c(from, check.names = FALSE))
+ do.call(DataFrame, c(from, check.names = is.null(names(from))))
})
setAs("NULL", "DataFrame", function(from) as(list(), "DataFrame"))
@@ -652,8 +652,9 @@ setAs("ANY", "DataTable_OR_NULL", function(from) as(from, "DataFrame"))
###
cbind.DataFrame <- function(..., deparse.level = 1) {
- ans <- DataFrame(...)
- mcols(ans) <- rbind_mcols(...)
+ dfs <- lapply(list(...), as, "DataFrame", strict=FALSE)
+ ans <- DataFrame(dfs)
+ mcols(ans) <- do.call(rbind_mcols, dfs)
ans
}
diff --git a/R/FilterRules-class.R b/R/FilterRules-class.R
index 801aa57..73dc84a 100644
--- a/R/FilterRules-class.R
+++ b/R/FilterRules-class.R
@@ -325,9 +325,12 @@ setMethod("show", "FilterClosure", function(object) {
})
### -------------------------------------------------------------------------
-### FilterMatrix: coordinates results from multiple filters
+### FilterResults: coordinates results from multiple filters
###
+setClass("FilterResults",
+ representation(filterRules = "FilterRules"))
+
.valid.FilterMatrix <- function(object)
{
c(if (!is.logical(object))
@@ -338,13 +341,13 @@ setMethod("show", "FilterClosure", function(object) {
"length(filterRules) must equal ncol(object)")
}
-setClass("FilterMatrix", representation(filterRules = "FilterRules"),
- contains = "matrix",
+setClass("FilterMatrix",
+ contains = c("matrix", "FilterResults"),
validity = .valid.FilterMatrix)
setGeneric("filterRules", function(x, ...) standardGeneric("filterRules"))
-setMethod("filterRules", "FilterMatrix", function(x) {
+setMethod("filterRules", "FilterResults", function(x) {
setNames(x at filterRules, colnames(x))
})
@@ -397,7 +400,7 @@ setMethod("show", "FilterMatrix", function(object) {
print(mat, quote = FALSE, right = TRUE)
})
-setMethod("summary", "FilterMatrix",
+setMethod("summary", "FilterResults",
function(object, discarded = FALSE, percent = FALSE)
{
if (!isTRUEorFALSE(discarded))
diff --git a/R/Linteger-class.R b/R/LLint-class.R
similarity index 51%
rename from R/Linteger-class.R
rename to R/LLint-class.R
index 1972bb6..5a5f80a 100644
--- a/R/Linteger-class.R
+++ b/R/LLint-class.R
@@ -1,30 +1,30 @@
### =========================================================================
-### Linteger objects
+### LLint objects
### -------------------------------------------------------------------------
###
-### The Linteger class is a container for storing a vector of "large integers"
+### The LLint class is a container for storing a vector of "large integers"
### (i.e. long long int in C). It supports NAs.
###
### We don't support names for now. We will when we need them.
-setClass("Linteger", representation(bytes="raw"))
+setClass("LLint", representation(bytes="raw"))
-setClassUnion("integer_OR_Linteger", c("integer", "Linteger"))
+setClassUnion("integer_OR_LLint", c("integer", "LLint"))
-is.Linteger <- function(x) is(x, "Linteger")
+is.LLint <- function(x) is(x, "LLint")
-BYTES_PER_LINTEGER <- .Machine$sizeof.longlong
+BYTES_PER_LLINT <- .Machine$sizeof.longlong
-setMethod("length", "Linteger",
- function(x) length(x at bytes) %/% BYTES_PER_LINTEGER
+setMethod("length", "LLint",
+ function(x) length(x at bytes) %/% BYTES_PER_LLINT
)
### Called from the .onLoad() hook in zzz.R
-make_NA_Linteger_ <- function()
+make_NA_LLint_ <- function()
{
- ans_bytes <- .Call2("make_RAW_from_NA_LINTEGER", PACKAGE="S4Vectors")
- new2("Linteger", bytes=ans_bytes, check=FALSE)
+ ans_bytes <- .Call2("make_RAW_from_NA_LLINT", PACKAGE="S4Vectors")
+ new2("LLint", bytes=ans_bytes, check=FALSE)
}
@@ -32,63 +32,63 @@ make_NA_Linteger_ <- function()
### Coercion
###
-.from_logical_to_Linteger <- function(from)
+.from_logical_to_LLint <- function(from)
{
- .Call2("new_Linteger_from_LOGICAL", from, PACKAGE="S4Vectors")
+ .Call2("new_LLint_from_LOGICAL", from, PACKAGE="S4Vectors")
}
-setAs("logical", "Linteger", .from_logical_to_Linteger)
+setAs("logical", "LLint", .from_logical_to_LLint)
-.from_integer_to_Linteger <- function(from)
+.from_integer_to_LLint <- function(from)
{
- .Call2("new_Linteger_from_INTEGER", from, PACKAGE="S4Vectors")
+ .Call2("new_LLint_from_INTEGER", from, PACKAGE="S4Vectors")
}
-setAs("integer", "Linteger", .from_integer_to_Linteger)
+setAs("integer", "LLint", .from_integer_to_LLint)
-.from_numeric_to_Linteger <- function(from)
+.from_numeric_to_LLint <- function(from)
{
- .Call2("new_Linteger_from_NUMERIC", from, PACKAGE="S4Vectors")
+ .Call2("new_LLint_from_NUMERIC", from, PACKAGE="S4Vectors")
}
-setAs("numeric", "Linteger", .from_numeric_to_Linteger)
+setAs("numeric", "LLint", .from_numeric_to_LLint)
-.from_character_to_Linteger <- function(from)
+.from_character_to_LLint <- function(from)
{
- .Call2("new_Linteger_from_CHARACTER", from, PACKAGE="S4Vectors")
+ .Call2("new_LLint_from_CHARACTER", from, PACKAGE="S4Vectors")
}
-setAs("character", "Linteger", .from_character_to_Linteger)
+setAs("character", "LLint", .from_character_to_LLint)
-as.Linteger <- function(x) as(x, "Linteger")
+as.LLint <- function(x) as(x, "LLint")
-### S3/S4 combo for as.logical.Linteger
-.from_Linteger_to_logical <- function(x)
+### S3/S4 combo for as.logical.LLint
+.from_LLint_to_logical <- function(x)
{
- .Call2("new_LOGICAL_from_Linteger", x, PACKAGE="S4Vectors")
+ .Call2("new_LOGICAL_from_LLint", x, PACKAGE="S4Vectors")
}
-as.logical.Linteger <- function(x, ...) .from_Linteger_to_logical(x, ...)
-setMethod("as.logical", "Linteger", as.logical.Linteger)
+as.logical.LLint <- function(x, ...) .from_LLint_to_logical(x, ...)
+setMethod("as.logical", "LLint", as.logical.LLint)
-### S3/S4 combo for as.integer.Linteger
-.from_Linteger_to_integer <- function(x)
+### S3/S4 combo for as.integer.LLint
+.from_LLint_to_integer <- function(x)
{
- .Call2("new_INTEGER_from_Linteger", x, PACKAGE="S4Vectors")
+ .Call2("new_INTEGER_from_LLint", x, PACKAGE="S4Vectors")
}
-as.integer.Linteger <- function(x, ...) .from_Linteger_to_integer(x, ...)
-setMethod("as.integer", "Linteger", as.integer.Linteger)
+as.integer.LLint <- function(x, ...) .from_LLint_to_integer(x, ...)
+setMethod("as.integer", "LLint", as.integer.LLint)
-### S3/S4 combo for as.numeric.Linteger
-.from_Linteger_to_numeric <- function(x)
+### S3/S4 combo for as.numeric.LLint
+.from_LLint_to_numeric <- function(x)
{
- .Call2("new_NUMERIC_from_Linteger", x, PACKAGE="S4Vectors")
+ .Call2("new_NUMERIC_from_LLint", x, PACKAGE="S4Vectors")
}
-as.numeric.Linteger <- function(x, ...) .from_Linteger_to_numeric(x, ...)
-setMethod("as.numeric", "Linteger", as.numeric.Linteger)
+as.numeric.LLint <- function(x, ...) .from_LLint_to_numeric(x, ...)
+setMethod("as.numeric", "LLint", as.numeric.LLint)
-### S3/S4 combo for as.character.Linteger
-.from_Linteger_to_character <- function(x)
+### S3/S4 combo for as.character.LLint
+.from_LLint_to_character <- function(x)
{
- .Call2("new_CHARACTER_from_Linteger", x, PACKAGE="S4Vectors")
+ .Call2("new_CHARACTER_from_LLint", x, PACKAGE="S4Vectors")
}
-as.character.Linteger <- function(x, ...) .from_Linteger_to_character(x, ...)
-setMethod("as.character", "Linteger", as.character.Linteger)
+as.character.LLint <- function(x, ...) .from_LLint_to_character(x, ...)
+setMethod("as.character", "LLint", as.character.LLint)
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -100,10 +100,10 @@ setMethod("as.character", "Linteger", as.character.Linteger)
### Return a single double value.
.normarg_vector_length <- function(length=0L, max_length=.MAX_VECTOR_LENGTH)
{
- if (is.Linteger(length)) {
- if (length(length) != 1L || is.na(length) || length < as.Linteger(0L))
+ if (is.LLint(length)) {
+ if (length(length) != 1L || is.na(length) || length < as.LLint(0L))
stop("invalid 'length' argument")
- if (length > as.Linteger(max_length))
+ if (length > as.LLint(max_length))
stop("'length' is too big")
return(as.double(length))
}
@@ -119,12 +119,12 @@ setMethod("as.character", "Linteger", as.character.Linteger)
length
}
-Linteger <- function(length=0L)
+LLint <- function(length=0L)
{
- max_length <- .MAX_VECTOR_LENGTH / BYTES_PER_LINTEGER
+ max_length <- .MAX_VECTOR_LENGTH / BYTES_PER_LLINT
length <- .normarg_vector_length(length, max_length=max_length)
- ans_bytes <- raw(length * BYTES_PER_LINTEGER)
- new2("Linteger", bytes=ans_bytes, check=FALSE)
+ ans_bytes <- raw(length * BYTES_PER_LLINT)
+ new2("LLint", bytes=ans_bytes, check=FALSE)
}
@@ -132,7 +132,7 @@ Linteger <- function(length=0L)
### Displaying
###
-.show_Linteger <- function(x)
+.show_LLint <- function(x)
{
x_len <- length(x)
if (x_len == 0L) {
@@ -144,16 +144,16 @@ Linteger <- function(length=0L)
return()
}
-setMethod("show", "Linteger", function(object) .show_Linteger(object))
+setMethod("show", "LLint", function(object) .show_LLint(object))
-setMethod("showAsCell", "Linteger", function(object) as.character(object))
+setMethod("showAsCell", "LLint", function(object) as.character(object))
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Combining
###
-combine_Linteger_objects <- function(objects)
+combine_LLint_objects <- function(objects)
{
if (!is.list(objects))
stop("'objects' must be a list")
@@ -175,22 +175,22 @@ combine_Linteger_objects <- function(objects)
if (is.null(x))
return(NULL)
if (is.logical(x) || is.integer(x))
- x <- as.Linteger(x)
- if (is.Linteger(x))
+ x <- as.LLint(x)
+ if (is.LLint(x))
return(x at bytes)
- stop(wmsg("cannot combine Linteger objects ",
+ stop(wmsg("cannot combine LLint objects ",
"with objects of class ", class(x)))
}
)
ans_bytes <- unlist(bytes_slots, use.names=FALSE)
- new2("Linteger", bytes=ans_bytes, check=FALSE)
+ new2("LLint", bytes=ans_bytes, check=FALSE)
}
-setMethod("c", "Linteger",
+setMethod("c", "LLint",
function (x, ..., ignore.mcols=FALSE, recursive=FALSE)
{
if (!identical(recursive, FALSE))
- stop("\"c\" method for Linteger objects ",
+ stop("\"c\" method for LLint objects ",
"does not support the 'recursive' argument")
if (missing(x)) {
objects <- list(...)
@@ -198,7 +198,7 @@ setMethod("c", "Linteger",
} else {
objects <- list(x, ...)
}
- combine_Linteger_objects(objects)
+ combine_LLint_objects(objects)
}
)
@@ -207,29 +207,29 @@ setMethod("c", "Linteger",
### is.na(), anyNA()
###
-setMethod("is.na", "Linteger", function(x) is.na(as.logical(x)))
+setMethod("is.na", "LLint", function(x) is.na(as.logical(x)))
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Operations from "Ops" group
###
-setMethod("Ops", c("Linteger", "Linteger"),
+setMethod("Ops", c("LLint", "LLint"),
function(e1, e2)
{
- .Call("Linteger_Ops", .Generic, e1, e2, PACKAGE="S4Vectors")
+ .Call("LLint_Ops", .Generic, e1, e2, PACKAGE="S4Vectors")
}
)
-### If one operand is Linteger and the other one is integer, then the latter
-### is coerced to Linteger.
-### If one operand is Linteger and the other one is double, then the former
+### If one operand is LLint and the other one is integer, then the latter
+### is coerced to LLint.
+### If one operand is LLint and the other one is double, then the former
### is coerced to double.
-setMethod("Ops", c("Linteger", "numeric"),
+setMethod("Ops", c("LLint", "numeric"),
function(e1, e2)
{
if (is.integer(e2)) {
- e2 <- as.Linteger(e2)
+ e2 <- as.LLint(e2)
} else {
## Suppress "non reversible coercion to double" warning.
e1 <- suppressWarnings(as.double(e1))
@@ -238,11 +238,11 @@ setMethod("Ops", c("Linteger", "numeric"),
}
)
-setMethod("Ops", c("numeric", "Linteger"),
+setMethod("Ops", c("numeric", "LLint"),
function(e1, e2)
{
if (is.integer(e1)) {
- e1 <- as.Linteger(e1)
+ e1 <- as.LLint(e1)
} else {
## Suppress "non reversible coercion to double" warning.
e2 <- suppressWarnings(as.double(e2))
@@ -256,16 +256,15 @@ setMethod("Ops", c("numeric", "Linteger"),
### Operations from "Summary" group
###
-setMethod("Summary", "Linteger",
+setMethod("Summary", "LLint",
function(x, ..., na.rm=FALSE)
{
if (length(list(...)) != 0L)
- stop(wmsg("\"", .Generic, "\" method for Linteger objects ",
+ stop(wmsg("\"", .Generic, "\" method for LLint objects ",
"takes only one object"))
if (!isTRUEorFALSE(na.rm))
stop("'na.rm' must be TRUE or FALSE")
- .Call("Linteger_Summary", .Generic, x, na.rm=na.rm,
- PACKAGE="S4Vectors")
+ .Call("LLint_Summary", .Generic, x, na.rm=na.rm, PACKAGE="S4Vectors")
}
)
diff --git a/R/List-class.R b/R/List-class.R
index 39705a4..1a6b0bb 100644
--- a/R/List-class.R
+++ b/R/List-class.R
@@ -131,58 +131,83 @@ setMethod("show", "List",
### unlist()
###
-### NOT exported. Assume 'names1' is not NULL.
-make_unlist_result_names <- function(names1, names2)
+### 'inner_names' and 'outer_names' can be either NULL or character vectors.
+### If both are character vectors, then they must have the same length.
+.make_unlisted_names <- function(inner_names, outer_names)
{
- if (is.null(names2))
- return(names1)
- idx2 <- names2 != "" | is.na(names2)
- idx1 <- names1 != "" | is.na(names1)
- idx <- idx1 & idx2
- if (any(idx))
- names1[idx] <- paste(names1[idx], names2[idx], sep = ".")
- idx <- !idx1 & idx2
- if (any(idx))
- names1[idx] <- names2[idx]
- names1
+ if (is.null(outer_names))
+ return(inner_names)
+ if (is.null(inner_names))
+ return(outer_names)
+ ## Replace missing outer names with inner names.
+ no_outer <- is.na(outer_names) | outer_names == ""
+ if (any(no_outer)) {
+ idx <- which(no_outer)
+ outer_names[idx] <- inner_names[idx]
+ }
+ ## Paste *outer* and *inner* names together when both are present.
+ no_inner <- is.na(inner_names) | inner_names == ""
+ both <- !(no_outer | no_inner)
+ if (any(both)) {
+ idx <- which(both)
+ outer_names[idx] <- paste(outer_names[idx], inner_names[idx], sep=".")
+ }
+ outer_names
}
+### 'unlisted_x' is assumed to have the *inner* names of 'x' on it.
+set_unlisted_names <- function(unlisted_x, x)
+{
+ x_names <- names(x)
+ if (is.null(x_names))
+ return(unlisted_x)
+ inner_names <- ROWNAMES(unlisted_x)
+ outer_names <- rep.int(x_names, elementNROWS(x))
+ unlisted_names <- .make_unlisted_names(inner_names, outer_names)
+ if (length(dim(unlisted_x)) < 2L) {
+ res <- try(names(unlisted_x) <- unlisted_names, silent=TRUE)
+ what <- "names"
+ } else {
+ res <- try(rownames(unlisted_x) <- unlisted_names, silent=TRUE)
+ what <- "rownames"
+ }
+ if (is(res, "try-error"))
+ warning("failed to set ", what, " on the ",
+ "unlisted ", class(x), " object")
+ unlisted_x
+}
+
+### If 'use.names' is FALSE or 'x' has no *outer* names, then we propagate
+### the *inner* names on the unlisted object. Note that this deviates from
+### base::unlist() which doesn't propagate any names (outer or inner) when
+### 'use.names' is FALSE.
+### Otherwise (i.e. if 'use.names' is TRUE and 'x' has *outer* names), the
+### names we propagate are obtained by pasting the *outer* and *inner* names
+### together. Note that, unlike base::unlist(), we never mangle the *outer*
+### names when they have no corresponding *inner* names (a terrible feature
+### of base::unlist()).
setMethod("unlist", "List",
function(x, recursive=TRUE, use.names=TRUE)
{
if (!isTRUEorFALSE(use.names))
stop("'use.names' must be TRUE or FALSE")
- if (length(x) == 0L)
- return(NULL)
- x_names <- names(x)
- if (!is.null(x_names))
- names(x) <- NULL
- xx <- as.list(x)
+ if (length(x) == 0L) {
+ elt_type <- elementType(x)
+ if (isVirtualClass(elt_type))
+ return(NULL)
+ return(new(elt_type))
+ }
+ xx <- unname(as.list(x))
if (length(dim(xx[[1L]])) < 2L) {
- ans <- do.call(c, xx)
- ans_names0 <- names(ans)
- if (use.names) {
- if (!is.null(x_names)) {
- ans_names <- rep.int(x_names, elementNROWS(x))
- ans_names <- make_unlist_result_names(ans_names, ans_names0)
- try_result <- try(names(ans) <- ans_names, silent=TRUE)
- if (inherits(try_result, "try-error"))
- warning("failed to set names on the result ",
- "of unlisting a ", class(x), " object")
- }
- } else {
- ## This is consistent with base::unlist but is not consistent
- ## with unlist,CompressedList. See comments and FIXME note in
- ## the unlist,CompressedList code for more details.
- if (!is.null(ans_names0))
- names(ans) <- NULL
- }
+ ## This propagates the *inner* names of 'x'.
+ unlisted_x <- do.call(c, xx)
} else {
- ans <- do.call(rbind, xx)
- if (!use.names)
- rownames(ans) <- NULL
+ ## This propagates the *inner* names of 'x'.
+ unlisted_x <- do.call(rbind, xx)
}
- ans
+ if (use.names)
+ unlisted_x <- set_unlisted_names(unlisted_x, x)
+ unlisted_x
}
)
diff --git a/R/Pairs-class.R b/R/Pairs-class.R
index 292330a..e588867 100644
--- a/R/Pairs-class.R
+++ b/R/Pairs-class.R
@@ -89,16 +89,16 @@ Pairs <- function(first, second, ..., names = NULL, hits = NULL) {
setMethod("match", c("Pairs", "Pairs"),
function(x, table, nomatch = NA_integer_, incomparables = NULL, ...) {
- if (!is.null(incomparables))
- stop("'incomparables' must be NULL")
- hits <- intersect(findMatches(first(x), first(table), ...),
- findMatches(second(x), second(table), ...))
- ans <- selectHits(hits, "first")
- if (!identical(nomatch, NA_integer_)) {
- ans[is.na(ans)] <- nomatch
- }
- ans
-})
+ if (!is.null(incomparables))
+ stop("'incomparables' must be NULL")
+ hits <- intersect(findMatches(first(x), first(table), ...),
+ findMatches(second(x), second(table), ...))
+ ans <- selectHits(hits, "first")
+ if (!identical(nomatch, NA_integer_)) {
+ ans[is.na(ans)] <- nomatch
+ }
+ ans
+ })
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Coerce
@@ -174,6 +174,18 @@ setMethod("c", "Pairs", function (x, ..., recursive = FALSE) {
.unlist_list_of_Pairs(args)
})
+
+### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+### Utilities
+###
+
+setMethod("t", "Pairs", function(x) {
+ tx <- x
+ first(tx) <- second(x)
+ second(tx) <- first(x)
+ tx
+})
+
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Show
###
diff --git a/R/Rle-class.R b/R/Rle-class.R
index 0089b8a..64cf6c3 100644
--- a/R/Rle-class.R
+++ b/R/Rle-class.R
@@ -8,7 +8,7 @@ setClass("Rle",
contains="Vector",
representation(
values="vector_OR_factor",
- lengths="integer_OR_Linteger"
+ lengths="integer_OR_LLint"
),
prototype(
values=logical(0),
@@ -69,12 +69,12 @@ new_Rle <- function(values=logical(0), lengths=NULL)
{
stopifnot(is(values, "vector_OR_factor"))
if (!is.null(lengths)) {
- if (!(is.numeric(lengths) || is.Linteger(lengths)))
- stop("'lengths' must be NULL or a numeric or Linteger vector")
+ if (!(is.numeric(lengths) || is.LLint(lengths)))
+ stop("'lengths' must be NULL or a numeric or LLint vector")
if (anyNA(lengths))
stop("'lengths' cannot contain NAs")
if (is.double(lengths)) {
- suppressWarnings(lengths <- as.Linteger(lengths))
+ suppressWarnings(lengths <- as.LLint(lengths))
if (anyNA(lengths))
stop("Rle vector is too long")
}
@@ -691,17 +691,23 @@ setMethod("match", c("Rle", "Rle"),
}
)
-### FIXME: Remove in R 3.3
setMethod("order", "Rle",
- function(..., na.last=TRUE, decreasing=FALSE,
- method=c("auto", "shell", "radix"))
- {
- args <- lapply(unname(list(...)), decodeRle)
+ function(..., na.last=TRUE, decreasing=FALSE,
+ method=c("auto", "shell", "radix"))
+{
+ args <- list(...)
+ if (length(args) == 1L) {
+ x <- args[[1L]]
+ o <- order(runValue(x), na.last=na.last, decreasing=decreasing,
+ method=method)
+ mseq(start(x)[o], end(x)[o])
+ } else {
+ args <- lapply(unname(args), decodeRle)
do.call(order, c(args, list(na.last=na.last,
decreasing=decreasing,
method=method)))
}
-)
+})
.sort.Rle <- function(x, decreasing=FALSE, na.last=NA, ...)
{
@@ -862,7 +868,7 @@ setMethod("show", "Rle",
nr <- nrun(object)
halfWidth <- getOption("width") %/% 2L
cat(classNameForDisplay(runValue(object)),
- "-Rle of length ", as.character(as.Linteger(lo)),
+ "-Rle of length ", as.character(as.LLint(lo)),
" with ", nr, ifelse(nr == 1, " run\n", " runs\n"), sep = "")
first <- max(1L, halfWidth)
showMatrix <-
diff --git a/R/Rle-utils.R b/R/Rle-utils.R
index 49fefc7..0d62331 100644
--- a/R/Rle-utils.R
+++ b/R/Rle-utils.R
@@ -340,7 +340,8 @@ setMethod("sd", signature = c(x = "Rle"),
### S3/S4 combo for median.Rle
### FIXME: code duplication needed for S3 / S4 dispatch
### drop NA's here, so dropRle==TRUE allows x[FALSE][NA] in median.default
-median.Rle <- function(x, na.rm = FALSE)
+### FIXME: Remove these methods in R 3.5
+median.Rle <- function(x, na.rm = FALSE, ...)
{
if (na.rm)
x <- x[!is.na(x)]
@@ -360,6 +361,7 @@ setMethod("median", "Rle",
callNextMethod(x=x, na.rm=FALSE)
})
+### FIXME: Remove this in R 3.5
quantile.Rle <-
function(x, probs = seq(0, 1, 0.25), na.rm = FALSE, names = TRUE,
type = 7, ...)
@@ -372,6 +374,7 @@ quantile.Rle <-
NextMethod("quantile", na.rm=FALSE)
}
+### FIXME: Remove this in R 3.5
setMethod("mad", "Rle",
function(x, center = median(x), constant = 1.4826, na.rm = FALSE,
low = FALSE, high = FALSE)
@@ -389,6 +392,7 @@ setMethod("IQR", "Rle",
function(x, na.rm = FALSE)
diff(quantile(x, c(0.25, 0.75), na.rm = na.rm, names = FALSE)))
+### FIXME: Remove this in R 3.5
setMethod("smoothEnds", "Rle", function(y, k = 3)
{
oldOption <- getOption("dropRle")
diff --git a/R/Vector-class.R b/R/Vector-class.R
index 5c44afc..2057104 100644
--- a/R/Vector-class.R
+++ b/R/Vector-class.R
@@ -507,7 +507,7 @@ ensureMcols <- function(x) {
rbind_mcols <- function(x, ...)
{
- args <- list(x, ...)
+ args <- c(if (!missing(x)) list(x), list(...))
mcols_list <- lapply(args, mcols)
if (length(mcols_list) == 1L)
return(mcols_list[[1L]])
diff --git a/R/aggregate-methods.R b/R/aggregate-methods.R
index ca5f404..1d1c88a 100644
--- a/R/aggregate-methods.R
+++ b/R/aggregate-methods.R
@@ -228,7 +228,7 @@ aggregateWithDots <- function(x, by, FUN, ..., drop = TRUE) {
stats <- DataFrame(mapply(safeEval, exprs, envs, SIMPLIFY=FALSE))
if (endomorphism && !is(x, "DataFrame")) {
- ans <- x[end(PartitioningByEnd(by))]
+ ans <- x[end(IRanges::PartitioningByEnd(by))]
mcols(by) <- NULL
mcols(ans) <- DataFrame(grouping = by, stats)
} else {
diff --git a/R/str-utils.R b/R/character-utils.R
similarity index 100%
rename from R/str-utils.R
rename to R/character-utils.R
diff --git a/R/int-utils.R b/R/integer-utils.R
similarity index 100%
rename from R/int-utils.R
rename to R/integer-utils.R
diff --git a/R/logical-utils.R b/R/logical-utils.R
deleted file mode 100644
index 9419643..0000000
--- a/R/logical-utils.R
+++ /dev/null
@@ -1,32 +0,0 @@
-### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-### Basic manipulation of a "compact bit vector" i.e. a bit vector stored in
-### a standard raw vector.
-###
-
-logicalAsCompactBitvector <- function(x)
-{
- if (!is.logical(x))
- stop("'x' must be a logical vector")
- .Call2("logical_as_compact_bitvector", x, PACKAGE="S4Vectors")
-}
-
-compactBitvectorAsLogical <- function(x, length.out)
-{
- if (!is.raw(x))
- stop("'x' must be a raw vector")
- if (!isSingleNumber(length.out))
- stop("'length.out' must be a single number")
- if (!is.integer(length.out))
- length.out <- as.integer(length.out)
- .Call2("compact_bitvector_as_logical", x, length.out, PACKAGE="S4Vectors")
-}
-
-subsetCompactBitvector <- function(x, i)
-{
- if (!is.raw(x))
- stop("'x' must be a raw vector")
- if (!is.integer(i))
- stop("'i' must be an integer vector")
- .Call2("subset_compact_bitvector", x, i, PACKAGE="S4Vectors")
-}
-
diff --git a/R/subsetting-utils.R b/R/subsetting-utils.R
index b7356da..8f976db 100644
--- a/R/subsetting-utils.R
+++ b/R/subsetting-utils.R
@@ -475,35 +475,38 @@ setMethod("extractROWS", c("vector_OR_factor", "RangeNSBS"),
}
)
+setMethod("extractROWS", c("array", "RangeNSBS"), .extractROWSWithBracket)
+setMethod("extractROWS", c("array", "RangesNSBS"), .extractROWSWithBracket)
+
### NOT exported but will be used in IRanges package (by "extractROWS" method
-### with signature Linteger,RangesNSBS).
-extract_ranges_from_Linteger <- function(x, start, width)
+### with signature LLint,RangesNSBS).
+extract_ranges_from_LLint <- function(x, start, width)
{
- start <- (start - 1L) * BYTES_PER_LINTEGER + 1L
- width <- width * BYTES_PER_LINTEGER
+ start <- (start - 1L) * BYTES_PER_LLINT + 1L
+ width <- width * BYTES_PER_LLINT
x at bytes <- extract_ranges_from_vector_OR_factor(x at bytes, start, width)
x
}
-setMethod("extractROWS", c("Linteger", "RangeNSBS"),
+setMethod("extractROWS", c("LLint", "RangeNSBS"),
function(x, i)
{
start <- i at subscript[[1L]]
width <- i at subscript[[2L]] - start + 1L
- extract_ranges_from_Linteger(x, start, width)
+ extract_ranges_from_LLint(x, start, width)
}
)
-setMethod("extractROWS", c("Linteger", "NSBS"),
+setMethod("extractROWS", c("LLint", "NSBS"),
function(x, i)
{
start <- as.integer(i)
width <- rep.int(1L, length(start))
- extract_ranges_from_Linteger(x, start, width)
+ extract_ranges_from_LLint(x, start, width)
}
)
-setMethod("extractROWS", c("Linteger", "ANY"),
+setMethod("extractROWS", c("LLint", "ANY"),
function (x, i)
{
## We don't support NAs in the subscript yet.
@@ -523,7 +526,7 @@ subset_along_ROWS <- function(x, i, j, ..., drop=TRUE)
extractROWS(x, i)
}
-setMethod("[", "Linteger", subset_along_ROWS)
+setMethod("[", "LLint", subset_along_ROWS)
setMethod("replaceROWS", "ANY", .replaceROWSWithBracket)
@@ -621,16 +624,16 @@ setMethod("getListElement", "list",
### window(), head(), tail(), rep.int()
###
-### S3/S4 combo for window.Linteger
+### S3/S4 combo for window.LLint
window_along_ROWS <- function(x, start=NA, end=NA, width=NA)
{
i <- RangeNSBS(x, start=start, end=end, width=width)
extractROWS(x, i)
}
-window.Linteger <- function(x, ...) window_along_ROWS(x, ...)
-setMethod("window", "Linteger", window.Linteger)
+window.LLint <- function(x, ...) window_along_ROWS(x, ...)
+setMethod("window", "LLint", window.LLint)
-### S3/S4 combo for head.Linteger
+### S3/S4 combo for head.LLint
head_along_ROWS <- function(x, n=6L)
{
if (!isSingleNumber(n))
@@ -645,10 +648,10 @@ head_along_ROWS <- function(x, n=6L)
}
window(x, start=1L, width=n)
}
-head.Linteger <- function(x, ...) head_along_ROWS(x, ...)
-setMethod("head", "Linteger", head.Linteger)
+head.LLint <- function(x, ...) head_along_ROWS(x, ...)
+setMethod("head", "LLint", head.LLint)
-### S3/S4 combo for tail.Linteger
+### S3/S4 combo for tail.LLint
tail_along_ROWS <- function(x, n=6L)
{
if (!isSingleNumber(n))
@@ -663,14 +666,14 @@ tail_along_ROWS <- function(x, n=6L)
}
window(x, end=x_NROW, width=n)
}
-tail.Linteger <- function(x, ...) tail_along_ROWS(x, ...)
-setMethod("tail", "Linteger", tail.Linteger)
+tail.LLint <- function(x, ...) tail_along_ROWS(x, ...)
+setMethod("tail", "LLint", tail.LLint)
rep.int_along_ROWS <- function(x, times)
{
x_len <- length(x)
- if (!(is.numeric(times) || is.Linteger(times)))
- stop("'times' must be a numeric or Linteger vector")
+ if (!(is.numeric(times) || is.LLint(times)))
+ stop("'times' must be a numeric or LLint vector")
times_len <- length(times)
if (times_len == 1L) {
if (times == 1L)
@@ -681,7 +684,7 @@ rep.int_along_ROWS <- function(x, times)
if (times_len == x_len) {
i <- Rle(seq_len(x_len), times)
} else if (times_len == 1L) {
- if (is.Linteger(times))
+ if (is.LLint(times))
times <- as.double(times)
i <- IRanges::IRanges(rep.int(1L, times), rep.int(x_len, times))
} else {
@@ -690,5 +693,5 @@ rep.int_along_ROWS <- function(x, times)
extractROWS(x, i)
}
-setMethod("rep.int", "Linteger", rep.int_along_ROWS)
+setMethod("rep.int", "LLint", rep.int_along_ROWS)
diff --git a/R/zzz.R b/R/zzz.R
index 1ae753a..dd73a92 100644
--- a/R/zzz.R
+++ b/R/zzz.R
@@ -4,9 +4,9 @@
{
ns <- asNamespace(pkgname)
- objname <- "NA_Linteger_"
- NA_Linteger_ <- make_NA_Linteger_()
- assign(objname, NA_Linteger_, envir=ns)
+ objname <- "NA_LLint_"
+ NA_LLint_ <- make_NA_LLint_()
+ assign(objname, NA_LLint_, envir=ns)
namespaceExport(ns, objname)
}
diff --git a/TODO b/TODO
index 4d056b7..80bb0fe 100644
--- a/TODO
+++ b/TODO
@@ -8,7 +8,7 @@ R files: 73 files
X utils.R
X isConstant.R (renamed isSorted.R)
X normarg-utils.R
- X compact_bitvector.R (renamed logical-utils.R)
+ X compact_bitvector.R (deleted)
X int-utils.R
X str-utils.R
X vector-utils.R (NEW!)
@@ -54,7 +54,7 @@ C files:
X AEbufs.c
X SEXP_utils.c (split in SEXP_utils.c + vector_utils.c + eval_utils.c)
X anyMissing.c
- X compact_bitvector.c (renamed logical_utils.c)
+ X compact_bitvector.c (deleted)
X int_utils.c
X str_utils.c
X Hits_class.c
@@ -76,4 +76,4 @@ o FilterRules:
- refactor, using ShortRead filter framework (becomes FilterList)
- support subsetting DataFrame/RangedData directly
-oo
+oooooooooo
diff --git a/inst/doc/RleTricks.pdf b/inst/doc/RleTricks.pdf
index 16c46eb..9c3e2bd 100644
Binary files a/inst/doc/RleTricks.pdf and b/inst/doc/RleTricks.pdf differ
diff --git a/inst/doc/S4QuickOverview.pdf b/inst/doc/S4QuickOverview.pdf
index 22bddcd..7c9a93c 100644
Binary files a/inst/doc/S4QuickOverview.pdf and b/inst/doc/S4QuickOverview.pdf differ
diff --git a/inst/include/S4Vectors_defines.h b/inst/include/S4Vectors_defines.h
index d4da744..e6a593d 100644
--- a/inst/include/S4Vectors_defines.h
+++ b/inst/include/S4Vectors_defines.h
@@ -18,7 +18,7 @@
#include <Rdefines.h>
#include <R_ext/Rdynload.h>
-#define NA_LINTEGER LLONG_MIN
+#define NA_LLINT LLONG_MIN
/* Get or set i-th element from int or long long int array 'x'.
GET_INT_OR_LLINT() always returns a long long int.
diff --git a/inst/include/S4Vectors_interface.h b/inst/include/S4Vectors_interface.h
index 319f06d..28a456e 100644
--- a/inst/include/S4Vectors_interface.h
+++ b/inst/include/S4Vectors_interface.h
@@ -181,6 +181,11 @@ void IntAE_set_val(
int val
);
+void IntAE_extend(
+ IntAE *ae,
+ size_t new_buflength
+);
+
void IntAE_insert_at(
IntAE *ae,
size_t at,
@@ -244,6 +249,11 @@ size_t IntAEAE_set_nelt(
size_t nelt
);
+void IntAEAE_extend(
+ IntAEAE *aeae,
+ size_t new_buflength
+);
+
void IntAEAE_insert_at(
IntAEAE *aeae,
size_t at,
@@ -291,6 +301,11 @@ size_t IntPairAE_set_nelt(
size_t nelt
);
+void IntPairAE_extend(
+ IntPairAE *ae,
+ size_t new_buflength
+);
+
void IntPairAE_insert_at(
IntPairAE *ae,
size_t at,
@@ -310,6 +325,11 @@ size_t IntPairAEAE_set_nelt(
size_t nelt
);
+void IntPairAEAE_extend(
+ IntPairAEAE *aeae,
+ size_t new_buflength
+);
+
void IntPairAEAE_insert_at(
IntPairAEAE *aeae,
size_t at,
@@ -333,6 +353,11 @@ void LLongAE_set_val(
long long val
);
+void LLongAE_extend(
+ LLongAE *ae,
+ size_t new_buflength
+);
+
void LLongAE_insert_at(
LLongAE *ae,
size_t at,
@@ -352,6 +377,11 @@ size_t CharAE_set_nelt(
size_t nelt
);
+void CharAE_extend(
+ CharAE *ae,
+ size_t new_buflength
+);
+
void CharAE_insert_at(
CharAE *ae,
size_t at,
@@ -373,6 +403,8 @@ void CharAE_delete_at(
size_t nelt
);
+SEXP new_CHARSXP_from_CharAE(const CharAE *ae);
+
SEXP new_RAW_from_CharAE(const CharAE *ae);
SEXP new_LOGICAL_from_CharAE(const CharAE *ae);
@@ -384,6 +416,11 @@ size_t CharAEAE_set_nelt(
size_t nelt
);
+void CharAEAE_extend(
+ CharAEAE *aeae,
+ size_t new_buflength
+);
+
void CharAEAE_insert_at(
CharAEAE *aeae,
size_t at,
@@ -409,16 +446,16 @@ SEXP new_CHARACTER_from_CharAEAE(const CharAEAE *aeae);
const char *get_classname(SEXP x);
/*
- * Linteger_class.c
+ * LLint_class.c
*/
-int is_Linteger(SEXP x);
+int is_LLint(SEXP x);
-R_xlen_t get_Linteger_length(SEXP x);
+R_xlen_t get_LLint_length(SEXP x);
-long long int *get_Linteger_dataptr(SEXP x);
+long long int *get_LLint_dataptr(SEXP x);
-SEXP alloc_Linteger(const char *classname, R_xlen_t length);
+SEXP alloc_LLint(const char *classname, R_xlen_t length);
/*
* subsetting_utils.c
@@ -467,7 +504,7 @@ SEXP list_as_data_frame(
);
/*
- * int_utils.c
+ * integer_utils.c
*/
int check_integer_pairs(
diff --git a/inst/include/_S4Vectors_stubs.c b/inst/include/_S4Vectors_stubs.c
index 48a4612..cf6aa64 100644
--- a/inst/include/_S4Vectors_stubs.c
+++ b/inst/include/_S4Vectors_stubs.c
@@ -143,6 +143,11 @@ DEFINE_NOVALUE_CCALLABLE_STUB(IntAE_set_val,
( ae, val)
)
+DEFINE_NOVALUE_CCALLABLE_STUB(IntAE_extend,
+ (IntAE *ae, size_t new_buflength),
+ ( ae, new_buflength)
+)
+
DEFINE_NOVALUE_CCALLABLE_STUB(IntAE_insert_at,
(IntAE *ae, size_t at, int val),
( ae, at, val)
@@ -208,6 +213,11 @@ DEFINE_CCALLABLE_STUB(size_t, IntAEAE_set_nelt,
( aeae, nelt)
)
+DEFINE_NOVALUE_CCALLABLE_STUB(IntAEAE_extend,
+ (IntAEAE *aeae, size_t new_buflength),
+ ( aeae, new_buflength)
+)
+
DEFINE_NOVALUE_CCALLABLE_STUB(IntAEAE_insert_at,
(IntAEAE *aeae, size_t at, IntAE *ae),
( aeae, at, ae)
@@ -258,6 +268,11 @@ DEFINE_CCALLABLE_STUB(size_t, IntPairAE_set_nelt,
( ae, nelt)
)
+DEFINE_NOVALUE_CCALLABLE_STUB(IntPairAE_extend,
+ (IntPairAE *ae, size_t new_buflength),
+ ( ae, new_buflength)
+)
+
DEFINE_NOVALUE_CCALLABLE_STUB(IntPairAE_insert_at,
(IntPairAE *ae, size_t at, int a, int b),
( ae, at, a, b)
@@ -278,6 +293,11 @@ DEFINE_CCALLABLE_STUB(size_t, IntPairAEAE_set_nelt,
( aeae, nelt)
)
+DEFINE_NOVALUE_CCALLABLE_STUB(IntPairAEAE_extend,
+ (IntPairAEAE *aeae, size_t new_buflength),
+ ( aeae, new_buflength)
+)
+
DEFINE_NOVALUE_CCALLABLE_STUB(IntPairAEAE_insert_at,
(IntPairAEAE *aeae, size_t at, IntPairAE *ae),
( aeae, at, ae)
@@ -303,6 +323,11 @@ DEFINE_NOVALUE_CCALLABLE_STUB(LLongAE_set_val,
( ae, val)
)
+DEFINE_NOVALUE_CCALLABLE_STUB(LLongAE_extend,
+ (LLongAE *ae, size_t new_buflength),
+ ( ae, new_buflength)
+)
+
DEFINE_NOVALUE_CCALLABLE_STUB(LLongAE_insert_at,
(LLongAE *ae, size_t at, long long val),
( ae, at, val)
@@ -323,6 +348,11 @@ DEFINE_CCALLABLE_STUB(size_t, CharAE_set_nelt,
( ae, nelt)
)
+DEFINE_NOVALUE_CCALLABLE_STUB(CharAE_extend,
+ (CharAE *ae, size_t new_buflength),
+ ( ae, new_buflength)
+)
+
DEFINE_NOVALUE_CCALLABLE_STUB(CharAE_insert_at,
(CharAE *ae, size_t at, char c),
( ae, at, c)
@@ -348,6 +378,11 @@ DEFINE_NOVALUE_CCALLABLE_STUB(CharAE_delete_at,
( ae, at, nelt)
)
+DEFINE_CCALLABLE_STUB(SEXP, new_CHARSXP_from_CharAE,
+ (const CharAE *ae),
+ ( ae)
+)
+
DEFINE_CCALLABLE_STUB(SEXP, new_RAW_from_CharAE,
(const CharAE *ae),
( ae)
@@ -368,6 +403,11 @@ DEFINE_CCALLABLE_STUB(size_t, CharAEAE_set_nelt,
( aeae, nelt)
)
+DEFINE_NOVALUE_CCALLABLE_STUB(CharAEAE_extend,
+ (CharAEAE *aeae, size_t new_buflength),
+ ( aeae, new_buflength)
+)
+
DEFINE_NOVALUE_CCALLABLE_STUB(CharAEAE_insert_at,
(CharAEAE *aeae, size_t at, CharAE *ae),
( aeae, at, ae)
@@ -398,25 +438,25 @@ DEFINE_CCALLABLE_STUB(const char *, get_classname,
)
/*
- * Stubs for callables defined in Linteger_class.c
+ * Stubs for callables defined in LLint_class.c
*/
-DEFINE_CCALLABLE_STUB(int, is_Linteger,
+DEFINE_CCALLABLE_STUB(int, is_LLint,
(SEXP x),
( x)
)
-DEFINE_CCALLABLE_STUB(R_xlen_t, get_Linteger_length,
+DEFINE_CCALLABLE_STUB(R_xlen_t, get_LLint_length,
(SEXP x),
( x)
)
-DEFINE_CCALLABLE_STUB(long long int *, get_Linteger_dataptr,
+DEFINE_CCALLABLE_STUB(long long int *, get_LLint_dataptr,
(SEXP x),
( x)
)
-DEFINE_CCALLABLE_STUB(SEXP, alloc_Linteger,
+DEFINE_CCALLABLE_STUB(SEXP, alloc_LLint,
(const char *classname, R_xlen_t length),
( classname, length)
)
@@ -455,7 +495,7 @@ DEFINE_CCALLABLE_STUB(SEXP, list_as_data_frame,
)
/*
- * Stubs for callables defined in int_utils.c
+ * Stubs for callables defined in integer_utils.c
*/
DEFINE_CCALLABLE_STUB(int, check_integer_pairs,
diff --git a/inst/unitTests/test_List-class.R b/inst/unitTests/test_List-class.R
index ddfbcba..739a132 100644
--- a/inst/unitTests/test_List-class.R
+++ b/inst/unitTests/test_List-class.R
@@ -39,22 +39,26 @@ test_List_unlist <- function() {
names(x0)[2] <- names(x)[2] <- NA
target <- unlist(x0)
- names(target)[2:4] <- NA # base::unlist() behaviour not what we want!
+ names(target)[2:4] <- "" # base::unlist() behaviour not what we want!
current <- unlist(x)
checkIdentical(target, current)
names(x0[[2]])[] <- names(x[[2]])[] <- NA
target <- unlist(x0)
+ names(target)[2:4] <- NA # base::unlist() behaviour not what we want!
current <- unlist(x)
checkIdentical(target, current)
names(x0[[2]]) <- names(x[[2]]) <- "b"
target <- unlist(x0)
+ names(target)[2:4] <- c("b", NA, NA) # base::unlist() behaviour not what
+ # we want!
current <- unlist(x)
checkIdentical(target, current)
names(x0[[2]])[] <- names(x[[2]])[] <- "a"
target <- unlist(x0)
+ names(target)[2:4] <- "a" # base::unlist() behaviour not what we want!
current <- unlist(x)
checkIdentical(target, current)
diff --git a/man/Linteger-class.Rd b/man/LLint-class.Rd
similarity index 62%
rename from man/Linteger-class.Rd
rename to man/LLint-class.Rd
index b715e87..708bef0 100644
--- a/man/Linteger-class.Rd
+++ b/man/LLint-class.Rd
@@ -1,60 +1,60 @@
-\name{Linteger-class}
+\name{LLint-class}
\docType{class}
-\alias{class:Linteger}
-\alias{Linteger-class}
+\alias{class:LLint}
+\alias{LLint-class}
-\alias{is.Linteger}
-\alias{length,Linteger-method}
+\alias{is.LLint}
+\alias{length,LLint-method}
-\alias{coerce,logical,Linteger-method}
-\alias{coerce,integer,Linteger-method}
-\alias{coerce,numeric,Linteger-method}
-\alias{coerce,character,Linteger-method}
+\alias{coerce,logical,LLint-method}
+\alias{coerce,integer,LLint-method}
+\alias{coerce,numeric,LLint-method}
+\alias{coerce,character,LLint-method}
-\alias{as.Linteger}
+\alias{as.LLint}
-\alias{as.logical.Linteger}
-\alias{as.logical,Linteger-method}
-\alias{as.integer.Linteger}
-\alias{as.integer,Linteger-method}
-\alias{as.numeric.Linteger}
-\alias{as.numeric,Linteger-method}
-\alias{as.character.Linteger}
-\alias{as.character,Linteger-method}
+\alias{as.logical.LLint}
+\alias{as.logical,LLint-method}
+\alias{as.integer.LLint}
+\alias{as.integer,LLint-method}
+\alias{as.numeric.LLint}
+\alias{as.numeric,LLint-method}
+\alias{as.character.LLint}
+\alias{as.character,LLint-method}
-\alias{Linteger}
+\alias{LLint}
-\alias{show,Linteger-method}
-\alias{showAsCell,Linteger-method}
+\alias{show,LLint-method}
+\alias{showAsCell,LLint-method}
-\alias{c,Linteger-method}
+\alias{c,LLint-method}
-\alias{NA_Linteger_}
-\alias{is.na,Linteger-method}
+\alias{NA_LLint_}
+\alias{is.na,LLint-method}
-\alias{Ops,Linteger,Linteger-method}
-\alias{Ops,Linteger,numeric-method}
-\alias{Ops,numeric,Linteger-method}
+\alias{Ops,LLint,LLint-method}
+\alias{Ops,LLint,numeric-method}
+\alias{Ops,numeric,LLint-method}
-\alias{Summary,Linteger-method}
+\alias{Summary,LLint-method}
-\title{Linteger vectors}
+\title{LLint vectors}
\description{
- The Linteger class is a container for storing a vector of \emph{large
+ The LLint class is a container for storing a vector of \emph{large
integers} (i.e. long long int values at the C level).
}
\usage{
-Linteger(length=0L)
-as.Linteger(x)
-is.Linteger(x)
+LLint(length=0L)
+as.LLint(x)
+is.LLint(x)
}
\arguments{
\item{length}{
- A non-negative number (i.e. integer, double, or Linteger value)
+ A non-negative number (i.e. integer, double, or LLint value)
specifying the desired length.
}
\item{x}{
@@ -63,15 +63,15 @@ is.Linteger(x)
}
\details{
- Linteger vectors aim to provide the same functionality as integer vectors
+ LLint vectors aim to provide the same functionality as integer vectors
in base R but their values are stored as long long int values at the C
level vs int values for integer vectors.
Note that on Intel platforms long long int values are 64-bit and int values
- 32-bit only. Therefore Linteger vectors can hold values in the +/-9.223e18
+ 32-bit only. Therefore LLint vectors can hold values in the +/-9.223e18
range (approximately) vs +/-2.147e9 only for integer vectors.
- NAs are supported and the \code{NA_Linteger_} constant is predefined for
- convenience as \code{as(NA, "Linteger")}.
+ NAs are supported and the \code{NA_LLint_} constant is predefined for
+ convenience as \code{as(NA, "LLint")}.
Names are not supported for now.
@@ -102,34 +102,34 @@ is.Linteger(x)
## SIMPLE EXAMPLES
## ---------------------------------------------------------------------
-Linteger()
-Linteger(10)
+LLint()
+LLint(10)
-as.Linteger(3e9)
-as.Linteger("3000000000")
+as.LLint(3e9)
+as.LLint("3000000000")
-x <- as.Linteger(1:10 * 111111111)
+x <- as.LLint(1:10 * 111111111)
x * x
5 * x # result as vector of doubles (i.e. 'x' coerced to double)
-5L * x # result as Linteger vector (i.e. 5L coerced to Linteger vector)
+5L * x # result as LLint vector (i.e. 5L coerced to LLint vector)
max(x)
min(x)
range(x)
sum(x)
-x <- as.Linteger(1:20)
+x <- as.LLint(1:20)
prod(x)
-x <- as.Linteger(1:21)
-prod(x) # result is out of Linteger range (+/-9.223e18)
+x <- as.LLint(1:21)
+prod(x) # result is out of LLint range (+/-9.223e18)
prod(as.numeric(x))
-x <- as.Linteger(1:75000)
+x <- as.LLint(1:75000)
sum(x * x * x) == sum(x) * sum(x)
-## Note that max(), min() and range() *always* return an Linteger vector
-## when called on an Linteger vector, even when the vector is empty:
-max(Linteger()) # NA with no warning
-min(Linteger()) # NA with no warning
+## Note that max(), min() and range() *always* return an LLint vector
+## when called on an LLint vector, even when the vector is empty:
+max(LLint()) # NA with no warning
+min(LLint()) # NA with no warning
## This differs from how max(), min() and range() behave on an empty
## integer vector:
@@ -145,9 +145,9 @@ min(integer()) # Inf with a warning
s <- "-2.9999999999999999"
as.integer(s) # -3
-## as.Linteger() converts the string *directly* to Linteger, without
+## as.LLint() converts the string *directly* to LLint, without
## coercing to double first:
-as.Linteger(s) # decimal part ignored
+as.LLint(s) # decimal part ignored
## ---------------------------------------------------------------------
## GOING FROM DOUBLE-PRECISION VALUES TO INTEGERS AND VICE-VERSA
@@ -158,21 +158,21 @@ as.Linteger(s) # decimal part ignored
2^53 == 2^53 + 1 # TRUE, yep!
## And therefore:
-as.Linteger(2^53) == as.Linteger(2^53 + 1) # also TRUE
+as.LLint(2^53) == as.LLint(2^53 + 1) # also TRUE
## This can be even more disturbing when passing a big literal integer
## value because the R parser will turn it into a double-precision value
-## before passing it to as.Linteger():
-x1 <- as.Linteger(9007199254740992) # same as as.Linteger(2^53)
+## before passing it to as.LLint():
+x1 <- as.LLint(9007199254740992) # same as as.LLint(2^53)
x1
-x2 <- as.Linteger(9007199254740993) # same as as.Linteger(2^53 + 1)
+x2 <- as.LLint(9007199254740993) # same as as.LLint(2^53 + 1)
x2
x1 == x2 # still TRUE
## However, no precision is lost if a string literal is used instead:
-x1 <- as.Linteger("9007199254740992")
+x1 <- as.LLint("9007199254740992")
x1
-x2 <- as.Linteger("9007199254740993")
+x2 <- as.LLint("9007199254740993")
x2
x1 == x2 # FALSE
x2 - x1
@@ -182,22 +182,22 @@ d2 <- as.double(x2) # warning!
d1 == d2 # TRUE
## ---------------------------------------------------------------------
-## Linteger IS IMPLEMENTED AS AN S4 CLASS
+## LLint IS IMPLEMENTED AS AN S4 CLASS
## ---------------------------------------------------------------------
-class(Linteger(10))
-typeof(Linteger(10)) # S4
-storage.mode(Linteger(10)) # S4
-is.vector(Linteger(10)) # FALSE
-is.atomic(Linteger(10)) # FALSE
+class(LLint(10))
+typeof(LLint(10)) # S4
+storage.mode(LLint(10)) # S4
+is.vector(LLint(10)) # FALSE
+is.atomic(LLint(10)) # FALSE
-## This means that an Linteger vector cannot go in an ordinary data
+## This means that an LLint vector cannot go in an ordinary data
## frame:
\dontrun{
-data.frame(id=as.Linteger(1:5)) # error!
+data.frame(id=as.LLint(1:5)) # error!
}
## A DataFrame needs to be used instead:
-DataFrame(id=as.Linteger(1:5))
+DataFrame(id=as.LLint(1:5))
## ---------------------------------------------------------------------
## SANITY CHECKS
@@ -205,22 +205,22 @@ DataFrame(id=as.Linteger(1:5))
x <- as.integer(c(0, 1, -1, -3, NA, -99))
y <- as.integer(c(-6, NA, -4:3, 0, 1999, 6:10, NA))
-xx <- as.Linteger(x)
-yy <- as.Linteger(y)
+xx <- as.LLint(x)
+yy <- as.LLint(y)
## Operations from "Arith" group:
stopifnot(identical(x + y, as.integer(xx + yy)))
-stopifnot(identical(as.Linteger(y + x), yy + xx))
+stopifnot(identical(as.LLint(y + x), yy + xx))
stopifnot(identical(x - y, as.integer(xx - yy)))
-stopifnot(identical(as.Linteger(y - x), yy - xx))
+stopifnot(identical(as.LLint(y - x), yy - xx))
stopifnot(identical(x * y, as.integer(xx * yy)))
-stopifnot(identical(as.Linteger(y * x), yy * xx))
+stopifnot(identical(as.LLint(y * x), yy * xx))
stopifnot(identical(x / y, xx / yy))
stopifnot(identical(y / x, yy / xx))
stopifnot(identical(x \%/\% y, as.integer(xx \%/\% yy)))
-stopifnot(identical(as.Linteger(y \%/\% x), yy \%/\% xx))
+stopifnot(identical(as.LLint(y \%/\% x), yy \%/\% xx))
stopifnot(identical(x \%\% y, as.integer(xx \%\% yy)))
-stopifnot(identical(as.Linteger(y \%\% x), yy \%\% xx))
+stopifnot(identical(as.LLint(y \%\% x), yy \%\% xx))
stopifnot(identical(x ^ y, xx ^ yy))
stopifnot(identical(y ^ x, yy ^ xx))
diff --git a/man/List-utils.Rd b/man/List-utils.Rd
index bd1763e..a89af36 100644
--- a/man/List-utils.Rd
+++ b/man/List-utils.Rd
@@ -123,6 +123,10 @@ pc(...)
\item{expr}{
Expression to evaluate.
}
+ \item{deparse.level}{
+ See \code{?base::\link[base]{rbind}} for a description of
+ this argument.
+ }
}
\details{
diff --git a/man/Rle-class.Rd b/man/Rle-class.Rd
index 3789b77..b1f9c7e 100644
--- a/man/Rle-class.Rd
+++ b/man/Rle-class.Rd
@@ -71,7 +71,6 @@
\alias{match,Rle,ANY-method}
\alias{show,Rle-method}
\alias{showAsCell,Rle-method}
-\alias{order,Rle-method}
\alias{sort,Rle-method}
\alias{table,Rle-method}
\alias{tabulate,Rle-method}
diff --git a/man/Rle-runstat.Rd b/man/Rle-runstat.Rd
index aef6efe..78636b6 100644
--- a/man/Rle-runstat.Rd
+++ b/man/Rle-runstat.Rd
@@ -42,7 +42,7 @@ runq(x, k, i, endrule = c("drop", "constant"), ...)
}
\arguments{
- \item{x}{
+ \item{x,y}{
The data object.
}
\item{k}{
@@ -68,6 +68,10 @@ runq(x, k, i, endrule = c("drop", "constant"), ...)
\item{i}{
An integer in [0, k] indicating which order statistic to calculate.
}
+ \item{algorithm,print.level}{
+ See \code{?stats::\link[stats]{runmed}} for a description of
+ these arguments.
+ }
\item{\dots}{Additional arguments passed to methods. Specifically,
\code{na.rm}. When \code{na.rm = TRUE}, the \code{NA} and \code{NaN}
values are removed. When \code{na.rm = FALSE}, \code{NA} is returned
diff --git a/man/Vector-class.Rd b/man/Vector-class.Rd
index adc9f26..cebfaa3 100644
--- a/man/Vector-class.Rd
+++ b/man/Vector-class.Rd
@@ -38,6 +38,8 @@
\alias{as.complex,Vector-method}
\alias{as.character,Vector-method}
\alias{as.raw,Vector-method}
+\alias{as.matrix,Vector-method}
+\alias{as.matrix.Vector}
\alias{coerce,Vector,vector-method}
\alias{coerce,Vector,logical-method}
\alias{coerce,Vector,integer-method}
diff --git a/man/str-utils.Rd b/man/character-utils.Rd
similarity index 99%
rename from man/str-utils.Rd
rename to man/character-utils.Rd
index 8736e56..9ec3a0c 100644
--- a/man/str-utils.Rd
+++ b/man/character-utils.Rd
@@ -1,4 +1,4 @@
-\name{str-utils}
+\name{character-utils}
\alias{unstrsplit}
\alias{unstrsplit,list-method}
diff --git a/src/AEbufs.c b/src/AEbufs.c
index 0c7161c..6987ffc 100644
--- a/src/AEbufs.c
+++ b/src/AEbufs.c
@@ -142,7 +142,7 @@ void _IntAE_set_val(const IntAE *ae, int val)
return;
}
-static void IntAE_extend(IntAE *ae, size_t new_buflength)
+void _IntAE_extend(IntAE *ae, size_t new_buflength)
{
ae->elts = (int *) realloc2(ae->elts, ae->_buflength,
new_buflength, sizeof(int));
@@ -154,7 +154,7 @@ static int IntAE_extend_if_full(IntAE *ae)
{
if (_IntAE_get_nelt(ae) < ae->_buflength)
return 0;
- IntAE_extend(ae, _increase_buflength(ae->_buflength));
+ _IntAE_extend(ae, _increase_buflength(ae->_buflength));
return 1;
}
@@ -185,7 +185,7 @@ IntAE *_new_IntAE(size_t buflength, size_t nelt, int val)
ae = new_empty_IntAE();
if (buflength != 0) {
- IntAE_extend(ae, buflength);
+ _IntAE_extend(ae, buflength);
_IntAE_set_nelt(ae, nelt);
_IntAE_set_val(ae, val);
}
@@ -200,7 +200,7 @@ void _IntAE_append(IntAE *ae, const int *newvals, size_t nnewval)
ae_nelt = _IntAE_get_nelt(ae);
new_nelt = ae_nelt + nnewval;
if (new_nelt > ae->_buflength)
- IntAE_extend(ae, new_nelt);
+ _IntAE_extend(ae, new_nelt);
dest = ae->elts + ae_nelt;
memcpy(dest, newvals, nnewval * sizeof(int));
_IntAE_set_nelt(ae, new_nelt);
@@ -420,7 +420,7 @@ static IntAEAE *new_empty_IntAEAE()
return aeae;
}
-static void IntAEAE_extend(IntAEAE *aeae, size_t new_buflength)
+void _IntAEAE_extend(IntAEAE *aeae, size_t new_buflength)
{
size_t old_buflength, i;
@@ -437,7 +437,7 @@ static int IntAEAE_extend_if_full(IntAEAE *aeae)
{
if (_IntAEAE_get_nelt(aeae) < aeae->_buflength)
return 0;
- IntAEAE_extend(aeae, _increase_buflength(aeae->_buflength));
+ _IntAEAE_extend(aeae, _increase_buflength(aeae->_buflength));
return 1;
}
@@ -472,7 +472,7 @@ IntAEAE *_new_IntAEAE(size_t buflength, size_t nelt)
aeae = new_empty_IntAEAE();
if (buflength != 0) {
- IntAEAE_extend(aeae, buflength);
+ _IntAEAE_extend(aeae, buflength);
for (i = 0; i < nelt; i++) {
ae = new_empty_IntAE();
_IntAEAE_insert_at(aeae, i, ae);
@@ -694,10 +694,10 @@ static IntPairAE *new_empty_IntPairAE()
return ae;
}
-static void IntPairAE_extend(IntPairAE *ae, size_t new_buflength)
+void _IntPairAE_extend(IntPairAE *ae, size_t new_buflength)
{
- IntAE_extend(ae->a, new_buflength);
- IntAE_extend(ae->b, new_buflength);
+ _IntAE_extend(ae->a, new_buflength);
+ _IntAE_extend(ae->b, new_buflength);
return;
}
@@ -714,7 +714,7 @@ IntPairAE *_new_IntPairAE(size_t buflength, size_t nelt)
ae = new_empty_IntPairAE();
if (buflength != 0) {
- IntPairAE_extend(ae, buflength);
+ _IntPairAE_extend(ae, buflength);
/* Elements are NOT initialized. */
_IntPairAE_set_nelt(ae, nelt);
}
@@ -796,7 +796,7 @@ static IntPairAEAE *new_empty_IntPairAEAE()
return aeae;
}
-static void IntPairAEAE_extend(IntPairAEAE *aeae, size_t new_buflength)
+void _IntPairAEAE_extend(IntPairAEAE *aeae, size_t new_buflength)
{
size_t old_buflength, i;
@@ -814,7 +814,7 @@ static int IntPairAEAE_extend_if_full(IntPairAEAE *aeae)
{
if (_IntPairAEAE_get_nelt(aeae) < aeae->_buflength)
return 0;
- IntPairAEAE_extend(aeae, _increase_buflength(aeae->_buflength));
+ _IntPairAEAE_extend(aeae, _increase_buflength(aeae->_buflength));
return 1;
}
@@ -850,7 +850,7 @@ IntPairAEAE *_new_IntPairAEAE(size_t buflength, size_t nelt)
aeae = new_empty_IntPairAEAE();
if (buflength != 0) {
- IntPairAEAE_extend(aeae, buflength);
+ _IntPairAEAE_extend(aeae, buflength);
for (i = 0; i < nelt; i++) {
ae = new_empty_IntPairAE();
_IntPairAEAE_insert_at(aeae, i, ae);
@@ -938,7 +938,7 @@ void _LLongAE_set_val(const LLongAE *ae, long long val)
return;
}
-static void LLongAE_extend(LLongAE *ae, size_t new_buflength)
+void _LLongAE_extend(LLongAE *ae, size_t new_buflength)
{
ae->elts = (long long *) realloc2(ae->elts, ae->_buflength,
new_buflength, sizeof(long long));
@@ -950,7 +950,7 @@ static int LLongAE_extend_if_full(LLongAE *ae)
{
if (_LLongAE_get_nelt(ae) < ae->_buflength)
return 0;
- LLongAE_extend(ae, _increase_buflength(ae->_buflength));
+ _LLongAE_extend(ae, _increase_buflength(ae->_buflength));
return 1;
}
@@ -981,7 +981,7 @@ LLongAE *_new_LLongAE(size_t buflength, size_t nelt, long long val)
ae = new_empty_LLongAE();
if (buflength != 0) {
- LLongAE_extend(ae, buflength);
+ _LLongAE_extend(ae, buflength);
_LLongAE_set_nelt(ae, nelt);
_LLongAE_set_val(ae, val);
}
@@ -1046,7 +1046,7 @@ static CharAE *new_empty_CharAE()
return ae;
}
-static void CharAE_extend(CharAE *ae, size_t new_buflength)
+void _CharAE_extend(CharAE *ae, size_t new_buflength)
{
ae->elts = (char *) realloc2(ae->elts, ae->_buflength,
new_buflength, sizeof(char));
@@ -1058,7 +1058,7 @@ static int CharAE_extend_if_full(CharAE *ae)
{
if (_CharAE_get_nelt(ae) < ae->_buflength)
return 0;
- CharAE_extend(ae, _increase_buflength(ae->_buflength));
+ _CharAE_extend(ae, _increase_buflength(ae->_buflength));
return 1;
}
@@ -1089,7 +1089,7 @@ CharAE *_new_CharAE(size_t buflength)
ae = new_empty_CharAE();
if (buflength != 0)
- CharAE_extend(ae, buflength);
+ _CharAE_extend(ae, buflength);
return ae;
}
@@ -1112,7 +1112,7 @@ void _CharAE_append_string(CharAE *ae, const char *string)
ae_nelt = _CharAE_get_nelt(ae);
new_nelt = ae_nelt + nnewval;
if (new_nelt > ae->_buflength)
- CharAE_extend(ae, new_nelt);
+ _CharAE_extend(ae, new_nelt);
dest = ae->elts + ae_nelt;
memcpy(dest, string, sizeof(char) * nnewval);
_CharAE_set_nelt(ae, new_nelt);
@@ -1141,6 +1141,18 @@ void _CharAE_delete_at(CharAE *ae, size_t at, size_t nelt)
return;
}
+SEXP _new_CHARSXP_from_CharAE(const CharAE *ae)
+{
+ size_t ae_nelt;
+
+ ae_nelt = _CharAE_get_nelt(ae);
+ if (ae_nelt > INT_MAX)
+ error("S4Vectors internal error in "
+ "_new_CHARSXP_from_CharAE: character "
+ "buffer is too long for mkCharLen()");
+ return mkCharLen(ae->elts, (int) ae_nelt);
+}
+
SEXP _new_RAW_from_CharAE(const CharAE *ae)
{
size_t ae_nelt;
@@ -1248,7 +1260,7 @@ static CharAEAE *new_empty_CharAEAE()
return aeae;
}
-static void CharAEAE_extend(CharAEAE *aeae, size_t new_buflength)
+void _CharAEAE_extend(CharAEAE *aeae, size_t new_buflength)
{
size_t old_buflength, i;
@@ -1265,7 +1277,7 @@ static int CharAEAE_extend_if_full(CharAEAE *aeae)
{
if (_CharAEAE_get_nelt(aeae) < aeae->_buflength)
return 0;
- CharAEAE_extend(aeae, _increase_buflength(aeae->_buflength));
+ _CharAEAE_extend(aeae, _increase_buflength(aeae->_buflength));
return 1;
}
@@ -1300,7 +1312,7 @@ CharAEAE *_new_CharAEAE(size_t buflength, size_t nelt)
aeae = new_empty_CharAEAE();
if (buflength != 0) {
- CharAEAE_extend(aeae, buflength);
+ _CharAEAE_extend(aeae, buflength);
for (i = 0; i < nelt; i++) {
ae = new_empty_CharAE();
_CharAEAE_insert_at(aeae, i, ae);
@@ -1320,7 +1332,7 @@ void _CharAEAE_append_string(CharAEAE *aeae, const char *string)
SEXP _new_CHARACTER_from_CharAEAE(const CharAEAE *aeae)
{
- size_t aeae_nelt, i, ae_nelt;
+ size_t aeae_nelt, i;
SEXP ans, ans_elt;
CharAE *ae;
@@ -1329,12 +1341,7 @@ SEXP _new_CHARACTER_from_CharAEAE(const CharAEAE *aeae)
PROTECT(ans = NEW_CHARACTER((R_xlen_t) aeae_nelt));
for (i = 0; i < aeae_nelt; i++) {
ae = aeae->elts[i];
- ae_nelt = _CharAE_get_nelt(ae);
- if (ae_nelt > INT_MAX)
- error("S4Vectors internal error in "
- "_new_CHARACTER_from_CharAEAE: character "
- "buffer is too long for mkCharLen()");
- PROTECT(ans_elt = mkCharLen(ae->elts, (int) ae_nelt));
+ PROTECT(ans_elt = _new_CHARSXP_from_CharAE(ae));
SET_STRING_ELT(ans, i, ans_elt);
UNPROTECT(1);
}
diff --git a/src/Linteger_class.c b/src/LLint_class.c
similarity index 77%
rename from src/Linteger_class.c
rename to src/LLint_class.c
index c518e44..315e0fc 100644
--- a/src/Linteger_class.c
+++ b/src/LLint_class.c
@@ -1,28 +1,28 @@
/****************************************************************************
- * Low-level manipulation of Linteger objects *
+ * Low-level manipulation of LLint objects *
* Author: H. Pag\`es *
****************************************************************************/
#include "S4Vectors.h"
#include <ctype.h> /* for isspace() and isdigit() */
-#define BYTES_PER_LINTEGER (sizeof(long long int) / sizeof(char))
-#define NEW_LINTEGER(n) _alloc_Linteger("Linteger", (n))
-#define LINTEGER(x) _get_Linteger_dataptr(x)
+#define BYTES_PER_LLINT (sizeof(long long int) / sizeof(char))
+#define NEW_LLINT(n) _alloc_LLint("LLint", (n))
+#define LLINT(x) _get_LLint_dataptr(x)
-int _is_Linteger(SEXP x)
+int _is_LLint(SEXP x)
{
return isObject(x) &&
- strcmp(CHAR(STRING_ELT(GET_CLASS(x), 0)), "Linteger") == 0;
+ strcmp(CHAR(STRING_ELT(GET_CLASS(x), 0)), "LLint") == 0;
}
/* --- .Call ENTRY POINT --- */
-SEXP make_RAW_from_NA_LINTEGER()
+SEXP make_RAW_from_NA_LLINT()
{
SEXP ans;
- PROTECT(ans = NEW_RAW(BYTES_PER_LINTEGER));
- *((long long int *) RAW(ans)) = NA_LINTEGER;
+ PROTECT(ans = NEW_RAW(BYTES_PER_LLINT));
+ *((long long int *) RAW(ans)) = NA_LLINT;
UNPROTECT(1);
return ans;
}
@@ -34,23 +34,23 @@ SEXP make_RAW_from_NA_LINTEGER()
static SEXP bytes_symbol = NULL;
-static SEXP get_Linteger_bytes(SEXP x)
+static SEXP get_LLint_bytes(SEXP x)
{
INIT_STATIC_SYMBOL(bytes)
return GET_SLOT(x, bytes_symbol);
}
-R_xlen_t _get_Linteger_length(SEXP x)
+R_xlen_t _get_LLint_length(SEXP x)
{
- return XLENGTH(get_Linteger_bytes(x)) / BYTES_PER_LINTEGER;
+ return XLENGTH(get_LLint_bytes(x)) / BYTES_PER_LLINT;
}
-long long int *_get_Linteger_dataptr(SEXP x)
+long long int *_get_LLint_dataptr(SEXP x)
{
- return (long long int *) RAW(get_Linteger_bytes(x));
+ return (long long int *) RAW(get_LLint_bytes(x));
}
-static void set_Linteger_bytes(SEXP x, SEXP value)
+static void set_LLint_bytes(SEXP x, SEXP value)
{
INIT_STATIC_SYMBOL(bytes)
SET_SLOT(x, bytes_symbol, value);
@@ -66,24 +66,24 @@ static void set_Linteger_bytes(SEXP x, SEXP value)
* Thus they cannot be made .Call entry points!
*/
-static SEXP new_Linteger_from_bytes(const char *classname, SEXP bytes)
+static SEXP new_LLint_from_bytes(const char *classname, SEXP bytes)
{
SEXP classdef, ans;
PROTECT(classdef = MAKE_CLASS(classname));
PROTECT(ans = NEW_OBJECT(classdef));
- set_Linteger_bytes(ans, bytes);
+ set_LLint_bytes(ans, bytes);
UNPROTECT(2);
return ans;
}
/* Allocation WITHOUT initialization. */
-SEXP _alloc_Linteger(const char *classname, R_xlen_t length)
+SEXP _alloc_LLint(const char *classname, R_xlen_t length)
{
SEXP bytes, ans;
- PROTECT(bytes = NEW_RAW(length * BYTES_PER_LINTEGER));
- PROTECT(ans = new_Linteger_from_bytes(classname, bytes));
+ PROTECT(bytes = NEW_RAW(length * BYTES_PER_LLINT));
+ PROTECT(ans = new_LLint_from_bytes(classname, bytes));
UNPROTECT(2);
return ans;
}
@@ -102,7 +102,7 @@ static void from_ints_to_llints(const int *from, long long int *to,
for (i = 0; i < n; i++, from++, to++) {
from_elt = *from;
if (from_elt == NA_INTEGER) {
- *to = NA_LINTEGER;
+ *to = NA_LLINT;
continue;
}
*to = (long long int) from_elt;
@@ -121,7 +121,7 @@ static void from_doubles_to_llints(const double *from, long long int *to,
for (i = 0; i < n; i++, from++, to++) {
from_elt = *from;
if (from_elt == NA_REAL) {
- *to = NA_LINTEGER;
+ *to = NA_LLINT;
continue;
}
if (from_elt > (double) LLONG_MAX ||
@@ -129,10 +129,10 @@ static void from_doubles_to_llints(const double *from, long long int *to,
{
if (first_time) {
warning("out-of-range values coerced to NAs "
- "in coercion to Linteger");
+ "in coercion to LLint");
first_time = 0;
}
- *to = NA_LINTEGER;
+ *to = NA_LLINT;
continue;
}
*to = (long long int) from_elt;
@@ -148,7 +148,7 @@ static int scan_llint(const char *s, long long int *out)
char c, sign;
long long int val;
- *out = NA_LINTEGER;
+ *out = NA_LLINT;
/* Skip leading spaces. */
while (isspace(c = *(s++))) {};
if (c == '\0')
@@ -201,24 +201,24 @@ static void from_STRSXP_to_llints(SEXP from, long long int *to)
for (i = 0; i < n; i++, to++) {
from_elt = STRING_ELT(from, i);
if (from_elt == NA_STRING) {
- *to = NA_LINTEGER;
+ *to = NA_LLINT;
continue;
}
if (scan_llint(CHAR(from_elt), to)) {
/* syntactically correct number but overflow */
if (first_time1) {
warning("out-of-range values coerced to NAs "
- "in coercion to Linteger");
+ "in coercion to LLint");
first_time1 = 0;
}
continue;
}
- if (*to != NA_LINTEGER)
+ if (*to != NA_LLINT)
continue;
if (first_time2) {
/* syntactically incorrect number */
warning("syntactically incorrect numbers "
- "coerced to NAs in coercion to Linteger");
+ "coerced to NAs in coercion to LLint");
first_time2 = 0;
}
}
@@ -233,7 +233,7 @@ static void from_llints_to_bools(const long long int *from, int *to,
for (i = 0; i < n; i++, from++, to++) {
from_elt = *from;
- if (from_elt == NA_LINTEGER) {
+ if (from_elt == NA_LLINT) {
*to = NA_LOGICAL;
continue;
}
@@ -252,7 +252,7 @@ static void from_llints_to_ints(const long long int *from, int *to,
first_time = 1;
for (i = 0; i < n; i++, from++, to++) {
from_elt = *from;
- if (from_elt == NA_LINTEGER) {
+ if (from_elt == NA_LLINT) {
*to = NA_INTEGER;
continue;
}
@@ -282,7 +282,7 @@ static void from_llints_to_doubles(const long long int *from, double *to,
first_time = 1;
for (i = 0; i < n; i++, from++, to++) {
from_elt = *from;
- if (from_elt == NA_LINTEGER) {
+ if (from_elt == NA_LLINT) {
*to = NA_REAL;
continue;
}
@@ -308,7 +308,7 @@ static void from_llints_to_STRSXP(const long long int *from, SEXP to)
n = XLENGTH(to);
for (i = 0; i < n; i++, from++) {
from_elt = *from;
- if (from_elt == NA_LINTEGER) {
+ if (from_elt == NA_LLINT) {
SET_STRING_ELT(to, i, NA_STRING);
continue;
}
@@ -330,102 +330,102 @@ static void from_llints_to_STRSXP(const long long int *from, SEXP to)
* Coercion.
*/
-static SEXP new_Linteger_from_ints(const int *x, R_xlen_t x_len)
+static SEXP new_LLint_from_ints(const int *x, R_xlen_t x_len)
{
SEXP ans;
- PROTECT(ans = NEW_LINTEGER(x_len));
- from_ints_to_llints(x, LINTEGER(ans), x_len);
+ PROTECT(ans = NEW_LLINT(x_len));
+ from_ints_to_llints(x, LLINT(ans), x_len);
UNPROTECT(1);
return ans;
}
/* --- .Call ENTRY POINT --- */
-SEXP new_Linteger_from_LOGICAL(SEXP x)
+SEXP new_LLint_from_LOGICAL(SEXP x)
{
- return new_Linteger_from_ints(LOGICAL(x), XLENGTH(x));
+ return new_LLint_from_ints(LOGICAL(x), XLENGTH(x));
}
/* --- .Call ENTRY POINT --- */
-SEXP new_Linteger_from_INTEGER(SEXP x)
+SEXP new_LLint_from_INTEGER(SEXP x)
{
- return new_Linteger_from_ints(INTEGER(x), XLENGTH(x));
+ return new_LLint_from_ints(INTEGER(x), XLENGTH(x));
}
/* --- .Call ENTRY POINT --- */
-SEXP new_Linteger_from_NUMERIC(SEXP x)
+SEXP new_LLint_from_NUMERIC(SEXP x)
{
R_xlen_t x_len;
SEXP ans;
x_len = XLENGTH(x);
- PROTECT(ans = NEW_LINTEGER(x_len));
- from_doubles_to_llints(REAL(x), LINTEGER(ans), x_len);
+ PROTECT(ans = NEW_LLINT(x_len));
+ from_doubles_to_llints(REAL(x), LLINT(ans), x_len);
UNPROTECT(1);
return ans;
}
/* --- .Call ENTRY POINT --- */
-SEXP new_Linteger_from_CHARACTER(SEXP x)
+SEXP new_LLint_from_CHARACTER(SEXP x)
{
R_xlen_t x_len;
SEXP ans;
x_len = XLENGTH(x);
- PROTECT(ans = NEW_LINTEGER(x_len));
- from_STRSXP_to_llints(x, LINTEGER(ans));
+ PROTECT(ans = NEW_LLINT(x_len));
+ from_STRSXP_to_llints(x, LLINT(ans));
UNPROTECT(1);
return ans;
}
/* --- .Call ENTRY POINT --- */
-SEXP new_LOGICAL_from_Linteger(SEXP x)
+SEXP new_LOGICAL_from_LLint(SEXP x)
{
R_xlen_t ans_len;
SEXP ans;
- ans_len = _get_Linteger_length(x);
+ ans_len = _get_LLint_length(x);
PROTECT(ans = NEW_LOGICAL(ans_len));
- from_llints_to_bools(LINTEGER(x), LOGICAL(ans), ans_len);
+ from_llints_to_bools(LLINT(x), LOGICAL(ans), ans_len);
UNPROTECT(1);
return ans;
}
/* --- .Call ENTRY POINT --- */
-SEXP new_INTEGER_from_Linteger(SEXP x)
+SEXP new_INTEGER_from_LLint(SEXP x)
{
R_xlen_t ans_len;
SEXP ans;
- ans_len = _get_Linteger_length(x);
+ ans_len = _get_LLint_length(x);
PROTECT(ans = NEW_INTEGER(ans_len));
- from_llints_to_ints(LINTEGER(x), INTEGER(ans), ans_len);
+ from_llints_to_ints(LLINT(x), INTEGER(ans), ans_len);
UNPROTECT(1);
return ans;
}
/* --- .Call ENTRY POINT --- */
-SEXP new_NUMERIC_from_Linteger(SEXP x)
+SEXP new_NUMERIC_from_LLint(SEXP x)
{
R_xlen_t ans_len;
SEXP ans;
- ans_len = _get_Linteger_length(x);
+ ans_len = _get_LLint_length(x);
PROTECT(ans = NEW_NUMERIC(ans_len));
- from_llints_to_doubles(LINTEGER(x), REAL(ans), ans_len);
+ from_llints_to_doubles(LLINT(x), REAL(ans), ans_len);
UNPROTECT(1);
return ans;
}
/* --- .Call ENTRY POINT --- */
-SEXP new_CHARACTER_from_Linteger(SEXP x)
+SEXP new_CHARACTER_from_LLint(SEXP x)
{
R_xlen_t ans_len;
SEXP ans;
- ans_len = _get_Linteger_length(x);
+ ans_len = _get_LLint_length(x);
PROTECT(ans = NEW_CHARACTER(ans_len));
- from_llints_to_STRSXP(LINTEGER(x), ans);
+ from_llints_to_STRSXP(LLINT(x), ans);
UNPROTECT(1);
return ans;
}
@@ -460,8 +460,8 @@ static long long int llint_div(long long int x, long long int y)
{
long long int z;
- if (x == NA_LINTEGER || y == NA_LINTEGER || y == 0LL)
- return NA_LINTEGER;
+ if (x == NA_LLINT || y == NA_LLINT || y == 0LL)
+ return NA_LLINT;
z = x / y;
if (x == 0LL || (x > 0LL) == (y > 0LL) || y * z == x)
return z;
@@ -472,8 +472,8 @@ static long long int llint_mod(long long int x, long long int y)
{
long long int z;
- if (x == NA_LINTEGER || y == NA_LINTEGER || y == 0LL)
- return NA_LINTEGER;
+ if (x == NA_LLINT || y == NA_LLINT || y == 0LL)
+ return NA_LLINT;
z = x % y;
/* The contortions below are meant to make sure that the result
has the sign of 'y'. */
@@ -485,7 +485,7 @@ static long long int llint_mod(long long int x, long long int y)
static double llint_div_as_double(long long int x, long long int y)
{
- if (x == NA_LINTEGER || y == NA_LINTEGER)
+ if (x == NA_LLINT || y == NA_LLINT)
return NA_REAL;
return (double) x / (double) y;
}
@@ -494,7 +494,7 @@ static double llint_pow_as_double(long long int x, long long int y)
{
if (x == 1LL || y == 0LL)
return 1.0;
- if (x == NA_LINTEGER || y == NA_LINTEGER)
+ if (x == NA_LLINT || y == NA_LLINT)
return NA_REAL;
return pow((double) x, (double) y);
}
@@ -542,7 +542,7 @@ static void llints_arith1(Arith1FunType arith_fun,
out[k] = arith_fun(x[i], y[j]);
}
if (_get_ovflow_flag())
- warning("NAs produced by Linteger overflow");
+ warning("NAs produced by LLint overflow");
return;
}
@@ -603,7 +603,7 @@ static void llints_compare(int op,
j = 0;
x_elt = x[i];
y_elt = y[j];
- if (x_elt == NA_LINTEGER || y_elt == NA_LINTEGER) {
+ if (x_elt == NA_LLINT || y_elt == NA_LLINT) {
out[k] = NA_LOGICAL;
continue;
}
@@ -632,7 +632,7 @@ static void llints_compare(int op,
}
/* --- .Call ENTRY POINT --- */
-SEXP Linteger_Ops(SEXP Generic, SEXP e1, SEXP e2)
+SEXP LLint_Ops(SEXP Generic, SEXP e1, SEXP e2)
{
R_xlen_t e1_len, e2_len, ans_len;
const long long int *e1_elts, *e2_elts;
@@ -642,19 +642,19 @@ SEXP Linteger_Ops(SEXP Generic, SEXP e1, SEXP e2)
int compare_op;
SEXP ans;
- e1_len = _get_Linteger_length(e1);
- e2_len = _get_Linteger_length(e2);
+ e1_len = _get_LLint_length(e1);
+ e2_len = _get_LLint_length(e2);
ans_len = compute_ans_length(e1_len, e2_len);
- e1_elts = LINTEGER(e1);
- e2_elts = LINTEGER(e2);
+ e1_elts = LLINT(e1);
+ e2_elts = LLINT(e2);
generic = CHAR(STRING_ELT(Generic, 0));
/* Operations from "Arith" group */
arith1_fun = get_arith1_fun(generic);
if (arith1_fun != NULL) {
- PROTECT(ans = NEW_LINTEGER(ans_len));
+ PROTECT(ans = NEW_LLINT(ans_len));
llints_arith1(arith1_fun, e1_elts, e1_len, e2_elts, e2_len,
- LINTEGER(ans), ans_len);
+ LLINT(ans), ans_len);
UNPROTECT(1);
return ans;
}
@@ -677,7 +677,7 @@ SEXP Linteger_Ops(SEXP Generic, SEXP e1, SEXP e2)
return ans;
}
- error("\"%s\": operation not supported on Linteger objects", generic);
+ error("\"%s\": operation not supported on LLint objects", generic);
return R_NilValue;
}
@@ -713,7 +713,7 @@ static long long int llints_summary(int op,
switch (op) {
case MAX_OP:
case MIN_OP:
- res = NA_LINTEGER;
+ res = NA_LLINT;
break;
case SUM_OP:
res = 0LL;
@@ -724,32 +724,32 @@ static long long int llints_summary(int op,
}
for (i = 0; i < in_len; i++) {
in_elt = in[i];
- if (in_elt == NA_LINTEGER) {
+ if (in_elt == NA_LLINT) {
if (na_rm)
continue;
- return NA_LINTEGER;
+ return NA_LLINT;
}
switch (op) {
case MAX_OP:
- if (res == NA_LINTEGER || in_elt > res)
+ if (res == NA_LLINT || in_elt > res)
res = in_elt;
break;
case MIN_OP:
- if (res == NA_LINTEGER || in_elt < res)
+ if (res == NA_LLINT || in_elt < res)
res = in_elt;
break;
case SUM_OP:
res = _safe_llint_add(res, in_elt);
- if (res == NA_LINTEGER) {
- warning("Linteger overflow - "
+ if (res == NA_LLINT) {
+ warning("LLint overflow - "
"use sum(as.numeric(.))");
return res;
}
break;
case PROD_OP:
res = _safe_llint_mult(res, in_elt);
- if (res == NA_LINTEGER) {
- warning("Linteger overflow - "
+ if (res == NA_LLINT) {
+ warning("LLint overflow - "
"use prod(as.numeric(.))");
return res;
}
@@ -759,7 +759,7 @@ static long long int llints_summary(int op,
return res;
}
-SEXP Linteger_Summary(SEXP Generic, SEXP x, SEXP na_rm)
+SEXP LLint_Summary(SEXP Generic, SEXP x, SEXP na_rm)
{
R_xlen_t x_len;
const long long int *x_elts;
@@ -767,29 +767,29 @@ SEXP Linteger_Summary(SEXP Generic, SEXP x, SEXP na_rm)
int summary_op;
SEXP ans;
- x_len = _get_Linteger_length(x);
- x_elts = LINTEGER(x);
+ x_len = _get_LLint_length(x);
+ x_elts = LLINT(x);
generic = CHAR(STRING_ELT(Generic, 0));
summary_op = get_summary_op(generic);
if (summary_op != 0) {
- PROTECT(ans = NEW_LINTEGER(1));
- LINTEGER(ans)[0] = llints_summary(summary_op, x_elts, x_len,
- LOGICAL(na_rm)[0]);
+ PROTECT(ans = NEW_LLINT(1));
+ LLINT(ans)[0] = llints_summary(summary_op, x_elts, x_len,
+ LOGICAL(na_rm)[0]);
UNPROTECT(1);
return ans;
}
if (strcmp(generic, "range") == 0) {
- PROTECT(ans = NEW_LINTEGER(2));
- LINTEGER(ans)[0] = llints_summary(MIN_OP, x_elts, x_len,
- LOGICAL(na_rm)[0]);
- LINTEGER(ans)[1] = llints_summary(MAX_OP, x_elts, x_len,
- LOGICAL(na_rm)[0]);
+ PROTECT(ans = NEW_LLINT(2));
+ LLINT(ans)[0] = llints_summary(MIN_OP, x_elts, x_len,
+ LOGICAL(na_rm)[0]);
+ LLINT(ans)[1] = llints_summary(MAX_OP, x_elts, x_len,
+ LOGICAL(na_rm)[0]);
UNPROTECT(1);
return ans;
}
- error("\"%s\": operation not supported on Linteger objects", generic);
+ error("\"%s\": operation not supported on LLint objects", generic);
return R_NilValue;
}
diff --git a/src/R_init_S4Vectors.c b/src/R_init_S4Vectors.c
index a056d6e..468e83d 100644
--- a/src/R_init_S4Vectors.c
+++ b/src/R_init_S4Vectors.c
@@ -18,16 +18,16 @@ static const R_CallMethodDef callMethods[] = {
/* anyMissing.c */
CALLMETHOD_DEF(anyMissing, 1),
-/* Linteger_class.c */
- CALLMETHOD_DEF(make_RAW_from_NA_LINTEGER, 0),
- CALLMETHOD_DEF(new_Linteger_from_LOGICAL, 1),
- CALLMETHOD_DEF(new_Linteger_from_INTEGER, 1),
- CALLMETHOD_DEF(new_Linteger_from_NUMERIC, 1),
- CALLMETHOD_DEF(new_Linteger_from_CHARACTER, 1),
- CALLMETHOD_DEF(new_LOGICAL_from_Linteger, 1),
- CALLMETHOD_DEF(new_INTEGER_from_Linteger, 1),
- CALLMETHOD_DEF(new_NUMERIC_from_Linteger, 1),
- CALLMETHOD_DEF(new_CHARACTER_from_Linteger, 1),
+/* LLint_class.c */
+ CALLMETHOD_DEF(make_RAW_from_NA_LLINT, 0),
+ CALLMETHOD_DEF(new_LLint_from_LOGICAL, 1),
+ CALLMETHOD_DEF(new_LLint_from_INTEGER, 1),
+ CALLMETHOD_DEF(new_LLint_from_NUMERIC, 1),
+ CALLMETHOD_DEF(new_LLint_from_CHARACTER, 1),
+ CALLMETHOD_DEF(new_LOGICAL_from_LLint, 1),
+ CALLMETHOD_DEF(new_INTEGER_from_LLint, 1),
+ CALLMETHOD_DEF(new_NUMERIC_from_LLint, 1),
+ CALLMETHOD_DEF(new_CHARACTER_from_LLint, 1),
/* subsetting_utils.c */
CALLMETHOD_DEF(vector_OR_factor_extract_positions, 2),
@@ -37,14 +37,10 @@ static const R_CallMethodDef callMethods[] = {
CALLMETHOD_DEF(sapply_NROW, 1),
/* logical_utils.c */
- CALLMETHOD_DEF(logical_as_compact_bitvector, 1),
- CALLMETHOD_DEF(compact_bitvector_as_logical, 2),
- CALLMETHOD_DEF(subset_compact_bitvector, 2),
- CALLMETHOD_DEF(compact_bitvector_bit_count, 1),
- CALLMETHOD_DEF(compact_bitvector_last_bit, 1),
- CALLMETHOD_DEF(compact_bitvector_set_op, 3),
-
-/* int_utils.c */
+ CALLMETHOD_DEF(logical_sum, 2),
+ CALLMETHOD_DEF(logical2_sum, 2),
+
+/* integer_utils.c */
CALLMETHOD_DEF(Integer_any_missing_or_outside, 3),
CALLMETHOD_DEF(Integer_diff_with_0, 1),
CALLMETHOD_DEF(Integer_diff_with_last, 2),
@@ -69,7 +65,7 @@ static const R_CallMethodDef callMethods[] = {
CALLMETHOD_DEF(Integer_fancy_mseq, 3),
CALLMETHOD_DEF(findIntervalAndStartFromWidth, 2),
-/* str_utils.c */
+/* character_utils.c */
CALLMETHOD_DEF(unstrsplit_list, 2),
CALLMETHOD_DEF(safe_strexplode, 1),
CALLMETHOD_DEF(strsplit_as_list_of_ints, 2),
@@ -139,6 +135,7 @@ void R_init_S4Vectors(DllInfo *info)
REGISTER_CCALLABLE(_IntAE_get_nelt);
REGISTER_CCALLABLE(_IntAE_set_nelt);
REGISTER_CCALLABLE(_IntAE_set_val);
+ REGISTER_CCALLABLE(_IntAE_extend);
REGISTER_CCALLABLE(_IntAE_insert_at);
REGISTER_CCALLABLE(_new_IntAE);
REGISTER_CCALLABLE(_IntAE_append);
@@ -152,6 +149,7 @@ void R_init_S4Vectors(DllInfo *info)
REGISTER_CCALLABLE(_new_IntAE_from_CHARACTER);
REGISTER_CCALLABLE(_IntAEAE_get_nelt);
REGISTER_CCALLABLE(_IntAEAE_set_nelt);
+ REGISTER_CCALLABLE(_IntAEAE_extend);
REGISTER_CCALLABLE(_IntAEAE_insert_at);
REGISTER_CCALLABLE(_new_IntAEAE);
REGISTER_CCALLABLE(_IntAEAE_pappend);
@@ -162,28 +160,34 @@ void R_init_S4Vectors(DllInfo *info)
REGISTER_CCALLABLE(_IntAEAE_toEnvir);
REGISTER_CCALLABLE(_IntPairAE_get_nelt);
REGISTER_CCALLABLE(_IntPairAE_set_nelt);
+ REGISTER_CCALLABLE(_IntPairAE_extend);
REGISTER_CCALLABLE(_IntPairAE_insert_at);
REGISTER_CCALLABLE(_new_IntPairAE);
REGISTER_CCALLABLE(_IntPairAEAE_get_nelt);
REGISTER_CCALLABLE(_IntPairAEAE_set_nelt);
+ REGISTER_CCALLABLE(_IntPairAEAE_extend);
REGISTER_CCALLABLE(_IntPairAEAE_insert_at);
REGISTER_CCALLABLE(_new_IntPairAEAE);
REGISTER_CCALLABLE(_LLongAE_get_nelt);
REGISTER_CCALLABLE(_LLongAE_set_nelt);
REGISTER_CCALLABLE(_LLongAE_set_val);
+ REGISTER_CCALLABLE(_LLongAE_extend);
REGISTER_CCALLABLE(_LLongAE_insert_at);
REGISTER_CCALLABLE(_new_LLongAE);
REGISTER_CCALLABLE(_CharAE_get_nelt);
REGISTER_CCALLABLE(_CharAE_set_nelt);
+ REGISTER_CCALLABLE(_CharAE_extend);
REGISTER_CCALLABLE(_CharAE_insert_at);
REGISTER_CCALLABLE(_new_CharAE);
REGISTER_CCALLABLE(_new_CharAE_from_string);
REGISTER_CCALLABLE(_CharAE_append_string);
REGISTER_CCALLABLE(_CharAE_delete_at);
+ REGISTER_CCALLABLE(_new_CHARSXP_from_CharAE);
REGISTER_CCALLABLE(_new_RAW_from_CharAE);
REGISTER_CCALLABLE(_new_LOGICAL_from_CharAE);
REGISTER_CCALLABLE(_CharAEAE_get_nelt);
REGISTER_CCALLABLE(_CharAEAE_set_nelt);
+ REGISTER_CCALLABLE(_CharAEAE_extend);
REGISTER_CCALLABLE(_CharAEAE_insert_at);
REGISTER_CCALLABLE(_new_CharAEAE);
REGISTER_CCALLABLE(_CharAEAE_append_string);
@@ -192,11 +196,11 @@ void R_init_S4Vectors(DllInfo *info)
/* SEXP_utils.c */
REGISTER_CCALLABLE(_get_classname);
-/* Linteger_class.c */
- REGISTER_CCALLABLE(_is_Linteger);
- REGISTER_CCALLABLE(_get_Linteger_length);
- REGISTER_CCALLABLE(_get_Linteger_dataptr);
- REGISTER_CCALLABLE(_alloc_Linteger);
+/* LLint_class.c */
+ REGISTER_CCALLABLE(_is_LLint);
+ REGISTER_CCALLABLE(_get_LLint_length);
+ REGISTER_CCALLABLE(_get_LLint_dataptr);
+ REGISTER_CCALLABLE(_alloc_LLint);
/* subsetting_utils.c */
REGISTER_CCALLABLE(_copy_vector_block);
@@ -207,7 +211,7 @@ void R_init_S4Vectors(DllInfo *info)
REGISTER_CCALLABLE(_vector_memcmp);
REGISTER_CCALLABLE(_list_as_data_frame);
-/* int_utils.c */
+/* integer_utils.c */
REGISTER_CCALLABLE(_check_integer_pairs);
REGISTER_CCALLABLE(_find_interv_and_start_from_width);
diff --git a/src/Rle_class.c b/src/Rle_class.c
index 034cc0d..ba33736 100644
--- a/src/Rle_class.c
+++ b/src/Rle_class.c
@@ -54,14 +54,14 @@ SEXP Rle_length(SEXP x)
x_nrun = XLENGTH(x_lengths);
x_lengths_dataptr = INTEGER(x_lengths);
sum = sum_int_lengths(x_lengths_dataptr, x_nrun);
- } else if (_is_Linteger(x_lengths)) {
- x_nrun = _get_Linteger_length(x_lengths);
- x_lengths_dataptr = _get_Linteger_dataptr(x_lengths);
+ } else if (_is_LLint(x_lengths)) {
+ x_nrun = _get_LLint_length(x_lengths);
+ x_lengths_dataptr = _get_LLint_dataptr(x_lengths);
sum = sum_llint_lengths(x_lengths_dataptr, x_nrun);
} else {
error("S4Vectors internal error in Rle_length(): "
"'runLengths(x)' is not an integer\n"
- " or Linteger vector");
+ " or LLint vector");
}
if (sum < 0)
error("S4Vectors internal error in Rle_length(): "
@@ -69,8 +69,8 @@ SEXP Rle_length(SEXP x)
if (sum > R_XLEN_T_MAX)
error("S4Vectors internal error in Rle_length(): "
"Rle vector is too long");
- PROTECT(ans = _alloc_Linteger("Linteger", 1));
- _get_Linteger_dataptr(ans)[0] = sum;
+ PROTECT(ans = _alloc_LLint("LLint", 1));
+ _get_LLint_dataptr(ans)[0] = sum;
UNPROTECT(1);
return ans;
}
@@ -108,7 +108,7 @@ static int check_llint_lengths(const long long int *lengths, R_xlen_t nrun)
no_big_lengths = 1;
for (i = 0; i < nrun; i++, lengths++) {
- if (*lengths == NA_LINTEGER) {
+ if (*lengths == NA_LLINT) {
snprintf(validity_msg, sizeof(validity_msg),
"some run lengths are NA");
return 1;
@@ -123,7 +123,7 @@ static int check_llint_lengths(const long long int *lengths, R_xlen_t nrun)
}
if (no_big_lengths) {
snprintf(validity_msg, sizeof(validity_msg),
- "the run lengths are stored in an Linteger vector\n"
+ "the run lengths are stored in an LLint vector\n"
" when they could be in an integer vector");
return 1;
}
@@ -140,13 +140,13 @@ static int valid_run_lengths(SEXP lengths)
lengths_dataptr = INTEGER(lengths);
return check_int_lengths(lengths_dataptr, nrun);
}
- if (_is_Linteger(lengths)) {
- nrun = _get_Linteger_length(lengths);
- lengths_dataptr = _get_Linteger_dataptr(lengths);
+ if (_is_LLint(lengths)) {
+ nrun = _get_LLint_length(lengths);
+ lengths_dataptr = _get_LLint_dataptr(lengths);
return check_llint_lengths(lengths_dataptr, nrun);
}
snprintf(validity_msg, sizeof(validity_msg),
- "'runLengths(x)' must be an integer or Linteger vector");
+ "'runLengths(x)' must be an integer or LLint vector");
return 1;
}
@@ -170,7 +170,7 @@ SEXP Rle_valid(SEXP x)
#define CHECK_RUN_LENGTH_IN(len_in, lengths_in_is_L) \
{ \
if (lengths_in_is_L) { \
- if ((len_in) == NA_LINTEGER) \
+ if ((len_in) == NA_LLINT) \
error("some run lengths are NA"); \
if ((len_in) > R_XLEN_T_MAX) \
error("Rle vector is too long"); \
@@ -685,8 +685,8 @@ static SEXP alloc_lengths(R_xlen_t nrun_out, int lengths_out_is_L,
/* No need to PROTECT() */
if (lengths_out_is_L) {
- lengths = _alloc_Linteger("Linteger", nrun_out);
- *dataptr_p = _get_Linteger_dataptr(lengths);
+ lengths = _alloc_LLint("LLint", nrun_out);
+ *dataptr_p = _get_LLint_dataptr(lengths);
} else {
lengths = NEW_INTEGER(nrun_out);
*dataptr_p = INTEGER(lengths);
@@ -908,9 +908,9 @@ SEXP _construct_Rle(SEXP values_in,
*
* --- .Call ENTRY POINT ---
* Args:
- * lengths_in: An integer or Linteger vector of the same length as 'values'
- * with no NAs or negative values, or a NULL. If NULL then all
- * the runs are considered to be of length 1 like if
+ * lengths_in: An integer or LLint vector of the same length as 'values'
+ * with no NAs or negative values, or a NULL. If NULL then
+ * all the runs are considered to be of length 1 like if
* lengths_in was 'rep(1, length(values))'.
*/
@@ -930,13 +930,13 @@ SEXP Rle_constructor(SEXP values_in, SEXP lengths_in)
if (IS_INTEGER(lengths_in)) {
lengths_in_len = XLENGTH(lengths_in);
lengths_in_dataptr = INTEGER(lengths_in);
- } else if (_is_Linteger(lengths_in)) {
+ } else if (_is_LLint(lengths_in)) {
lengths_in_is_L = 1;
- lengths_in_len = _get_Linteger_length(lengths_in);
- lengths_in_dataptr = _get_Linteger_dataptr(lengths_in);
+ lengths_in_len = _get_LLint_length(lengths_in);
+ lengths_in_dataptr = _get_LLint_dataptr(lengths_in);
} else {
error("the supplied 'lengths' must be an integer or "
- "Linteger vector, or a NULL");
+ "LLint vector, or a NULL");
}
if (nrun_in != lengths_in_len)
error("'length(values)' != 'length(lengths)'");
diff --git a/src/Rle_utils.c b/src/Rle_utils.c
index 029ee7f..77da583 100644
--- a/src/Rle_utils.c
+++ b/src/Rle_utils.c
@@ -175,8 +175,8 @@ SEXP Rle_runsum(SEXP x, SEXP k, SEXP na_rm)
lengths_in = INTEGER(x_lengths);
lengths_in_is_L = 0;
} else {
- nrun_in = _get_Linteger_length(x_lengths);
- lengths_in = _get_Linteger_dataptr(x_lengths);
+ nrun_in = _get_LLint_length(x_lengths);
+ lengths_in = _get_LLint_dataptr(x_lengths);
lengths_in_is_L = 1;
}
nrun_out = compute_nrun_out(nrun_in, lengths_in, lengths_in_is_L, k0);
diff --git a/src/S4Vectors.h b/src/S4Vectors.h
index 8102a76..14fe2e5 100644
--- a/src/S4Vectors.h
+++ b/src/S4Vectors.h
@@ -225,6 +225,11 @@ void _IntAE_set_val(
int val
);
+void _IntAE_extend(
+ IntAE *ae,
+ size_t new_buflength
+);
+
void _IntAE_insert_at(
IntAE *ae,
size_t at,
@@ -288,6 +293,11 @@ size_t _IntAEAE_set_nelt(
size_t nelt
);
+void _IntAEAE_extend(
+ IntAEAE *aeae,
+ size_t new_buflength
+);
+
void _IntAEAE_insert_at(
IntAEAE *aeae,
size_t at,
@@ -335,6 +345,11 @@ size_t _IntPairAE_set_nelt(
size_t nelt
);
+void _IntPairAE_extend(
+ IntPairAE *ae,
+ size_t new_buflength
+);
+
void _IntPairAE_insert_at(
IntPairAE *ae,
size_t at,
@@ -354,6 +369,11 @@ size_t _IntPairAEAE_set_nelt(
size_t nelt
);
+void _IntPairAEAE_extend(
+ IntPairAEAE *aeae,
+ size_t new_buflength
+);
+
void _IntPairAEAE_insert_at(
IntPairAEAE *aeae,
size_t at,
@@ -377,6 +397,11 @@ void _LLongAE_set_val(
long long val
);
+void _LLongAE_extend(
+ LLongAE *ae,
+ size_t new_buflength
+);
+
void _LLongAE_insert_at(
LLongAE *ae,
size_t at,
@@ -396,6 +421,11 @@ size_t _CharAE_set_nelt(
size_t nelt
);
+void _CharAE_extend(
+ CharAE *ae,
+ size_t new_buflength
+);
+
void _CharAE_insert_at(
CharAE *ae,
size_t at,
@@ -417,6 +447,8 @@ void _CharAE_delete_at(
size_t nelt
);
+SEXP _new_CHARSXP_from_CharAE(const CharAE *ae);
+
SEXP _new_RAW_from_CharAE(const CharAE *ae);
SEXP _new_LOGICAL_from_CharAE(const CharAE *ae);
@@ -428,6 +460,11 @@ size_t _CharAEAE_set_nelt(
size_t nelt
);
+void _CharAEAE_extend(
+ CharAEAE *aeae,
+ size_t new_buflength
+);
+
void _CharAEAE_insert_at(
CharAEAE *aeae,
size_t at,
@@ -459,33 +496,33 @@ const char *_get_classname(SEXP x);
SEXP anyMissing(SEXP x);
-/* Linteger_class.c */
+/* LLint_class.c */
-int _is_Linteger(SEXP x);
+int _is_LLint(SEXP x);
-SEXP make_RAW_from_NA_LINTEGER();
+SEXP make_RAW_from_NA_LLINT();
-R_xlen_t _get_Linteger_length(SEXP x);
+R_xlen_t _get_LLint_length(SEXP x);
-long long int *_get_Linteger_dataptr(SEXP x);
+long long int *_get_LLint_dataptr(SEXP x);
-SEXP _alloc_Linteger(const char *classname, R_xlen_t length);
+SEXP _alloc_LLint(const char *classname, R_xlen_t length);
-SEXP new_Linteger_from_LOGICAL(SEXP x);
+SEXP new_LLint_from_LOGICAL(SEXP x);
-SEXP new_Linteger_from_INTEGER(SEXP x);
+SEXP new_LLint_from_INTEGER(SEXP x);
-SEXP new_Linteger_from_NUMERIC(SEXP x);
+SEXP new_LLint_from_NUMERIC(SEXP x);
-SEXP new_Linteger_from_CHARACTER(SEXP x);
+SEXP new_LLint_from_CHARACTER(SEXP x);
-SEXP new_LOGICAL_from_Linteger(SEXP x);
+SEXP new_LOGICAL_from_LLint(SEXP x);
-SEXP new_INTEGER_from_Linteger(SEXP x);
+SEXP new_INTEGER_from_LLint(SEXP x);
-SEXP new_NUMERIC_from_Linteger(SEXP x);
+SEXP new_NUMERIC_from_LLint(SEXP x);
-SEXP new_CHARACTER_from_Linteger(SEXP x);
+SEXP new_CHARACTER_from_LLint(SEXP x);
/* subsetting_utils.c */
@@ -560,20 +597,18 @@ SEXP _list_as_data_frame(
/* logical_utils.c */
-SEXP logical_as_compact_bitvector(SEXP x);
-
-SEXP compact_bitvector_as_logical(SEXP x, SEXP length_out);
-
-SEXP subset_compact_bitvector(SEXP x, SEXP subscript);
-
-SEXP compact_bitvector_bit_count(SEXP x);
-
-SEXP compact_bitvector_last_bit(SEXP x);
+SEXP logical_sum(
+ SEXP x,
+ SEXP na_rm
+);
-SEXP compact_bitvector_set_op(SEXP query, SEXP ref, SEXP align);
+SEXP logical2_sum(
+ SEXP x,
+ SEXP na_rm
+);
-/* int_utils.c */
+/* integer_utils.c */
SEXP Integer_any_missing_or_outside(SEXP x, SEXP lower, SEXP upper);
@@ -755,7 +790,7 @@ SEXP findIntervalAndStartFromWidth(
);
-/* str_utils.c */
+/* character_utils.c */
SEXP unstrsplit_list(SEXP x, SEXP sep);
diff --git a/src/str_utils.c b/src/character_utils.c
similarity index 99%
rename from src/str_utils.c
rename to src/character_utils.c
index e4ddfdf..24379fc 100644
--- a/src/str_utils.c
+++ b/src/character_utils.c
@@ -91,7 +91,7 @@ SEXP unstrsplit_list(SEXP x, SEXP sep)
SEXP ans, sep0, x_elt, ans_elt, ans_names;
int x_len, sep0_len, i;
- if (!IS_LIST(x))
+ if (!isVectorList(x))
error("'x' must be a list");
if (!(IS_CHARACTER(sep) && LENGTH(sep) == 1))
error("'sep' must be a single string");
diff --git a/src/int_utils.c b/src/integer_utils.c
similarity index 100%
rename from src/int_utils.c
rename to src/integer_utils.c
diff --git a/src/logical_utils.c b/src/logical_utils.c
index 8927801..be9327f 100644
--- a/src/logical_utils.c
+++ b/src/logical_utils.c
@@ -1,199 +1,149 @@
#include "S4Vectors.h"
-#include <limits.h> /* for CHAR_BIT */
-#include <stdlib.h> /* for div() */
+// R_XLEN_T_MAX is 2^52
+// LLONG_MAX is 2^63-1
-#define BIT7_MASK (1 << (CHAR_BIT-1))
-
-#define END_OP 0
-#define S_H_OP 1
-#define N_OP 2
-#define BAD_OP 3
-#define P_OP 4
-#define I_OP 5
-#define D_OP 6
-#define M_OP 7
-
-static const unsigned char BitsSetTable256[256] =
+static SEXP sum_as_SEXP(R_xlen_t sum)
{
-# define B2(n) n, n+1, n+1, n+2
-# define B4(n) B2(n), B2(n+1), B2(n+1), B2(n+2)
-# define B6(n) B4(n), B4(n+1), B4(n+1), B4(n+2)
- B6(0), B6(1), B6(1), B6(2)
-};
-
-/* Turns a logical vector into a "compact bit vector" */
-SEXP logical_as_compact_bitvector(SEXP x)
-{
- SEXP ans;
- Rbyte *ans_elt;
- int x_length, ans_length, i, j, x_elt;
- div_t q;
-
- x_length = LENGTH(x);
- q = div(x_length, CHAR_BIT);
- ans_length = q.quot;
- if (q.rem != 0)
- ans_length++;
- PROTECT(ans = NEW_RAW(ans_length));
- for (i = j = 0, ans_elt = RAW(ans); i < x_length; i++, j++) {
- if (j >= CHAR_BIT) {
- j = 0;
- ans_elt++;
- }
- *ans_elt <<= 1;
- x_elt = LOGICAL(x)[i];
- if (x_elt == NA_INTEGER) {
- UNPROTECT(1);
- error("'x' contains NAs");
- }
- if (x_elt)
- *ans_elt |= 1;
- }
- if (q.rem != 0)
- *ans_elt <<= CHAR_BIT - q.rem;
- UNPROTECT(1);
- return ans;
+ /* If 'sum' is <= INT_MAX, we return it as an integer vector of length
+ 1. Otherwise, as a double vector of length 1. Since it's guaranteed
+ to be <= R_XLEN_T_MAX, then it can always be exactly represented as
+ a double. */
+ return sum <= INT_MAX ? ScalarInteger((int) sum) :
+ ScalarReal((double) sum);
}
-/* Turns a "compact bit vector" into a logical vector */
-SEXP compact_bitvector_as_logical(SEXP x, SEXP length_out)
+/*
+ Unlike base::sum() which can overflow (and return NA_integer_) on a long
+ logical vector, logical_sum() never overflows. It returns a double if the
+ result cannot be represented as an int (which is what length() does).
+ Note that logical_sum() is slightly faster than base::sum():
+
+ length(x) base::sum() logical_sum() speedup
+ --------- ----------- ------------- -------
+ rhino3:
+ 1e8 83 ms 74 ms 12%
+ 1e9 0.84 s 0.75 s 12%
+ 3e9 2.52 s 2.35 s 13% <-- long vector
+ malbec1:
+ 1e8 93 ms 74 ms 26%
+ 1e9 0.92 s 0.75 s 23%
+ veracruz1:
+ 1e8 121 ms 93 ms 30%
+ 1e9 1.27 s 1.01 s 26%
+
+ - rhino3: Linux server, Intel(R) Xeon(R) CPU E5-2697 v3 @ 2.60GHz (56
+ cores), 384 GB of RAM, with Ubuntu Ubuntu 14.04.3 LTS, gcc 4.8.4,
+ R 3.4.0 installed from source (default compiler options and flags).
+ - malbec1: HP ProLiant DL360 Gen9 server, Intel(R) Xeon(R) CPU E5-2640
+ v4 @ 2.40GHz (20 cores), 32 GB of RAM, with Ubuntu 16.04.2 LTS, gcc 5.4.0,
+ R 3.4.0 installed from source (default compiler options and flags).
+ - veracruz1: virtualized Mac Pro Server at Mac Stadium
+ (https://www.macstadium.com), Quad-Core Intel Xeon E5 3.7 GHz,
+ 32 GB of RAM, with El Capitan, clang 4.0.0, R 3.4.0 (CRAN binary).
+
+ I did not time this on Windows.
+*/
+SEXP logical_sum(SEXP x, SEXP na_rm)
{
- SEXP ans;
- Rbyte x_elt;
- int ans_length, x_length, i, j, k;
-
- ans_length = INTEGER(length_out)[0];
- x_length = LENGTH(x);
- if (ans_length > x_length * CHAR_BIT)
- error("'length_out' is > 'length(x)' * %d", CHAR_BIT);
- PROTECT(ans = NEW_LOGICAL(ans_length));
- for (i = j = 0, x_elt = RAW(x)[k = 0]; i < ans_length; i++, j++) {
- if (j >= CHAR_BIT) {
- j = 0;
- x_elt = RAW(x)[++k];
- }
- LOGICAL(ans)[i] = (x_elt & BIT7_MASK) != 0;
- x_elt <<= 1;
- }
- UNPROTECT(1);
- return ans;
-}
-
-/* Subsets a "compact bit vector" */
-SEXP subset_compact_bitvector(SEXP x, SEXP subscript)
-{
- SEXP ans;
- Rbyte *ans_elt;
- int x_length, subscript_length, ans_length, i, j, sub_i;
- div_t q, q2;
-
- x_length = LENGTH(x);
- subscript_length = LENGTH(subscript);
- q = div(subscript_length, CHAR_BIT);
- ans_length = q.quot;
- if (q.rem != 0)
- ans_length++;
- PROTECT(ans = NEW_RAW(ans_length));
- for (i = j = 0, ans_elt = RAW(ans); i < subscript_length; i++, j++) {
- if (j >= CHAR_BIT) {
- j = 0;
- ans_elt++;
- }
- *ans_elt <<= 1;
- sub_i = INTEGER(subscript)[i];
- if (sub_i == NA_INTEGER) {
- UNPROTECT(1);
- error("subscript contains NAs");
+ R_xlen_t x_len, sum, i;
+ const int *x_dataptr;
+ int na_rm0, x_elt;
+
+ x_len = XLENGTH(x);
+ x_dataptr = LOGICAL(x);
+ na_rm0 = LOGICAL(na_rm)[0];
+ sum = 0;
+ for (i = 0; i < x_len; i++) {
+ x_elt = x_dataptr[i];
+ if (x_elt == NA_LOGICAL) {
+ if (na_rm0)
+ continue;
+ return ScalarInteger(NA_INTEGER);
}
- sub_i--;
- q2 = div(sub_i, CHAR_BIT);
- if (sub_i < 0 || q2.quot >= x_length) {
- UNPROTECT(1);
- error("subscript out of bounds");
- }
- if (RAW(x)[q2.quot] & (BIT7_MASK >> q2.rem))
- *ans_elt |= 1;
- }
- if (q.rem != 0)
- *ans_elt <<= CHAR_BIT - q.rem;
- UNPROTECT(1);
- return ans;
-}
-
-SEXP compact_bitvector_bit_count(SEXP x)
-{
- SEXP ans;
- Rbyte *x_elt;
- int *ans_elt, ans_length, i;
-
- ans_length = LENGTH(x);
- PROTECT(ans = NEW_INTEGER(ans_length));
- for (i = 0, x_elt = RAW(x), ans_elt = INTEGER(ans); i < ans_length;
- i++, x_elt++, ans_elt++) {
- *ans_elt = BitsSetTable256[*x_elt];
- }
- UNPROTECT(1);
- return(ans);
-}
-
-SEXP compact_bitvector_last_bit(SEXP x)
-{
- SEXP ans;
- Rbyte LAST_MASK, *x_elt;
- int *ans_elt, ans_length, i;
-
- LAST_MASK = BIT7_MASK >> 7;
- ans_length = LENGTH(x);
- PROTECT(ans = NEW_INTEGER(ans_length));
- for (i = 0, x_elt = RAW(x), ans_elt = INTEGER(ans); i < ans_length;
- i++, x_elt++, ans_elt++) {
- *ans_elt = (*x_elt & LAST_MASK) != 0;
+ /* IIRC some comments in the R source code seem to suggest
+ that TRUEs are not guaranteed to be represented by ones
+ at the C level. */
+ if (x_elt)
+ sum++;
}
- UNPROTECT(1);
- return(ans);
+ return sum_as_SEXP(sum);
}
-SEXP compact_bitvector_set_op(SEXP query, SEXP ref, SEXP align)
+/*
+ Playing around with logical vectors stored in char arrays.
+
+ Storing logical vectors in int arrays like R does is such a waste of memory!
+ By using chars instead of ints very common operations like sum(x < 0.9) (this
+ is probably the primary use case for sum()!) would require 4x less memory.
+ This is particularly relevant if 'x' is a long vector (e.g. length(x) = 3e9)
+ where R currently spends a significant amount of time allocating memory (e.g.
+ 12Gb) to store the temporary logical vector.
+
+ Unfortunately walking on a char array is significantly faster than
+ base::sum() on Linux but not on Mac where it's more than 3x slower:
+
+ length(x) base::sum() logical2_sum() speedup
+ --------- ----------- -------------- -------
+ rhino3:
+ 1e8 83 ms 66 ms 25%
+ 1e9 0.84 s 0.66 s 27%
+ 3e9 2.52 s 1.93 s 30% <-- long vector
+ malbec1:
+ 1e8 93 ms 64 ms 45%
+ 1e9 0.92 s 0.63 s 46%
+ veracruz1:
+ 1e8 121 ms 398 ms not so good!
+ 1e9 1.27 s 4.05 s not so good!
+
+ To compare base::sum() vs logical_sum() vs logical2_sum():
+
+ library(S4Vectors)
+ sum1 <- function(x, na.rm=FALSE)
+ .Call("logical_sum", x, na.rm, PACKAGE="S4Vectors")
+ sum2 <- function(x, na.rm=FALSE)
+ .Call("logical2_sum", x, na.rm, PACKAGE="S4Vectors")
+
+ x <- as.logical(sample(2L, 1e8, replace=TRUE) - 1L)
+ x2 <- as.raw(x)
+
+ ## Correctness
+ res0 <- sum(x, na.rm=FALSE)
+ res1 <- sum1(x, na.rm=FALSE)
+ res2 <- sum2(x2, na.rm=FALSE)
+ stopifnot(identical(res0, res1))
+ stopifnot(identical(res0, res2))
+
+ ## Speed
+ system.time(replicate(20, sum(x, na.rm=FALSE)))
+ system.time(replicate(20, sum1(x, na.rm=FALSE)))
+ system.time(replicate(20, sum2(x2, na.rm=FALSE)))
+
+*/
+#define NA_LOGICAL2 127 /* Arbitrary choice. Could be set to anything
+ but 0 or 1. */
+#define LOGICAL2(x) ((char *) RAW(x))
+SEXP logical2_sum(SEXP x, SEXP na_rm)
{
- SEXP ans;
- Rbyte *ans_elt, query_elt, ref_elt, align_elt;
- int ans_length, i, j, k, op;
-
- ans_length = 8 * LENGTH(query);
- PROTECT(ans = NEW_RAW(ans_length));
- j = k = 0;
- query_elt = RAW(query)[0];
- ref_elt = RAW(ref)[0];
- align_elt = RAW(align)[0];
- for (i = 0, ans_elt = RAW(ans); i < ans_length; i++, ans_elt++) {
- if (j >= CHAR_BIT) {
- j = 0;
- k++;
- query_elt = RAW(query)[k];
- ref_elt = RAW(ref)[k];
- align_elt = RAW(align)[k];
- }
- op =
- ((query_elt & BIT7_MASK) != 0) +
- (((ref_elt & BIT7_MASK) != 0) << 1) +
- (((align_elt & BIT7_MASK) != 0) << 2);
- switch (op) {
- case M_OP: *ans_elt = 'M'; break;
- case I_OP: *ans_elt = 'I'; break;
- case D_OP: *ans_elt = 'D'; break;
- case N_OP: *ans_elt = 'N'; break;
- case S_H_OP: *ans_elt = 'S'; break;
- case P_OP: *ans_elt = 'P'; break;
- case END_OP: *ans_elt = '|'; break;
- case BAD_OP: *ans_elt = '?'; break;
+ R_xlen_t x_len, sum, i;
+ const char *x_dataptr;
+ int na_rm0;
+ char x_elt;
+
+ x_len = XLENGTH(x);
+ x_dataptr = LOGICAL2(x);
+ na_rm0 = LOGICAL(na_rm)[0];
+ sum = 0;
+ for (i = 0; i < x_len; i++) {
+ x_elt = x_dataptr[i];
+ if (x_elt == NA_LOGICAL2) {
+ if (na_rm0)
+ continue;
+ return ScalarInteger(NA_INTEGER);
}
- query_elt <<= 1;
- ref_elt <<= 1;
- align_elt <<= 1;
- j++;
+ if (x_elt)
+ sum++;
}
- UNPROTECT(1);
- return(ans);
+ return sum_as_SEXP(sum);
}
diff --git a/src/safe_arithm.c b/src/safe_arithm.c
index 21c9888..4abb8de 100644
--- a/src/safe_arithm.c
+++ b/src/safe_arithm.c
@@ -95,56 +95,56 @@ int _safe_int_mult(int x, int y)
long long int _safe_llint_add(long long int x, long long int y)
{
- if (x == NA_LINTEGER || y == NA_LINTEGER)
- return NA_LINTEGER;
+ if (x == NA_LLINT || y == NA_LLINT)
+ return NA_LLINT;
if ((y > 0LL && x > LLONG_MAX - y) ||
(y < 0LL && x < LLONG_MIN - y))
{
ovflow_flag = 1;
- return NA_LINTEGER;
+ return NA_LLINT;
}
return x + y;
}
long long int _safe_llint_subtract(long long int x, long long int y)
{
- if (x == NA_LINTEGER || y == NA_LINTEGER)
- return NA_LINTEGER;
+ if (x == NA_LLINT || y == NA_LLINT)
+ return NA_LLINT;
if ((y < 0LL && x > LLONG_MAX + y) ||
(y > 0LL && x < LLONG_MIN + y))
{
ovflow_flag = 1;
- return NA_LINTEGER;
+ return NA_LLINT;
}
return x - y;
}
long long int _safe_llint_mult(long long int x, long long int y)
{
- if (x == NA_LINTEGER || y == NA_LINTEGER)
- return NA_LINTEGER;
+ if (x == NA_LLINT || y == NA_LLINT)
+ return NA_LLINT;
if (x > 0LL) { /* x is positive */
if (y > 0LL) { /* x and y are positive */
if (x > (LLONG_MAX / y)) {
ovflow_flag = 1;
- return NA_LINTEGER;
+ return NA_LLINT;
}
} else { /* x is positive, y is non-positive */
if (y < (LLONG_MIN / x)) {
ovflow_flag = 1;
- return NA_LINTEGER;
+ return NA_LLINT;
}
}
} else { /* x is non-positive */
if (y > 0LL) { /* x is non-positive, y is positive */
if (x < (LLONG_MIN / y)) {
ovflow_flag = 1;
- return NA_LINTEGER;
+ return NA_LLINT;
}
} else { /* x and y are non-positive */
if ((x != 0LL) && (y < (LLONG_MAX / x))) {
ovflow_flag = 1;
- return NA_LINTEGER;
+ return NA_LLINT;
}
}
}
diff --git a/src/vector_utils.c b/src/vector_utils.c
index e3065ce..727f965 100644
--- a/src/vector_utils.c
+++ b/src/vector_utils.c
@@ -106,7 +106,7 @@ SEXP _list_as_data_frame(SEXP x, int nrow)
SEXP rownames, class;
int i;
- if (!IS_LIST(x) || GET_NAMES(x) == R_NilValue)
+ if (!isVectorList(x) || GET_NAMES(x) == R_NilValue)
error("S4Vectors internal error in _list_as_data_frame(): "
"'x' must be a named list");
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-bioc-s4vectors.git
More information about the debian-med-commit
mailing list