Skip to content

Instantly share code, notes, and snippets.

@joshuaulrich
Last active May 18, 2024 20:14
Show Gist options
  • Save joshuaulrich/39f76e27faed9e62e4c01ac0e32ea76e to your computer and use it in GitHub Desktop.
Save joshuaulrich/39f76e27faed9e62e4c01ac0e32ea76e to your computer and use it in GitHub Desktop.
double64 <-
function(length = 0L, ...)
{
bytes <- 8L
x <- raw(length = bytes * length)
attr(x, "class") <- "ctype"
attr(x, "rtype") <- "double"
attr(x, "bytes") <- bytes
attr(x, "signed") <- TRUE
x
}
#`[.double64` <-
#function(x, i) {
#
#}
as.double64 <-
function(x, ...) {
UseMethod("as.double64")
}
as.double64.double <-
function(x, ...)
{
bytes <- 8L
d <- writeBin(x, raw(), size = bytes)
attr(d, "class") <- "ctype"
attr(d, "rtype") <- "double"
attr(d, "bytes") <- bytes
attr(d, "signed") <- TRUE
d
}
as.rtype <-
function(x)
{
readBin(x,
what = attr(x, "rtype"),
n = length(x),
size = attr(x, "bytes"))
}
as.double.ctype <-
function(x, ...)
{
r <- as.rtype(x)
as.double(r)
}
# methods
length.ctype <-
function(x, ...)
{
.x <- unclass(x)
length(.x) / attr(x, "bytes")
}
print.ctype <-
function(x, ...)
{
r <- as.rtype(x)
print(r, ...)
return(x)
}
format.ctype <-
function(x, ...)
{
r <- as.rtype(x)
format(r, ...)
}
str.ctype <-
function(x, ...)
{
# class and length
klass <- class(x)
len <- length(x)
if (len > 1) {
class_len <- paste0(" '", klass, "' [1:", len, "]")
} else {
class_len <- paste0(" '", klass, "'")
}
# storage information
bytes <-
paste0(paste0(if (!attr(x, "signed")) "un", "signed "),
attr(x, "bytes") * 8, "-bit ",
attr(x, "rtype"))
# bits of data
rdata <- format(as.rtype(x), digits = 10)
# print
cat(class_len, head(rdata, 3), "\n ", bytes, "\n")
}
as.data.frame.ctype <- as.data.frame.vector
# examples
str(x <- double64(10))
# 'ctype' [1:10] 0 0 0
# signed 64-bit double
str(as.rtype(x))
# num [1:10] 0 0 0 0 0 0 0 0 0
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment