diff --git a/DESCRIPTION b/DESCRIPTION new file mode 100644 index 0000000..d23bf03 --- /dev/null +++ b/DESCRIPTION @@ -0,0 +1,23 @@ +Package: refer +Type: Package +Title: Create Object References +Version: 0.1.0 +Author: Christopher Mann +Maintainer: Christopher Mann +Description: Allows users to easily create references to R objects then + 'dereference' when needed or modify in place without using reference + classes, environments, or active bindings as workarounds. Users can + also create expression references that allow subsets of any object to + be referenced or expressions containing references to multiple + objects. +License: MIT + file LICENSE +Encoding: UTF-8 +Imports: utils, stats, eList, matchr +Suggests: knitr, rmarkdown +RoxygenNote: 7.1.1 +Language: en-US +VignetteBuilder: knitr +NeedsCompilation: no +Packaged: 2021-11-06 15:54:28 UTC; chris +Repository: CRAN +Date/Publication: 2021-11-08 12:10:04 UTC diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..7c78121 --- /dev/null +++ b/LICENSE @@ -0,0 +1,2 @@ +YEAR: 2020 +COPYRIGHT HOLDER: Christopher Mann diff --git a/MD5 b/MD5 new file mode 100644 index 0000000..736b8af --- /dev/null +++ b/MD5 @@ -0,0 +1,45 @@ +52c922ec86d79bfaca9d3ddd21ce3632 *DESCRIPTION +cc5ed83e123ffeb2bfe97f8ffd33ad39 *LICENSE +44acea82a17549835806b559b5f74c8e *NAMESPACE +59a5b1085dbbd0908cdde0c5ace11dab *R/attributes.R +64cce4d806d4d355c8e2cbff7eeec757 *R/check.R +7f60f01ddb0b37a79e0895f51f9e361d *R/deref.R +ab69c9cbf2cd44d3b442a207d35f0c0e *R/getset.R +5ce18d263963570b758fe1550ed99393 *R/incr.R +ec5110032349a6b93459fbb3f6085541 *R/match.R +9e19ac73ac51efdff53688789ef3ca3b *R/methods.R +8748fa850e7ac2d4303b7e64fe6e0710 *R/modify.R +806e74e7db360c66e34a33594d270a54 *R/print.R +fb7445c990a1a21bf35ed5c9a236d99f *R/ref.R +ccbe6026d935785ca68bbed8a95234e8 *R/slice.R +3ee9e2f4bc3fa6fd938fec26b53cfa87 *R/sref.R +51d27219176f33ec40f392631207307f *build/vignette.rds +150537914960b190e7978bf56e31737c *inst/WORDLIST +8ebb6432f635cd86ae778433cd540157 *inst/doc/introRef.R +0773232d68c1b9b18459fad00c4824ae *inst/doc/introRef.Rmd +1075dde4b7bc8d19d63f77bae3fe36e7 *inst/doc/introRef.html +e5cd75d66b240098c3e7808fdf63aa00 *man/Extract.Rd +b62d0fcf808af4c92280d1b4941cf741 *man/Methods.Rd +d1a1b07c4584cf4851f645149ce60f51 *man/decr.Rd +d21358cfc8a5840e2e1df21e41f2bf6c *man/deref.Rd +582d06f9284151e703fb301463740d34 *man/getEnv.Rd +5925e98ce585394a05ee0678fde30cae *man/getIndex.Rd +d7d47f93ae8404518b2bfbb3dcf77515 *man/getSym.Rd +3fc8dce883601093bc0ce426a87d6756 *man/grapes-.-times-equals-grapes.Rd +95455778b5731bc17b7054c64ab8677e *man/grapes-equals-grapes.Rd +322e0e876c86f24a3cb3e104c072dea2 *man/grapes-plus-equals-grapes.Rd +fee0efbee9a3c11fdb9f64986700e7c6 *man/grapes-pow-equals-grapes.Rd +d3cf86bbabd598cbb0ec54103afa47fd *man/grapes-slash-equals-grapes.Rd +36d5d9e060f73bcf55753a7b01891ecb *man/grapes-times-equals-grapes.Rd +b5b0c546df75a79d4deb2f4ddd66469a *man/incr.Rd +c7b67fd092cf5f48ce9d27c1fa60cc19 *man/is.nullref.Rd +d0167c8b65d911f414afe148d31a7e78 *man/is.ref.Rd +826a2b2baa889294da84e0c15310eb6f *man/iter.ref.Rd +8a20d8a294a50130b953767f684f383b *man/match_cond.ref.Rd +2dcfb54ac532c5a10b10b88e42ebd26e *man/modify_by.Rd +9b37911eff837bf0ad6cd3c43674f995 *man/ref.Rd +141194ff07ba8469b4485a34e4ddd56d *man/ref_list.Rd +3103a2ed5c23b2d9c9077d9373e438fa *man/slice.Rd +81121d48b9370b131722a7f227f7488e *man/sref.Rd +88852f55357cbf74d0459cba886cf9fc *man/sslice.Rd +0773232d68c1b9b18459fad00c4824ae *vignettes/introRef.Rmd diff --git a/NAMESPACE b/NAMESPACE new file mode 100644 index 0000000..bc747ef --- /dev/null +++ b/NAMESPACE @@ -0,0 +1,210 @@ +# Generated by roxygen2: do not edit by hand + +S3method("!",ref) +S3method("!",rfexpr) +S3method("!",slice) +S3method("!",sref) +S3method("!",sslice) +S3method("$",ref) +S3method("$",sref) +S3method("$<-",ref) +S3method("$<-",sref) +S3method("[",ref) +S3method("[",sref) +S3method("[<-",ref) +S3method("[<-",sref) +S3method("[[",ref) +S3method("[[",sref) +S3method("[[<-",ref) +S3method("[[<-",sref) +S3method(Complex,ref) +S3method(Complex,rfexpr) +S3method(Math,ref) +S3method(Math,rfexpr) +S3method(Ops,ref) +S3method(Ops,rfexpr) +S3method(Summary,ref) +S3method(Summary,rfexpr) +S3method(aggregate,ref) +S3method(aggregate,rfexpr) +S3method(all.equal,ref) +S3method(all.equal,rfexpr) +S3method(anyDuplicated,ref) +S3method(anyDuplicated,rfexpr) +S3method(as.Date,ref) +S3method(as.Date,rfexpr) +S3method(as.POSIXct,ref) +S3method(as.POSIXct,rfexpr) +S3method(as.POSIXlt,ref) +S3method(as.POSIXlt,rfexpr) +S3method(as.character,ref) +S3method(as.character,rfexpr) +S3method(as.data.frame,ref) +S3method(as.data.frame,rfexpr) +S3method(as.double,ref) +S3method(as.double,rfexpr) +S3method(as.function,ref) +S3method(as.function,rfexpr) +S3method(as.list,ref) +S3method(as.list,rfexpr) +S3method(as.matrix,ref) +S3method(as.matrix,rfexpr) +S3method(as.single,ref) +S3method(as.single,rfexpr) +S3method(as.table,ref) +S3method(as.table,rfexpr) +S3method(c,ref) +S3method(c,rfexpr) +S3method(coef,ref) +S3method(coef,rfexpr) +S3method(confint,ref) +S3method(confint,rfexpr) +S3method(cut,ref) +S3method(cut,rfexpr) +S3method(deref,default) +S3method(deref,ref) +S3method(deref,rfexpr) +S3method(deref,slice) +S3method(deref,sref) +S3method(deref,sslice) +S3method(diff,ref) +S3method(diff,rfexpr) +S3method(dim,ref) +S3method(dim,rfexpr) +S3method(droplevels,ref) +S3method(droplevels,rfexpr) +S3method(duplicated,ref) +S3method(duplicated,rfexpr) +S3method(fitted,ref) +S3method(fitted,rfexpr) +S3method(format,ref) +S3method(format,rfexpr) +S3method(getEnv,ref) +S3method(getEnv,slice) +S3method(getEnv,sref) +S3method(getIndex,slice) +S3method(getIndex,sslice) +S3method(getSym,ref) +S3method(getSym,slice) +S3method(getSym,sref) +S3method(is.nullref,default) +S3method(is.nullref,ref) +S3method(is.nullref,sref) +S3method(isSymmetric,ref) +S3method(isSymmetric,rfexpr) +S3method(iter,ref) +S3method(iter,rfexpr) +S3method(iter,slice) +S3method(kappa,ref) +S3method(kappa,rfexpr) +S3method(labels,ref) +S3method(labels,rfexpr) +S3method(length,ref) +S3method(length,rfexpr) +S3method(levels,ref) +S3method(levels,rfexpr) +S3method(match_cond,ref) +S3method(match_cond,rfexpr) +S3method(match_cond,slice) +S3method(match_cond,sref) +S3method(mean,ref) +S3method(mean,rfexpr) +S3method(median,ref) +S3method(median,rfexpr) +S3method(merge,ref) +S3method(merge,rfexpr) +S3method(model.frame,ref) +S3method(model.frame,rfexpr) +S3method(model.matrix,ref) +S3method(model.matrix,rfexpr) +S3method(modify_by,default) +S3method(modify_by,ref) +S3method(modify_by,slice) +S3method(modify_by,sref) +S3method(na.omit,ref) +S3method(na.omit,rfexpr) +S3method(plot,ref) +S3method(plot,rfexpr) +S3method(predict,ref) +S3method(predict,rfexpr) +S3method(print,ref) +S3method(print,rfexpr) +S3method(print,slice) +S3method(qr,ref) +S3method(qr,rfexpr) +S3method(rep,ref) +S3method(rep,rfexpr) +S3method(residuals,ref) +S3method(residuals,rfexpr) +S3method(rev,ref) +S3method(rev,rfexpr) +S3method(round,ref) +S3method(round,rfexpr) +S3method(row.names,ref) +S3method(row.names,rfexpr) +S3method(setEnv,ref) +S3method(setEnv,slice) +S3method(setEnv,sref) +S3method(setIndex,slice) +S3method(setIndex,sslice) +S3method(setSym,ref) +S3method(setSym,slice) +S3method(setSym,sref) +S3method(solve,ref) +S3method(solve,rfexpr) +S3method(sort,ref) +S3method(sort,rfexpr) +S3method(summary,ref) +S3method(summary,rfexpr) +S3method(terms,ref) +S3method(terms,rfexpr) +S3method(vcov,ref) +S3method(vcov,rfexpr) +S3method(window,ref) +S3method(window,rfexpr) +export("%*=%") +export("%+=%") +export("%-=%") +export("%.*=%") +export("%/=%") +export("%^=%") +export(decr) +export(deref) +export(getEnv) +export(getIndex) +export(getSym) +export(incr) +export(is.a.ref) +export(is.nullref) +export(is.ref) +export(is.rfexpr) +export(is.slice) +export(is.sref) +export(iter.ref) +export(match_cond.ref) +export(modify_by) +export(ref) +export(ref_list) +export(setEnv) +export(setIndex) +export(setSym) +export(slice) +export(sref) +export(sslice) +importFrom(eList,iter) +importFrom(matchr,match_cond) +importFrom(stats,aggregate) +importFrom(stats,coef) +importFrom(stats,confint) +importFrom(stats,fitted) +importFrom(stats,median) +importFrom(stats,model.frame) +importFrom(stats,model.matrix) +importFrom(stats,na.omit) +importFrom(stats,predict) +importFrom(stats,residuals) +importFrom(stats,terms) +importFrom(stats,vcov) +importFrom(stats,window) +importFrom(utils,capture.output) +importFrom(utils,find) diff --git a/R/attributes.R b/R/attributes.R new file mode 100644 index 0000000..7ef1828 --- /dev/null +++ b/R/attributes.R @@ -0,0 +1,214 @@ +#' Extract or Set Reference Environment +#' +#' Functions to obtain or set the environment to which a \code{\link{ref}} or \code{\link{sref}} object points. +#' +#' @param x object of class \code{"ref"} or \code{"sref"} +#' @param e new environment to which the reference points +#' +#' @return environment for \code{getEnv} or reference object for \code{setEnv} +#' +#' @export +#' +#' @examples +#' x <- 1:10 +#' ref_to_x <- ref(x) +#' ref_env <- getEnv(ref_to_x) +#' ref_sym <- getSym(ref_to_x) +#' +#' identical(ref_env, .GlobalEnv) +#' identical(ref_sym, "x") +#' +#' e <- new.env() +#' e$x <- 100 +#' ref_to_x <- setEnv(ref_to_x, e) +#' !ref_to_x +#' +getEnv <- function(x) UseMethod("getEnv") +#' @export +#' @method getEnv ref +getEnv.ref <- function(x){ + class(x) <- "list" + x[[1]] +} +#' @export +#' @method getEnv sref +getEnv.sref <- function(x){ + class(x) <- "list" + x[[1]] +} +#' @export +#' @method getEnv slice +getEnv.slice <- function(x){ + class(x) <- "list" + x[[1]] +} + +#' @export +#' @rdname getEnv +setEnv <- function(x, e) UseMethod("setEnv") +#' @export +#' @method setEnv ref +setEnv.ref <- function(x, e) { + if (!is.environment(e)) stop("Reference must be set with an environment.") + class_holder <- class(x) + class(x) <- "list" + x[[1]] <- e + class(x) <- class_holder + x +} +#' @export +#' @method setEnv sref +setEnv.sref <- function(x, e) { + if (!is.environment(e)) stop("Reference must be set with an environment.") + class_holder <- class(x) + class(x) <- "list" + x[[1]] <- e + class(x) <- class_holder + x +} +#' @export +#' @method setEnv slice +setEnv.slice <- function(x, e) { + if (!is.environment(e)) stop("Reference must be set with an environment.") + class_holder <- class(x) + class(x) <- "list" + x[[1]] <- e + class(x) <- class_holder + x +} + + + +#' Extract or Set Reference Symbol +#' +#' Functions to obtain or set the object name to which a \code{\link{ref}} or \code{\link{sref}} object points. +#' +#' @param x object of class \code{"ref"} +#' @param sym symbol or character naming the object to which the reference points +#' +#' @return character of length 1 +#' +#' @export +#' +#' @examples +#' x <- 1:10 +#' ref_to_x <- ref(x) +#' ref_env <- getEnv(ref_to_x) +#' ref_sym <- getSym(ref_to_x) +#' +#' identical(ref_env, .GlobalEnv) +#' identical(ref_sym, "x") +#' +#' y <- 500 +#' ref_to_x <- setSym(ref_to_x, y) +#' !ref_to_x +#' +#' @export +getSym <- function(x) UseMethod("getSym") +#' @export +#' @method getSym ref +getSym.ref <- function(x){ + class(x) <- "list" + x[[2]] +} +#' @export +#' @method getSym sref +getSym.sref <- function(x){ + class(x) <- "list" + x[[2]] +} +#' @export +#' @method getSym slice +getSym.slice <- function(x){ + class(x) <- "list" + x[[2]] +} + +#' @export +#' @rdname getSym +setSym <- function(x, sym) UseMethod("setSym") +#' @export +#' @method setSym ref +setSym.ref <- function(x, sym){ + class_holder <- class(x) + class(x) <- "list" + x[[2]] <- as.character(x)[[1]] + class(x) <- class_holder + x +} +#' @export +#' @method setSym sref +setSym.sref <- function(x, sym){ + class_holder <- class(x) + class(x) <- "list" + x[[2]] <- as.character(x)[[1]] + class(x) <- class_holder + x +} +#' @export +#' @method setSym slice +setSym.slice <- function(x, sym){ + class_holder <- class(x) + class(x) <- "list" + x[[2]] <- as.character(x)[[1]] + class(x) <- class_holder + x +} + + +#' Extract or Set Slice Index +#' +#' Functions to obtain or set the index to which a \code{\link{slice}} object points. +#' +#' @param x object of class \code{"slice"} +#' @param ... objects compatible with extracting or replacing a vector +#' +#' @return object of class \code{"slice"} +#' +#' @export +#' +#' @examples +#' x <- matrix(1:9, nrow=3) +#' slice_x <- slice(x, 2:3, 1) +#' identical(getIndex(slice_x), list(2:3, 1)) # TRUE +#' +#' setIndex(slice_x, list(1, substitute())) +#' identical(!slice_x, c(1, 4, 7)) # TRUE +#' +#' @export +getIndex <- function(x) UseMethod("getIndex") +#' @export +#' @method getIndex slice +getIndex.slice <- function(x){ + class(x) <- "list" + x[[3]] +} +#' @export +#' @method getIndex sslice +getIndex.sslice <- function(x){ + class(x) <- "list" + x[[3]] +} + +#' @export +#' @rdname getIndex +setIndex <- function(x, ...) UseMethod("setIndex") +#' @export +#' @method setIndex slice +setIndex.slice <- function(x, ...){ + class_holder <- class(x) + class(x) <- "list" + x[[3]] <- list(...) + class(x) <- class_holder + x +} +#' @export +#' @method setIndex sslice +setIndex.sslice <- function(x, ...){ + class_holder <- class(x) + class(x) <- "list" + x[[3]] <- list(...) + class(x) <- class_holder + x +} + diff --git a/R/check.R b/R/check.R new file mode 100644 index 0000000..a14796d --- /dev/null +++ b/R/check.R @@ -0,0 +1,66 @@ +#' Is Object a Reference? +#' +#' Check whether an R Object inherits a reference class. +#' +#' @param x object of any class +#' +#' @return \code{TRUE} if \code{x} is a reference object, otherwise \code{FALSE} +#' +#' @export +#' +#' @examples +#' # Create a vectors of random numbers +#' x <- rnorm(10) +#' +#' # Create a reference to the random numbers +#' ref_to_x <- ref(x) +#' +#' is.ref(ref_to_x) # TRUE +#' +is.ref <- function(x) inherits(x, "ref") +#' @export +#' @describeIn is.ref check whether object is an 'sref' object +is.sref <- function(x) inherits(x, "sref") +#' @export +#' @describeIn is.ref check whether object is a reference expression +is.rfexpr <- function(x) inherits(x, "rfexpr") +#' @export +#' @describeIn is.ref check whether object references a slice of a vector +is.slice <- function(x) inherits(x, "slice") +#' @export +#' @describeIn is.ref check whether object is any type of reference class +is.a.ref <- function(x) any(c("ref", "sref", "rfexpr", "slice") %in% class(x)) + + +#' Is Reference Null? +#' +#' Check whether a \code{\link{ref}} points to a \code{NULL} object or an object +#' that no longer exists. +#' +#' @param x object of class \code{"ref"} +#' +#' @return \code{TRUE} if \code{x} is not a reference or points to an object that does not exist; otherwise \code{FALSE}. +#' +#' @export +#' +#' @examples +#' # Create a vectors of random numbers and a reference +#' x <- rnorm(10) +#' ref_to_x <- ref(x) +#' +#' # Delete 'x' and check if NULL +#' is.nullref(ref_to_x) # FALSE +#' rm(x) +#' is.nullref(ref_to_x) # TRUE +#' +is.nullref <- function(x) UseMethod("is.nullref") +#' @export +#' @method is.nullref default +is.nullref.default <- function(x) FALSE +#' @export +#' @method is.nullref ref +is.nullref.ref <- function(x) tryCatch(is.null(deref(x)), error = function(e) TRUE) +#' @export +#' @method is.nullref sref +is.nullref.sref <- function(x) tryCatch(is.null(deref(x)), error = function(e) TRUE) + diff --git a/R/deref.R b/R/deref.R new file mode 100644 index 0000000..dc3003e --- /dev/null +++ b/R/deref.R @@ -0,0 +1,121 @@ +#' Dereference Object +#' +#' Return object from a \code{\link{ref}}. \code{`!`} can also be used to dereference an object. +#' See \code{\link{ref}} for more details. +#' +#' @param x reference object +#' +#' @details +#' \code{deref} is used to obtain the object originally referenced from \code{\link{ref}}. +#' \code{NULL} is returned if the object is no longer available. \code{ref} objects are +#' automatically dereferenced when using generic functions such as arithmetic operators. +#' Dereferencing a non-ref object just returns the object. +#' +#' @return R Obj or \code{NULL} +#' +#' @export +#' @examples +#' # Create a vectors of random numbers +#' x <- rnorm(10) +#' y <- runif(10) +#' +#' # Create a reference to the random numbers +#' ref_to_x <- ref(x) +#' ref_to_y <- ref(y) +#' +#' # Place references in a list +#' list_of_refs <- list(x = ref_to_x, y = ref_to_y) +#' +#' # Check sum of refs 'x' and 'y' +#' # Note that both `+` and `sum` automatically deref +#' sum1 <- sum(list_of_refs$x + list_of_refs$y) +#' +#' # Update 'x' and calculate new sum +#' x <- rnorm(10) +#' sum2 <- sum(list_of_refs$x + list_of_refs$y) +#' +#' # check diff in sums to see if 'list_of_refs' updated +#' sum2 - sum1 +#' +#' # Obtain a reference to an expression +#' ref_to_part <- ref(x[2:5] + 3) +#' deref(ref_to_part) +#' +#' # Another expression reference +#' refs_to_list <- ref(list(x, y)) +#' deref(refs_to_list) +#' +#' x <- "hello" +#' y <- "world" +#' +#' deref(refs_to_list) +#' +#' # Alternative, `!` can be used for dereferencing +#' !refs_to_list +#' +#' identical(!refs_to_list, deref(refs_to_list)) +#' +#' # Referencing data.frame columns +#' dat <- data.frame(first = 1:4, second = 5:8) +#' ref_to_first <- ref(dat$first) +#' mean1 <- mean(!ref_to_first) +#' +#' dat$first <- dat$first * 4 +#' mean2 <- mean(!ref_to_first) +#' +#' mean2 == 4*mean1 +#' +#' # Many operations automatically dereference +#' ref_to_first * 5 +#' ref_to_x == ref_to_y +#' cos(ref_to_first) +#' max(ref_to_first) +#' +deref <- function(x) UseMethod("deref") +#' @export +#' @method deref default +deref.default <- function(x) x +#' @export +#' @method deref ref +deref.ref <- function(x) { + getEnv(x)[[getSym(x)]] +} +#' @export +#' @method deref sref +deref.sref <- function(x) { + getEnv(x)[[getSym(x)]] +} +#' @export +#' @method deref slice +deref.slice <- function(x) { + obj <- getEnv(x)[[getSym(x)]] + do.call(`[`, append(list(obj), getIndex(x))) +} +#' @export +#' @method deref sslice +deref.sslice <- function(x) { + obj <- getEnv(x)[[getSym(x)]] + do.call(`[`, append(list(obj), getIndex(x))) +} +#' @export +#' @method deref rfexpr +deref.rfexpr <- function(x) { + eval(x) +} + +#' @export +#' @rdname deref +#' @method ! ref +`!.ref` <- function(x) deref(x) +#' @export +#' @method ! sref +`!.sref` <- function(x) deref(x) +#' @export +#' @method ! slice +`!.slice` <- function(x) deref(x) +#' @export +#' @method ! sslice +`!.sslice` <- function(x) deref(x) +#' @export +#' @method ! rfexpr +`!.rfexpr` <- function(x) deref(x) diff --git a/R/getset.R b/R/getset.R new file mode 100644 index 0000000..4475328 --- /dev/null +++ b/R/getset.R @@ -0,0 +1,138 @@ +#' Extract or Replace Parts of a Referenced Object +#' +#' Operators acting on a \code{\link{ref}} object that extract part of the underlying object +#' at the supplied indices, or replaces parts. These operators modify or extract from the +#' object that is referenced, not the reference! Use \code{\link{sref}} is this behavior +#' is undesirable. +#' +#' @param x object of class \code{"ref"} +#' @param name literal character string or a name +#' @param value object, usually of a similar class as the dereferenced value of \code{x}, used for assigning in place +#' @param ... values passed to the function after dereferencing +#' +#' @return Object of class \code{"ref"} +#' +#' @name Extract +#' @rdname Extract +#' +#' @examples +#' x <- list( +#' a = 1, +#' b = "hello", +#' "world" +#' ) +#' ref_to_x <- ref(x) +#' +#' # Extract parts of 'x' from the reference +#' ref_to_x$a +#' ref_to_x[2:3] +#' ref_to_x[["b"]] +#' +#' # Replace parts of 'x' through the reference +#' ref_to_x[["a"]] <- 100 +#' x$a == 100 +#' +#' ref_to_x$b <- "bye" +#' x$b == "bye" +#' +#' ref_to_x[2:3] <- list(2, 3) +#' print(x) +#' +#' +#' +NULL + +#' @rdname Extract +#' @export +`$.ref` <- function(x, name){ + dx <- deref(x) + if (is.null(dx)){ stop("Reference is NULL.") } + eval(as.call(list(`$`, dx, name))) +} +#' @rdname Extract +#' @export +`$.sref` <- function(x, ..., value){ + stop("Values cannot be extracted from sref objects.") +} +#' @rdname Extract +#' @export +`$<-.ref` <- function(x, name, value){ + if (is.nullref(x)){ stop("Reference is NULL.") } + expr <- substitute(x$y <- value) + expr[[2]][[2]] <- as.symbol(getSym(x)) + expr[[2]][[3]] <- name + expr[[3]] <- value + eval(expr, envir=getEnv(x)) + x +} +#' @rdname Extract +#' @export +`$<-.sref` <- function(x, ..., value){ + stop("Values cannot be set inside sref objects.") +} +#' @rdname Extract +#' @export +`[.ref` <- function(x, ...){ + dx <- deref(x) + if (is.null(dx)){ stop("Reference is NULL.") } + eval(as.call(list(`[`, dx, ...))) +} +#' @rdname Extract +#' @export +`[.sref` <- function(x, ..., value){ + stop("Values cannot be extracted from sref objects.") +} +#' @rdname Extract +#' @export +`[<-.ref` <- function(x, ..., value){ + if (is.nullref(x)){ stop("Reference is NULL.") } + dots <- list(...) + ndot <- length(dots) + expr <- substitute(x[] <- value) + expr[[2]][[2]] <- as.symbol(getSym(x)) + if (ndot >= 1){ + expr[[2]][3:(3+ndot-1)] <- dots + } + expr[[3]] <- value + eval(expr, envir=getEnv(x)) + x +} +#' @rdname Extract +#' @export +`[<-.sref` <- function(x, ..., value){ + stop("Values cannot be set inside sref objects.") +} +#' @rdname Extract +#' @export +`[[.ref` <- function(x, ...) { + dx <- deref(x) + if (is.null(dx)){ stop("Reference is NULL.") } + eval(as.call(list(`[[`, dx, ...))) +} +#' @rdname Extract +#' @export +`[[.sref` <- function(x, ..., value){ + stop("Values cannot be extracted from sref objects.") +} +#' @rdname Extract +#' @export +`[[<-.ref` <- function(x, ..., value){ + if (is.nullref(x)){ stop("Reference is NULL.") } + dots <- list(...) + ndot <- length(dots) + expr <- substitute(x[[]] <- value) + expr[[2]][[2]] <- as.symbol(getSym(x)) + if (ndot >= 1){ + expr[[2]][3:(3+ndot-1)] <- dots + } + expr[[3]] <- value + eval(expr, envir=getEnv(x)) + x +} +#' @rdname Extract +#' @export +`[[<-.sref` <- function(x, ..., value){ + stop("Values cannot be set inside sref objects.") +} + + diff --git a/R/incr.R b/R/incr.R new file mode 100644 index 0000000..06111db --- /dev/null +++ b/R/incr.R @@ -0,0 +1,229 @@ +#' Increment Value In Place +#' +#' Increase the value of an object on the search path. Equivalent to \code{x++} or \code{x += by} in other languages. +#' +#' @param x object to be incremented; can be a symbol, character, or extraction language object. +#' @param by value to increase \code{x} by; defaults to \code{1}. +#' +#' @details +#' \code{incr} quotes object \code{x}, then attempts to determine the primary object to be modified. +#' For example, \code{z} will be the 'primary object' in \code{incr(z[1:4])}. \code{incr} then searches +#' for the primary object in the search path and records the environment. \code{x <- x + by} is then +#' evaluated within the recorded environment. +#' +#' The quoted object can be a symbol or character object. It can also be language object, though the primary +#' call must be either \code{`$`}, \code{`[`}, or \code{`[[`}. These can be nested. For example, \code{x[1]} +#' or \code{x[2, 1][3]} is acceptable, but \code{sqrt(x)} is not. +#' +#' See \code{\link{decr}} to decrease the value. +#' +#' @return the value of \code{x} incremented by \code{by}, invisibly +#' @export +#' +#' @examples +#' z <- 1:10 +#' +#' incr(z) +#' identical(z, as.numeric(2:11)) # TRUE +#' +#' incr(z[1:3], by=2) +#' identical(z[1:3], as.numeric(4:6)) # TRUE +#' +#' l <- list(a = 1, b = 2) +#' decr(l$a) +#' l$a == 0 # TRUE +#' +#' decr(l$b, by = 4) +#' l$b == -2 # TRUE +incr <- function(x, by = 1){ + modify_by_(x, by, substitute(x <- x + y), sys.nframe()-1) +} +#' Decrease Value In Place +#' +#' Decrease the value of an object on the search path. Equivalent to \code{x--} or +#' \code{x -= by} in other languages. See \code{\link{incr}} for details on implementation. +#' +#' @param x object to be decreased; can be a symbol, character, or extraction language object. +#' @param by value to decrease \code{x} by; defaults to \code{1}. +#' +#' @return the value of \code{x} decreased by \code{by}, invisibly +#' @export +#' +#' @examples +#' z <- 1:10 +#' +#' incr(z) +#' identical(z, 2:11) # TRUE +#' +#' incr(z[1:3], by=2) +#' identical(z[1:3], 4:6) # TRUE +#' +#' l <- list(a = 1, b = 2) +#' decr(l$a) +#' l$a == 0 # TRUE +#' +#' decr(l$b, by = 4) +#' l$b == -2 # TRUE +decr <- function(x, by = 1){ + modify_by_(x, by, substitute(x <- x - y), sys.nframe()-1) +} + + +#' Add In Place +#' +#' Increase the value of an object on the search path. Equivalent to \code{'+='} in other languages. +#' See \code{\link{incr}} for details on implementation. +#' +#' @param x object to be modified; can be a symbol, character, or extraction language object. +#' @param value value with which to change \code{x} by +#' +#' @return the new value of \code{x}, invisibly +#' @export +#' +#' @examples +#' x <- 1:10 +#' x %+=% 10 +#' identical(x, 11:20) # TRUE +`%+=%` <- function(x, value){ + modify_by_(x, value, substitute(x <- x + y), sys.nframe()-1) +} + +#' Subtract In Place +#' +#' Decrease the value of an object on the search path. Equivalent to \code{'-='} in other languages. +#' See \code{\link{incr}} for details on implementation. +#' +#' @param x object to be modified; can be a symbol, character, or extraction language object. +#' @param value value with which to change \code{x} by +#' +#' @return the new value of \code{x}, invisibly +#' @export +#' +#' @examples +#' x <- 11:20 +#' x %-=% 10 +#' identical(x, 1:10) # TRUE +`%-=%` <- function(x, value){ + modify_by_(x, value, substitute(x <- x - y), sys.nframe()-1) +} + +#' Multiply In Place +#' +#' Change the value of an object on the search path through multiplication. Equivalent to \code{'*='} in other languages. +#' See \code{\link{incr}} for details on implementation. +#' +#' @param x object to be modified; can be a symbol, character, or extraction language object. +#' @param value value with which to change \code{x} by +#' +#' @return the new value of \code{x}, invisibly +#' @export +#' +#' @examples +#' x <- 5 +#' x %*=% 2 +#' identical(x, 10) # TRUE +`%*=%` <- function(x, value){ + modify_by_(x, value, substitute(x <- x * y), sys.nframe()-1) +} + +#' Divide In Place +#' +#' Change the value of an object on the search path through division. Equivalent to \code{'/='} in other languages. +#' See \code{\link{incr}} for details on implementation. +#' +#' @param x object to be modified; can be a symbol, character, or extraction language object. +#' @param value value with which to change \code{x} by +#' +#' @return the new value of \code{x}, invisibly +#' @export +#' +#' @examples +#' x <- 10 +#' x %/=% 2 +#' identical(x, 5) # TRUE +`%/=%` <- function(x, value){ + modify_by_(x, value, substitute(x <- x / y), sys.nframe()-1) +} + +#' Power In Place +#' +#' Change the value of an object on the search path through exponentiation Equivalent to \code{'^='} in other languages. +#' See \code{\link{incr}} for details on implementation. +#' +#' @param x object to be modified; can be a symbol, character, or extraction language object. +#' @param value value with which to change \code{x} by +#' +#' @return the new value of \code{x}, invisibly +#' @export +#' +#' @examples +#' x <- 10 +#' x %^=% 2 +#' identical(x, 100) # TRUE +`%^=%` <- function(x, value){ + modify_by_(x, value, substitute(x <- x ^ y), sys.nframe()-1) +} + +#' Matrix Multiplication In Place +#' +#' Change the value of an object on the search path through matrix multiplication. Similar to \code{'*='} in +#' other languages, except with matrix multiplication. See \code{\link{incr}} for details on implementation. +#' +#' @param x object to be modified; can be a symbol, character, or extraction language object. +#' @param value value with which to change \code{x} by +#' +#' @return the new value of \code{x}, invisibly +#' @export +#' +#' @examples +#' x <- 1:5 +#' x %*=% 6:10 +#' identical(x, 130) # TRUE +`%.*=%` <- function(x, value){ + modify_by_(x, value, substitute(x <- x %*% y), sys.nframe()-1) +} + + +modify_by_ <- function(x, value, fun, n){ + fun[[3]][[3]] <- value + if (is.slice(x)){ + s <- substitute(x[]) + s[[2]] <- as.symbol(getSym(x)) + ind <- getIndex(x) + if (length(ind)>0){ + for (i in 1:length(ind)){ + s[[2+i]] <- ind[[i]] + } + } + e <- getEnv(x) + } else if (is.ref(x)){ + s <- as.symbol(getSym(x)) + e <- getEnv(x) + } else { + s <- substitute(x, sys.frame(-1)) + e <- find_obj_(s, n) + } + fun[[2]] <- s + fun[[3]][[2]] <- s + eval(fun, e) +} + +find_obj_ <- function(x, n){ + if (is.symbol(x) || is.character(x)){ + sub_x <- as.character(x)[[1]] + for (i in n:0){ + if (!is.null(get0(sub_x, envir=sys.frame(i), ifnotfound = NULL))){ + return(sys.frame(i)) + } + } + stop("Object could not be found in the search path.") + } else if (is.language(x)){ + call_fun <- x[[1]] + if ( + identical(call_fun, substitute(`$`)) || + identical(call_fun, substitute(`[`)) || + identical(call_fun, substitute(`[[`)) + ) { return(find_obj_(x[[2]], n)) } + } + stop("Object location could not be determined. Only symbols or extraction expressions may be used.") +} diff --git a/R/match.R b/R/match.R new file mode 100644 index 0000000..6e16abe --- /dev/null +++ b/R/match.R @@ -0,0 +1,138 @@ +#' Check and Evaluate Match Condition +#' +#' \code{\link{ref}} methods for use with \code{\link[matchr]{Match}} in the \code{matchr} package. +#' +#' @param cond match condition +#' @param x object being matched +#' @param do return expression associated with the condition. If \code{cond} is matched with \code{x}, then \code{do} +#' should be evaluated and returned in a list with \code{TRUE}: \code{list(TRUE, eval(do))}. +#' @param ... arguments passed to evaluation +#' +#' @details +#' See \code{\link[matchr]{Match}} for details about the implementation of \code{match_cond}. When matching, +#' \code{ref} conditions check whether \code{x} is a \code{ref} object. If so, then a match occurs if the condition +#' and \code{x} point to the same object. Otherwise, the condition is dereferenced and the resulting value +#' is checked using the appropriate match condition. Note that a \code{\link{slice}} is never matched with a +#' \code{\link{ref}} and vice versa, though \code{\link{ref}} and \code{\link{sref}} objects may match if they +#' point to the same object. +#' +#' @return \code{FALSE} if no match, or a list containing \code{TRUE} and the evaluated expression +#' @importFrom matchr match_cond +#' @name match_cond.ref +#' @rdname match_cond.ref +#' @export +#' +#' @examples +#' x <- 1:10 +#' ref_to_x <- ref(x) +#' +#' matchr::Match( +#' x, +#' is.character -> "is a character", +#' ref_to_x -> "same as reference", # <- MATCH +#' . -> "anything else" +#' ) +#' +NULL + +#' @rdname match_cond.ref +#' @method match_cond ref +#' @importFrom matchr match_cond +#' @export +match_cond.ref <- function(cond, x, do, ...){ + if (is.slice(x)) return(FALSE) + if (is.ref(x) || is.sref(x)){ + if (identical(getEnv(cond), getEnv(x)) && identical(getSym(cond), getSym(x))){ + return(eval_match(do, ...)) + } + return(FALSE) + } + cond2 <- deref(cond) + match_cond(cond2, x, do, ...) +} +#' @rdname match_cond.ref +#' @method match_cond sref +#' @importFrom matchr match_cond +#' @export +match_cond.sref <- function(cond, x, do, ...){ + if (is.slice(x)) return(FALSE) + if (is.ref(x) || is.sref(x)){ + if (identical(getEnv(cond), getEnv(x)) && identical(getSym(cond), getSym(x))){ + return(eval_match(do, ...)) + } + return(FALSE) + } + cond2 <- deref(cond) + match_cond(cond2, x, do, ...) +} +#' @rdname match_cond.ref +#' @method match_cond slice +#' @importFrom matchr match_cond +#' @export +match_cond.slice <- function(cond, x, do, ...){ + if (is.slice(x)){ + if (identical(getEnv(cond), getEnv(x)) && identical(getSym(cond), getSym(x)) && identical(getIndex(cond), getIndex(x))){ + return(eval_match(do, ...)) + } + return(FALSE) + } + cond2 <- deref(cond) + match_cond(cond2, x, do, ...) +} +#' @rdname match_cond.ref +#' @method match_cond rfexpr +#' @importFrom matchr match_cond +#' @export +match_cond.rfexpr <- function(cond, x, do, ...){ + cond2 <- deref(cond) + if (is.rfexpr(x)){ x <- deref(x) } + match_cond(cond2, x, do, ...) +} + + +eval_match <- function(do, ...) { + x <- eval(do, ...) + if ("fallthrough" %in% class(x)){ return(FALSE) } + list(TRUE, x) +} + + + + + + +#' Convert Reference to Iterable Object +#' +#' \code{\link{ref}} methods for use with \code{\link[eList]{iter}} in the \code{eList} package. +#' It allows \code{ref} objects to be used with the different vector comprehensions in the package +#' and with functions such as \code{\link[base]{lapply}} in base R. +#' +#' @param x object to be looped across +#' +#' @return a vector +#' @export +#' @importFrom eList iter +#' @rdname iter.ref +#' @name iter.ref +#' @examples +#' x <- sample(1:10, 5, replace=TRUE) +#' slice_x <- slice(x, 1:2) +#' +#' lapply(eList::iter(slice_x), print) +NULL + +#' @rdname iter.ref +#' @method iter ref +#' @importFrom eList iter +#' @export +iter.ref <- function(x) iter(deref(x)) +#' @rdname iter.ref +#' @method iter slice +#' @importFrom eList iter +#' @export +iter.slice <- function(x) iter(deref(x)) +#' @rdname iter.ref +#' @method iter rfexpr +#' @importFrom eList iter +#' @export +iter.rfexpr <- function(x) iter(deref(x)) diff --git a/R/methods.R b/R/methods.R new file mode 100644 index 0000000..04bed38 --- /dev/null +++ b/R/methods.R @@ -0,0 +1,625 @@ +#' S3 Methods for Automatic Dereferencing +#' +#' These functions automatically call \code{\link{deref}} when applied to a \code{\link{ref}} or \code{"rfexpr"} +#' object. Therefore, there is no need to explicitly call \code{deref}. \code{\link{sref}} objects will need +#' to be explicitly dereferenced before applying these functions. All functions are from \code{base} R. +#' +#' @param x,y,e1,e2,z,target,current,object,a,b,formula objects of class \code{"ref"} +#' @param incomparables,digits,tz,row.names,optional,decreasing,na.rm,parm,level function specific arguments. See the relevant +#' functions for more details +#' @param ... other objects passed to the function +#' +#' @return An R object depending on the function. +#' +#' @name Methods +#' @rdname Methods +NULL + + +#' @export +#' @method Math ref +#' @rdname Methods +Math.ref <- function(x, ...) { + z <- deref(x) + generic <- get(.Generic, mode="function") + generic(z, ...) +} +#' @export +#' @method Ops ref +#' @rdname Methods +Ops.ref <- function(e1, e2) { + if (inherits(e1, "ref")) { e1 <- deref(e1) } + if (inherits(e2, "ref")) { e2 <- deref(e2) } + generic <- get(.Generic, mode="function") + generic(e1, e2) +} +#' @export +#' @method Complex ref +#' @rdname Methods +Complex.ref <- function(z) { + x <- deref(z) + generic <- get(.Generic, mode="function") + generic(x) +} +#' @export +#' @method Summary ref +#' @rdname Methods +Summary.ref <- function(..., na.rm=FALSE) { + dots <- list(...) + ndot <- length(dots) + l <- vector("list", ndot+1) + for (i in 1:ndot) l[[i]] <- deref(dots[[i]]) + l[["na.rm"]] <- na.rm + do.call(.Generic, l) +} + +#' @export +#' @method Math rfexpr +#' @rdname Methods +Math.rfexpr <- function(x, ...) { + z <- deref(x) + generic <- get(.Generic, mode="function") + generic(z, ...) +} +#' @export +#' @method Ops rfexpr +#' @rdname Methods +Ops.rfexpr <- function(e1, e2) { + if (inherits(e1, "rfexpr")) { e1 <- deref(e1) } + if (inherits(e2, "rfexpr")) { e2 <- deref(e2) } + generic <- get(.Generic, mode="function") + generic(e1, e2) +} +#' @export +#' @method Complex rfexpr +#' @rdname Methods +Complex.rfexpr <- function(z) { + x <- deref(z) + generic <- get(.Generic, mode="function") + generic(x) +} +#' @export +#' @method Summary rfexpr +#' @rdname Methods +Summary.rfexpr <- function(..., na.rm=FALSE) { + dots <- list(...) + ndot <- length(dots) + l <- vector("list", ndot+1) + for (i in 1:ndot) l[[i]] <- deref(dots[[i]]) + l[["na.rm"]] <- na.rm + do.call(.Generic, l) +} + + + +#' @export +#' @method all.equal ref +#' @rdname Methods +all.equal.ref <- function(target, current, ...) all.equal(deref(target), deref(current), ...) + +#' @export +#' @method anyDuplicated ref +#' @rdname Methods +anyDuplicated.ref <- function(x, incomparables = FALSE, ...) anyDuplicated(deref(x), incomparables, ...) + +#' @export +#' @method as.character ref +#' @rdname Methods +as.character.ref <- function(x, ...) as.character(deref(x), ...) + +#' @export +#' @method as.data.frame ref +#' @rdname Methods +as.data.frame.ref <- function(x, row.names=NULL, optional=FALSE, ...) as.data.frame(deref(x), row.names, optional, ...) + +#' @export +#' @method as.Date ref +#' @rdname Methods +as.Date.ref <- function(x, ...) as.Date(deref(x), ...) + +#' @export +#' @method as.double ref +#' @rdname Methods +as.double.ref <- function(x, ...) as.double(deref(x), ...) + +#' @export +#' @method as.function ref +#' @rdname Methods +as.function.ref <- function(x, ...) as.function(deref(x), ...) + +#' @export +#' @method as.list ref +#' @rdname Methods +as.list.ref <- function(x, ...) as.list(deref(x), ...) + +#' @export +#' @method as.matrix ref +#' @rdname Methods +as.matrix.ref <- function(x, ...) as.matrix(deref(x), ...) + +#' @export +#' @method as.POSIXct ref +#' @rdname Methods +as.POSIXct.ref <- function(x, tz="", ...) as.POSIXct(deref(x), tz, ...) + +#' @export +#' @method as.POSIXlt ref +#' @rdname Methods +as.POSIXlt.ref <- function(x, tz="", ...) as.POSIXlt(deref(x), tz, ...) + +#' @export +#' @method as.single ref +#' @rdname Methods +as.single.ref <- function(x, ...) as.single(deref(x), ...) + +#' @export +#' @method as.table ref +#' @rdname Methods +as.table.ref <- function(x, ...) as.table(deref(x), ...) + +#' @export +#' @method c ref +#' @rdname Methods +c.ref <- function(...){ + dots <- list(...) + ndot <- length(dots) + l <- vector("list", ndot) + for (i in 1:ndot){ l[[i]] <- deref(dots[[i]]) } + names(l) <- names(dots) + do.call(c, l) +} + +#' @export +#' @method cut ref +#' @rdname Methods +cut.ref <- function(x, ...) cut(deref(x), ...) + +#' @export +#' @method diff ref +#' @rdname Methods +diff.ref <- function(x, ...) diff(deref(x), ...) + +#' @export +#' @method dim ref +#' @rdname Methods +dim.ref <- function(x) dim(deref(x)) + +#' @export +#' @method droplevels ref +#' @rdname Methods +droplevels.ref <- function(x, ...) droplevels(deref(x), ...) + +#' @export +#' @method duplicated ref +#' @rdname Methods +duplicated.ref <- function(x, incomparables = FALSE, ...) duplicated(deref(x), incomparables, ...) + +#' @export +#' @method format ref +#' @rdname Methods +format.ref <- function(x, ...) format(deref(x), ...) + +#' @export +#' @method isSymmetric ref +#' @rdname Methods +isSymmetric.ref <- function(object, ...) isSymmetric(deref(object), ...) + +#' @export +#' @method kappa ref +#' @rdname Methods +kappa.ref <- function(z, ...) kappa(deref(z), ...) + +#' @export +#' @method labels ref +#' @rdname Methods +labels.ref <- function(object, ...) labels(deref(object), ...) + +#' @export +#' @method length ref +#' @rdname Methods +length.ref <- function(x) length(deref(x)) + +#' @export +#' @method levels ref +#' @rdname Methods +levels.ref <- function(x) levels(deref(x)) + +#' @export +#' @method mean ref +#' @rdname Methods +mean.ref <- function(x, ...) mean(deref(x), ...) + +#' @export +#' @method merge ref +#' @rdname Methods +merge.ref <- function(x, y, ...) merge(deref(x), deref(y), ...) + +#' @export +#' @method qr ref +#' @rdname Methods +qr.ref <- function(x, ...) qr(deref(x), ...) + +#' @export +#' @method rep ref +#' @rdname Methods +rep.ref <- function(x, ...) rep(deref(x), ...) + +#' @export +#' @method rev ref +#' @rdname Methods +rev.ref <- function(x) rev(deref(x)) + +#' @export +#' @method round ref +#' @rdname Methods +round.ref <- function(x, digits=0) round(deref(x), digits=deref(digits)) + +#' @export +#' @method row.names ref +#' @rdname Methods +row.names.ref <- function(x) row.names(deref(x)) + +#' @export +#' @method solve ref +#' @rdname Methods +solve.ref <- function(a, b, ...) solve(deref(a), deref(b), ...) + +#' @export +#' @method sort ref +#' @rdname Methods +sort.ref <- function(x, decreasing = FALSE, ...) sort(deref(x), decreasing, ...) + +#' @export +#' @method aggregate ref +#' @importFrom stats aggregate +#' @rdname Methods +aggregate.ref <- function(x, ...) aggregate(deref(x), ...) + +#' @export +#' @method coef ref +#' @importFrom stats coef +#' @rdname Methods +coef.ref <- function(object, ...) coef(deref(object), ...) + +#' @export +#' @method confint ref +#' @importFrom stats confint +#' @rdname Methods +confint.ref <- function(object, parm, level=0.95, ...) confint(deref(object), parm, level=level, ...) + +#' @export +#' @method fitted ref +#' @importFrom stats fitted +#' @rdname Methods +fitted.ref <- function(object, ...) fitted(deref(object), ...) + +#' @export +#' @method median ref +#' @importFrom stats median +#' @rdname Methods +median.ref <- function(x, na.rm = FALSE, ...) median(deref(x), na.rm = na.rm, ...) + +#' @export +#' @method model.frame ref +#' @importFrom stats model.frame +#' @rdname Methods +model.frame.ref <- function(formula, ...) model.frame(deref(formula), ...) + +#' @export +#' @method model.matrix ref +#' @importFrom stats model.matrix +#' @rdname Methods +model.matrix.ref <- function(object, ...) model.matrix(deref(object), ...) + +#' @export +#' @method na.omit ref +#' @importFrom stats na.omit +#' @rdname Methods +na.omit.ref <- function(object, ...) na.omit(deref(object), ...) + +#' @export +#' @method plot ref +#' @rdname Methods +plot.ref <- function(x, y, ...) plot(deref(x), deref(y), ...) + +#' @export +#' @method predict ref +#' @importFrom stats predict +#' @rdname Methods +predict.ref <- function(object, ...) predict(deref(object), ...) + +#' @export +#' @method residuals ref +#' @importFrom stats residuals +#' @rdname Methods +residuals.ref <- function(object, ...) residuals(deref(object), ...) + +#' @export +#' @method summary ref +#' @rdname Methods +summary.ref <- function(object, ...) summary(deref(object), ...) + +#' @export +#' @method terms ref +#' @importFrom stats terms +#' @rdname Methods +terms.ref <- function(x, ...) terms(deref(x), ...) + +#' @export +#' @method vcov ref +#' @importFrom stats vcov +#' @rdname Methods +vcov.ref <- function(object, ...) vcov(deref(object), ...) + +#' @export +#' @method window ref +#' @importFrom stats window +#' @rdname Methods +window.ref <- function(x, ...) window(deref(x), ...) + + +#' @export +#' @method all.equal rfexpr +#' @rdname Methods +all.equal.rfexpr <- function(target, current, ...) all.equal(deref(target), deref(current), ...) + +#' @export +#' @method anyDuplicated rfexpr +#' @rdname Methods +anyDuplicated.rfexpr <- function(x, incomparables = FALSE, ...) anyDuplicated(deref(x), incomparables, ...) + +#' @export +#' @method as.character rfexpr +#' @rdname Methods +as.character.rfexpr <- function(x, ...) as.character(deref(x), ...) + +#' @export +#' @method as.data.frame rfexpr +#' @rdname Methods +as.data.frame.rfexpr <- function(x, row.names=NULL, optional=FALSE, ...) as.data.frame(deref(x), row.names, optional, ...) + +#' @export +#' @method as.Date rfexpr +#' @rdname Methods +as.Date.rfexpr <- function(x, ...) as.Date(deref(x), ...) + +#' @export +#' @method as.double rfexpr +#' @rdname Methods +as.double.rfexpr <- function(x, ...) as.double(deref(x), ...) + +#' @export +#' @method as.function rfexpr +#' @rdname Methods +as.function.rfexpr <- function(x, ...) as.function(deref(x), ...) + +#' @export +#' @method as.list rfexpr +#' @rdname Methods +as.list.rfexpr <- function(x, ...) as.list(deref(x), ...) + +#' @export +#' @method as.matrix rfexpr +#' @rdname Methods +as.matrix.rfexpr <- function(x, ...) as.matrix(deref(x), ...) + +#' @export +#' @method as.POSIXct rfexpr +#' @rdname Methods +as.POSIXct.rfexpr <- function(x, tz="", ...) as.POSIXct(deref(x), tz, ...) + +#' @export +#' @method as.POSIXlt rfexpr +#' @rdname Methods +as.POSIXlt.rfexpr <- function(x, tz="", ...) as.POSIXlt(deref(x), tz, ...) + +#' @export +#' @method as.single rfexpr +#' @rdname Methods +as.single.rfexpr <- function(x, ...) as.single(deref(x), ...) + +#' @export +#' @method as.table rfexpr +#' @rdname Methods +as.table.rfexpr <- function(x, ...) as.table(deref(x), ...) + +#' @export +#' @method c rfexpr +#' @rdname Methods +c.rfexpr <- function(...){ + dots <- list(...) + ndot <- length(dots) + l <- vector("list", ndot) + for (i in 1:ndot){ l[[i]] <- deref(dots[[i]]) } + names(l) <- names(dots) + do.call(c, l) +} + +#' @export +#' @method cut rfexpr +#' @rdname Methods +cut.rfexpr <- function(x, ...) cut(deref(x), ...) + +#' @export +#' @method diff rfexpr +#' @rdname Methods +diff.rfexpr <- function(x, ...) diff(deref(x), ...) + +#' @export +#' @method dim rfexpr +#' @rdname Methods +dim.rfexpr <- function(x) dim(deref(x)) + +#' @export +#' @method droplevels rfexpr +#' @rdname Methods +droplevels.rfexpr <- function(x, ...) droplevels(deref(x), ...) + +#' @export +#' @method duplicated rfexpr +#' @rdname Methods +duplicated.rfexpr <- function(x, incomparables = FALSE, ...) duplicated(deref(x), incomparables, ...) + +#' @export +#' @method format rfexpr +#' @rdname Methods +format.rfexpr <- function(x, ...) format(deref(x), ...) + +#' @export +#' @method isSymmetric rfexpr +#' @rdname Methods +isSymmetric.rfexpr <- function(object, ...) isSymmetric(deref(object), ...) + +#' @export +#' @method kappa rfexpr +#' @rdname Methods +kappa.rfexpr <- function(z, ...) kappa(deref(z), ...) + +#' @export +#' @method labels rfexpr +#' @rdname Methods +labels.rfexpr <- function(object, ...) labels(deref(object), ...) + +#' @export +#' @method length rfexpr +#' @rdname Methods +length.rfexpr <- function(x) length(deref(x)) + +#' @export +#' @method levels rfexpr +#' @rdname Methods +levels.rfexpr <- function(x) levels(deref(x)) + +#' @export +#' @method mean rfexpr +#' @rdname Methods +mean.rfexpr <- function(x, ...) mean(deref(x), ...) + +#' @export +#' @method merge rfexpr +#' @rdname Methods +merge.rfexpr <- function(x, y, ...) merge(deref(x), deref(y), ...) + +#' @export +#' @method qr rfexpr +#' @rdname Methods +qr.rfexpr <- function(x, ...) qr(deref(x), ...) + +#' @export +#' @method rep rfexpr +#' @rdname Methods +rep.rfexpr <- function(x, ...) rep(deref(x), ...) + +#' @export +#' @method rev rfexpr +#' @rdname Methods +rev.rfexpr <- function(x) rev(deref(x)) + +#' @export +#' @method round rfexpr +#' @rdname Methods +round.rfexpr <- function(x, digits=0) round(deref(x), digits=deref(digits)) + +#' @export +#' @method row.names rfexpr +#' @rdname Methods +row.names.rfexpr <- function(x) row.names(deref(x)) + +#' @export +#' @method solve rfexpr +#' @rdname Methods +solve.rfexpr <- function(a, b, ...) solve(deref(a), deref(b), ...) + +#' @export +#' @method sort rfexpr +#' @rdname Methods +sort.rfexpr <- function(x, decreasing = FALSE, ...) sort(deref(x), decreasing, ...) + + +#' @export +#' @method aggregate rfexpr +#' @importFrom stats aggregate +#' @rdname Methods +aggregate.rfexpr <- function(x, ...) aggregate(deref(x), ...) + +#' @export +#' @method coef rfexpr +#' @importFrom stats coef +#' @rdname Methods +coef.rfexpr <- function(object, ...) coef(deref(object), ...) + +#' @export +#' @method confint rfexpr +#' @importFrom stats confint +#' @rdname Methods +confint.rfexpr <- function(object, parm, level=0.95, ...) confint(deref(object), parm, level=level, ...) + +#' @export +#' @method fitted rfexpr +#' @importFrom stats fitted +#' @rdname Methods +fitted.rfexpr <- function(object, ...) fitted(deref(object), ...) + +#' @export +#' @method median rfexpr +#' @importFrom stats median +#' @rdname Methods +median.rfexpr <- function(x, na.rm = FALSE, ...) median(deref(x), na.rm = na.rm, ...) + +#' @export +#' @method model.frame rfexpr +#' @importFrom stats model.frame +#' @rdname Methods +model.frame.rfexpr <- function(formula, ...) model.frame(deref(formula), ...) + +#' @export +#' @method model.matrix rfexpr +#' @importFrom stats model.matrix +#' @rdname Methods +model.matrix.rfexpr <- function(object, ...) model.matrix(deref(object), ...) + +#' @export +#' @method na.omit rfexpr +#' @importFrom stats na.omit +#' @rdname Methods +na.omit.rfexpr <- function(object, ...) na.omit(deref(object), ...) + +#' @export +#' @method plot rfexpr +#' @rdname Methods +plot.rfexpr <- function(x, y, ...) plot(deref(x), deref(y), ...) + +#' @export +#' @method predict rfexpr +#' @importFrom stats predict +#' @rdname Methods +predict.rfexpr <- function(object, ...) predict(deref(object), ...) + +#' @export +#' @method residuals rfexpr +#' @importFrom stats residuals +#' @rdname Methods +residuals.rfexpr <- function(object, ...) residuals(deref(object), ...) + +#' @export +#' @method summary rfexpr +#' @rdname Methods +summary.rfexpr <- function(object, ...) summary(deref(object), ...) + +#' @export +#' @method terms rfexpr +#' @importFrom stats terms +#' @rdname Methods +terms.rfexpr <- function(x, ...) terms(deref(x), ...) + +#' @export +#' @method vcov rfexpr +#' @importFrom stats vcov +#' @rdname Methods +vcov.rfexpr <- function(object, ...) vcov(deref(object), ...) + +#' @export +#' @method window rfexpr +#' @importFrom stats window +#' @rdname Methods +window.rfexpr <- function(x, ...) window(deref(x), ...) diff --git a/R/modify.R b/R/modify.R new file mode 100644 index 0000000..824114e --- /dev/null +++ b/R/modify.R @@ -0,0 +1,72 @@ +#' Modify an Object In Place +#' +#' Update the value pointed to by a \code{\link{ref}} object. If the new value is a function, +#' the old values will be applied to the function and overwritten. +#' +#' @param x object of class \code{"ref"} +#' @param value new value or function applied to the object at the referenced location +#' @param ... additional arguments passed to the function +#' +#' @return object of class \code{"ref"} +#' +#' @export +#' +#' @examples +#' x <- 1:10 +#' ref_to_x <- ref(x) +#' +#' # Apply the square root function +#' modify_by(ref_to_x, sqrt) +#' print(x) +#' +#' # Overwrite the original values +#' modify_by(ref_to_x, "hello world!") +#' print(x) +#' +modify_by <- function(x, value, ...) UseMethod("modify_by") +#' @export +#' @method modify_by ref +modify_by.ref <- function(x, value, ...){ + expr <- substitute(x <- z) + expr[[2]] <- as.symbol(getSym(x)) + if (is.function(value)){ + dx <- deref(x) + res <- do.call(value, append(list(dx), list(...))) + expr[[3]] <- res + } else { + expr[[3]] <- value + } + eval(expr, envir=getEnv(x)) +} +#' @export +#' @method modify_by sref +modify_by.sref <- function(x, value, ...){ + stop("sref objects cannot be modified.") +} +#' @export +#' @method modify_by slice +modify_by.slice <- function(x, value, ...){ + expr <- substitute(x[y] <- z) + e <- getEnv(x) + expr[[2]][[2]] <- as.symbol(getSym(x)) + expr[[2]][[3]] <- getIndex(x) + if (is.function(value)){ + dx <- deref(x) + expr[[3]] <- do.call(value, append(list(dx), list(...))) + } else { + expr[[3]] <- value + } + eval(expr, envir=e) +} +#' @export +#' @method modify_by default +modify_by.default <- function(x, value, ...){ + sub_x <- substitute(x, sys.frame(-1)) + e <- find_obj_(sub_x, sys.nframe()-2) + expr <- substitute(x <- z) + expr[[2]] <- sub_x + if (is.function(value)){ + expr[[3]] <- as.call(append(list(value, sub_x), list(...))) + } else { expr[[3]] <- value } + eval(expr, envir=e) +} diff --git a/R/print.R b/R/print.R new file mode 100644 index 0000000..e36768a --- /dev/null +++ b/R/print.R @@ -0,0 +1,28 @@ +#' @importFrom utils capture.output +#' @method print ref +#' @export +print.ref <- function(x, ...){ + tryCatch(cat(paste0(capture.output(print(getEnv(x))), " => ", getSym(x))), error=function(e) cat("")) +} + +#' @importFrom utils capture.output +#' @method print slice +#' @export +print.slice <- function(x, ...){ + tryCatch(cat(paste0(capture.output(print(getEnv(x))), " => ", getSym(x), "[]")), error=function(e) cat("")) +} + +#' @importFrom utils capture.output +#' @method print ref +#' @export +print.sref <- function(x, ...){ + tryCatch(cat(paste0(capture.output(print(getEnv(x))), " => ", getSym(x))), error=function(e) cat("")) +} + +#' @importFrom utils capture.output +#' @method print rfexpr +#' @export +print.rfexpr <- function(x, ...){ + class(x) <- NULL + cat(paste0("<", capture.output(print(dederef_exp_(x))), ">")) +} diff --git a/R/ref.R b/R/ref.R new file mode 100644 index 0000000..cb7f29e --- /dev/null +++ b/R/ref.R @@ -0,0 +1,222 @@ +#' Create Reference to an Object +#' +#' Create a reference to an arbitrary R object. Use \code{\link{deref}} or \code{`!`} to obtain the values +#' within the referenced object. Use \code{\link{sref}} to create a safer reference that limits modification +#' in place. +#' +#' @param x object to be referenced. \code{x} can be a symbol, character, or an expression containing a symbol. +#' +#' @details +#' Since R does not have reference semantics outside of environments, \code{ref} records the environment location +#' of an object rather than its memory address.\code{ref(x)} searches for object with name \code{"x"} within the +#' search path. If found, a reference to the environment and the name \code{"x"} are recorded. Otherwise, an +#' error is returned. +#' +#' \code{ref} can also create a reference to objects within an expression. \code{ref} searches the uncalled names +#' within the expression and replaces them with a reference to the object and a call to deref. For example, +#' \code{ref(x[[y]][2])} inserts a reference to variable \code{x} and variable \code{y} from the search path into +#' the expression then wraps the expression into an object of class \code{"ref_exp"}. These objects are +#' dereferenced by evaluating the expression. An error is returned only if the corresponding variables cannot +#' be found along the search path. +#' +#' \code{\link{deref}} can be used to find the objects at the referenced location. This usually results in a +#' copy of the objects. If the object is no longer available, \code{NULL} will be returned. Generic functions on +#' a \code{ref} object, such as arithmetic or \code{`sqrt`}, will automatically dereference the object before +#' applying the generic function. See \link{Methods} and \link{Extract} for a list of available functions +#' where explicit dereferencing is not needed. If this behavior is not desired, then \code{\link{sref}} can +#' be used to force the explicit use of \code{deref}. +#' +#' See \link{Extract} and \code{\link{modify_by}} for functions that modify the underlying value in place. +#' +#' An active binding could also be used instead of creating a reference. Active bindings, though, can be more +#' difficult to pass around and may have additional overhead since they are functions. +#' +#' \code{ref} can provide unsafe or inconsistent code that is susceptible to side-effects. Apply caution and +#' restraint with its use and be sure to \code{deref} before exporting any \code{ref} objects. +#' +#' @return a list of class \code{"ref"} containing a reference to the environment of the object and the name of +#' the object to be found within the environment, or an expression of class \code{"rfexpr"} containing references +#' +#' @export +#' @importFrom utils find +#' +#' @examples +#' # Create a vectors of random numbers +#' x <- rnorm(10) +#' y <- runif(10) +#' +#' # Create a reference to the random numbers +#' ref_to_x <- ref(x) +#' ref_to_y <- ref(y) +#' +#' # Place references in a list +#' list_of_refs <- list(x = ref_to_x, y = ref_to_y) +#' +#' # Check sum of refs 'x' and 'y' +#' # Note that both `+` and `sum` automatically deref +#' sum1 <- sum(list_of_refs$x + list_of_refs$y) +#' +#' # Update 'x' and calculate new sum +#' x <- rnorm(10) +#' sum2 <- sum(list_of_refs$x + list_of_refs$y) +#' +#' # check diff in sums to see if 'list_of_refs' updated +#' sum2 - sum1 +#' +#' # Obtain a reference to an expression +#' ref_to_part <- ref(x[2:5] + 3) +#' deref(ref_to_part) +#' +#' # Another expression reference +#' refs_to_list <- ref(list(x, y)) +#' deref(refs_to_list) +#' +#' x <- "hello" +#' y <- "world" +#' +#' deref(refs_to_list) +#' +#' # Alternative, `!` can be used for dereferencing +#' !refs_to_list +#' +#' identical(!refs_to_list, deref(refs_to_list)) +#' +#' # Referencing data.frame columns +#' dat <- data.frame(first = 1:4, second = 5:8) +#' ref_to_first <- ref(dat$first) +#' mean1 <- mean(!ref_to_first) +#' +#' dat$first <- dat$first * 4 +#' mean2 <- mean(!ref_to_first) +#' +#' mean2 == 4*mean1 +#' +#' # Many operations automatically dereference +#' ref_to_first * 5 +#' ref_to_x == ref_to_y +#' cos(ref_to_first) +#' max(ref_to_first) +#' +ref <- function(x) { + sub_x <- substitute(x) + if (is.name(sub_x)){ + sub_x <- as.character(sub_x) + } else if (is.character(sub_x)) { + if (length(sub_x) != 1){ stop("Only character strings of length 1 can be used as a reference") } + } else if (is.language(sub_x)) { + n <- sys.nframe() + new_ref <- ref_sub_lang_(sub_x, n-1) + class(new_ref) <- "rfexpr" + return(new_ref) + } else { + stop("Referenced object must be a symbol or character string of length 1.") + } + .env_obj <- NULL + for (i in (sys.nframe()-1):0){ + if (!is.null(get0(sub_x, envir=sys.frame(i), ifnotfound = NULL))){ + .env_obj <- sys.frame(i) + break + } + } + if (is.null(.env_obj)){ + e <- find(sub_x, numeric = TRUE) + if (length(e) == 0){ stop(paste0("Object '", sub_x, "' could not be found in the search path.")) } + .env_obj <- pos.to.env(e) + } + structure ( + list ( + .env_obj, + sub_x + ), + class = "ref" + ) +} +ref_sub_lang_ <- function(x, n) { + if (is.name(x)){ + res <- substitute(deref(x)) + res[[2]] <- as_ref_(as.character(x), n) + return(res) + } else if (is.language(x)){ + nl <- length(x) + if (nl > 1){ + if (identical(x[[1]], substitute(`$`)) || identical(x[[1]], substitute(`@`))) { + x[[2]] <- ref_sub_lang_(x[[2]], n) + } else { + for (i in 1:nl){ + x[[i]] <- ref_sub_lang_(x[[i]], n) + } + } + return(x) + } + } + x +} +dederef_exp_ <- function(x){ + if (is.symbol(x)) return(x) + if (is.language(x)){ + if (identical(x[[1]], substitute(deref))){ + return(as.symbol(getSym(x[[2]]))) + } + for (i in 1:length(x)){ + x[[i]] <- dederef_exp_(x[[i]]) + } + } + x +} +#' @importFrom utils find +as_ref_ <- function(x, n){ + .env_obj <- NULL + for (i in n:0){ + if (!is.null(get0(x, envir=sys.frame(i), ifnotfound = NULL, inherits=FALSE))){ + .env_obj <- sys.frame(i) + break + } + } + if (is.null(.env_obj)){ + e <- find(x, numeric = TRUE) + if (length(e) == 0){ stop(paste0("Object '", x, "' could not be found in the search path.")) } + .env_obj <- pos.to.env(e) + } + structure ( + list ( + .env_obj, + x + ), + class = "ref" + ) +} + +#' Create A List of References +#' +#' Create a list of references or referenced expressions. See \code{\link{ref}} for more details. +#' +#' @param ... objects to be referenced, possibly named. +#' +#' @return a list containing object references +#' @export +#' +#' @examples +#' x <- 1 +#' y <- "hello" +#' z <- list(a = 1, b = 2, c = 3) +#' +#' new_list <- ref_list(x, second = y, z) +#' +#' !new_list[[1]] +#' (!new_list$second) == y # TRUE +#' +#' y <- 18 +#' (!new_list$second) == 18 # TRUE +#' +ref_list <- function(...) { + dots <- eval(substitute(alist(...))) + ndot <- length(dots) + if (ndot == 0){ return(list()) } + l <- vector("list", ndot) + for (i in 1:ndot){ + l[[i]] <- do.call(ref, list(dots[[i]])) + } + names(l) <- names(dots) + return(l) +} + diff --git a/R/slice.R b/R/slice.R new file mode 100644 index 0000000..92450a0 --- /dev/null +++ b/R/slice.R @@ -0,0 +1,61 @@ +#' Create a Reference Slice to a Vector +#' +#' Create a reference to a 'part' of an R object. Use \code{\link{deref}} or \code{`!`} to obtain the values +#' within the referenced object. +#' +#' @param x object to be referenced; must be a symbol or character +#' @param ... objects passed to \code{x[...]} when dereferenced +#' +#' @return object of class \code{"slice"} and \code{"ref"} +#' @export +#' +#' @details +#' \code{slice} is similar to \code{\link{ref}}; it creates a reference to another R object. There are two +#' main differences with \code{ref}. First, \code{slice} only accepts names or characters instead of +#' expressions. Second, \code{slice} records a part of the underlying object. \code{slice(x, 1:2, 3)} +#' is equivalent to the reference of \code{x[1:2, 3]}. This is similar to \code{ref(x[1:2, 3])}, though the +#' implementation is different. \code{ref} would create an expression with a reference to \code{x}, while +#' \code{slice(x, 1:2, 3)} creates a list with a reference to \code{x} and the extract inputs. \code{slice} +#' is more efficient, but is limited in its capabilities. +#' +#' @examples +#' ## Vector Slice +#' x <- 10:1 +#' +#' slice_x <- slice(x, 2:4) +#' identical(!slice_x, 9:7) # TRUE +#' +#' x <- x - 2 +#' identical(!slice_x, 7:5) # TRUE +#' +#' ## Matrix Slice +#' y <- matrix(1:9, nrow=3) +#' slice_y <- slice(y, 2, 3) +#' +#' identical(!slice_y, y[2, 3]) # TRUE +slice <- function(x, ...){ + sub_x <- substitute(x) + if (is.name(sub_x)){ sub_x <- as.character(sub_x) + } else if (is.character(sub_x)){ sub_x <- sub_x[[1]] + } else { stop("'slice' only accepts symbols or character strings.") } + .env_obj <- NULL + for (i in (sys.nframe()-1):0){ + if (!is.null(get0(sub_x, envir=sys.frame(i), ifnotfound = NULL))){ + .env_obj <- sys.frame(i) + break + } + } + if (is.null(.env_obj)){ + e <- find(sub_x, numeric = TRUE) + if (length(e) == 0){ stop(paste0("Object '", sub_x, "' could not be found in the search path.")) } + .env_obj <- pos.to.env(e) + } + structure ( + list ( + .env_obj, + sub_x, + list(...) + ), + class = c("slice", "ref") + ) +} diff --git a/R/sref.R b/R/sref.R new file mode 100644 index 0000000..8881220 --- /dev/null +++ b/R/sref.R @@ -0,0 +1,148 @@ +#' Create a Safer Reference to an Object +#' +#' Create a reference to an arbitrary R object. See \code{\link{ref}} for more details. \code{sref} behaves +#' similar to \code{ref}, but does not have support for direct operations on the referenced object. +#' +#' @param x object to be referenced. \code{x} can be a symbol, character, or an expression containing a symbol. +#' +#' @details +#' \code{sref} is similar to \code{\link{ref}}; it accepts either an R object or an expression, then records +#' its location. \code{ref} objects prioritize convenience, while \code{sref} objects prioritize clarity and +#' safety. For example, \code{`[`} and \code{`$`} can be used on a \code{ref} object to access the elements +#' of the underlying object, while \code{`[<-`} and \code{`$<-`} can be used to overwrite elements within. +#' These do not work for \code{sref} objects. Furthermore, base mathematical functions such as \code{`+`} +#' and \code{sqrt} also will not automatically dereference before applying. +#' +#' @export +#' @importFrom utils find +#' +#' @examples +#' x <- 1:10 +#' ref_x <- ref(x) +#' sref_x <- sref(x) +#' +#' ## These operations will run: +#' ref_x + 5 +#' ref_x[1:4] +#' ref_x[7] <- 5 +#' +#' ## These operations will not run: +#' # sref_x + 5 +#' # sref_x[1:4] +#' # sref_x[7] <- 5 +#' +sref <- function(x) { + sub_x <- substitute(x) + if (is.name(sub_x)){ + sub_x <- as.character(sub_x) + } else if (is.character(sub_x)) { + if (length(sub_x) != 1){ stop("Only character strings of length 1 can be used as a reference") } + } else if (is.language(sub_x)) { + n <- sys.nframe() + new_ref <- sref_sub_lang_(sub_x, n-1) + class(new_ref) <- "rfexpr" + return(new_ref) + } else { + stop("Referenced object must be a symbol or character string of length 1.") + } + .env_obj <- NULL + for (i in (sys.nframe()-1):0){ + if (!is.null(get0(sub_x, envir=sys.frame(i), ifnotfound = NULL))){ + .env_obj <- sys.frame(i) + break + } + } + if (is.null(.env_obj)){ + e <- find(sub_x, numeric = TRUE) + if (length(e) == 0){ stop(paste0("Object '", sub_x, "' could not be found in the search path.")) } + .env_obj <- pos.to.env(e) + } + structure ( + list ( + .env_obj, + sub_x + ), + class = "sref" + ) +} +sref_sub_lang_ <- function(x, n) { + if (is.name(x)){ + res <- substitute(deref(x)) + res[[2]] <- as_sref_(as.character(x), n) + return(res) + } else if (is.language(x)){ + nl <- length(x) + if (nl > 1){ + if (identical(x[[1]], substitute(`$`)) || identical(x[[1]], substitute(`@`))) { + x[[2]] <- sref_sub_lang_(x[[2]], n) + } else { + for (i in 1:nl){ + x[[i]] <- sref_sub_lang_(x[[i]], n) + } + } + return(x) + } + } + x +} +#' @importFrom utils find +as_sref_ <- function(x, n){ + .env_obj <- NULL + for (i in n:0){ + if (!is.null(get0(x, envir=sys.frame(i), ifnotfound = NULL, inherits=FALSE))){ + .env_obj <- sys.frame(i) + break + } + } + if (is.null(.env_obj)){ + e <- find(x, numeric = TRUE) + if (length(e) == 0){ stop(paste0("Object '", x, "' could not be found in the search path.")) } + .env_obj <- pos.to.env(e) + } + structure ( + list ( + .env_obj, + x + ), + class = "sref" + ) +} + + +#' Create a Safer Reference Slice to a Vector +#' +#' Create a reference to a 'part' of an R object. \code{sslice} behaves similar to \code{\link{slice}}, but does not +#' have support for direct operations on the referenced object. See \code{\link{sref}} for details about the behavior. +#' +#' @param x object to be referenced; must be a symbol or character +#' @param ... objects passed to \code{x[...]} when dereferenced +#' +#' @return object of class \code{"sslice"} and \code{"sref"} +#' @export +#' +sslice <- function(x, ...){ + sub_x <- substitute(x) + if (is.name(sub_x)){ sub_x <- as.character(sub_x) + } else if (is.character(sub_x)){ sub_x <- sub_x[[1]] + } else { stop("'slice' only accepts symbols or character strings.") } + .env_obj <- NULL + for (i in (sys.nframe()-1):0){ + if (!is.null(get0(sub_x, envir=sys.frame(i), ifnotfound = NULL))){ + .env_obj <- sys.frame(i) + break + } + } + if (is.null(.env_obj)){ + e <- find(sub_x, numeric = TRUE) + if (length(e) == 0){ stop(paste0("Object '", sub_x, "' could not be found in the search path.")) } + .env_obj <- pos.to.env(e) + } + structure ( + list ( + .env_obj, + sub_x, + list(...) + ), + class = c("sslice", "sref") + ) +} diff --git a/build/vignette.rds b/build/vignette.rds new file mode 100644 index 0000000..95d429b Binary files /dev/null and b/build/vignette.rds differ diff --git a/inst/WORDLIST b/inst/WORDLIST new file mode 100644 index 0000000..0a29054 --- /dev/null +++ b/inst/WORDLIST @@ -0,0 +1 @@ +de diff --git a/inst/doc/introRef.R b/inst/doc/introRef.R new file mode 100644 index 0000000..3b7c9cc --- /dev/null +++ b/inst/doc/introRef.R @@ -0,0 +1,89 @@ +## ----setup, include = FALSE--------------------------------------------------- +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) + +## ----------------------------------------------------------------------------- +library(refer) + +## ----------------------------------------------------------------------------- +map <- matrix(' ', nrow=10, ncol=10) +map + +## ----------------------------------------------------------------------------- +person <- list( + map = ref(map), + row = 1, + col = 1 +) +map[1,1] <- 'X' + +## ----------------------------------------------------------------------------- +person$map + +## ----------------------------------------------------------------------------- +!person$map + +## ----------------------------------------------------------------------------- +map[1,5] <- "O" +!person$map + +## ----------------------------------------------------------------------------- +location <- ref(c(person$row, person$col)) +location + +## ----------------------------------------------------------------------------- +!location + +## ----------------------------------------------------------------------------- +person$row <- person$row + 1 +!location + +## ----------------------------------------------------------------------------- +location + 1 +!location + +## ----------------------------------------------------------------------------- +row1 <- slice(map, 1, 1:5) +!row1 + +## ----------------------------------------------------------------------------- +map[1, 3] <- "%" +!row1 + +## ----------------------------------------------------------------------------- +loc_row <- slice(location, 1) +!loc_row + +## ----------------------------------------------------------------------------- +person$col %+=% 3 +person$col + +## ----------------------------------------------------------------------------- +person$col %-=% 3 +person$col + +## ----------------------------------------------------------------------------- +x <- 1:nrow(map) +slice_x <- slice(x, 3:6) +slice_x %+=% 10 +x + +## ----------------------------------------------------------------------------- +modify_by(x, sqrt) +x + +## ----------------------------------------------------------------------------- +modify_by(x, 5) +x + +## ----------------------------------------------------------------------------- +p <- sref(person) +!p + +## ----eval=FALSE--------------------------------------------------------------- +# ## These will spawn an error. Don't run! +# p$row +# modify_by(p, function(x){ x$row <- x$row + 1; x }) + diff --git a/inst/doc/introRef.Rmd b/inst/doc/introRef.Rmd new file mode 100644 index 0000000..c33dd8d --- /dev/null +++ b/inst/doc/introRef.Rmd @@ -0,0 +1,164 @@ +--- +title: "An Introduction to 'refer' References" +author: "Christopher Mann" +date: "`r Sys.Date()`" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{An Introduction to 'refer' References} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +The `refer` package allows users to keep references to objects and modify objects in place with relying on reference classes. This article describes how to use `ref` objects by moving objects around a map. Please note that many of the operations in the `refer` package go against the philosophy of R and may lead to inconsistent and unclear code; use sparingly and with caution. + +First, we need to load the `refer` package. + +```{r} +library(refer) +``` + +## Creating References, Reference Expressions, and Slices + +Our goal with this project is to population a map. We will use a character matrix and keep it small at 10x10. + +```{r} +map <- matrix(' ', nrow=10, ncol=10) +map +``` + +Next, let us create a person to place on the map. The person will keep track of its location and a reference to the map object. We will place a representative of the person on the map. + +```{r} +person <- list( + map = ref(map), + row = 1, + col = 1 +) +map[1,1] <- 'X' +``` + +Since a reference of the map is placed inside `'person'`, we can always use it to indirectly access the map. Just calling `person$map`, though, only returns the reference not the actual item. + +```{r} +person$map +``` + +To return the underlying object, we must 'dereference' the item using either the `deref()` function or the `!` operator. + +```{r} +!person$map +``` + +If we add a new object to the original map, then the change is reflected when it is dereferenced from `person`. + +```{r} +map[1,5] <- "O" +!person$map +``` + +`ref` can also be used to build expressions that contain references. For example, `location` below contains a reference to the `row` and `col` of `person`.Dereferencing `location` evaluates the expression, taking note of where person is located when originally created. The effect is similar to creating an active binding. However, active bindings are heavier and much more difficult to pass around, inspect, and so forth. + +```{r} +location <- ref(c(person$row, person$col)) +location +``` + +```{r} +!location +``` + +Since `location` is a reference, updating either `row` or `col` will change the dereferenced value of location. + +```{r} +person$row <- person$row + 1 +!location +``` + +Note that `ref` objects automatically dereference when applied to many base functions such arithmetic operators. This includes the standard extraction operators: `$`, `[`, and `[[`. However, these do not overwrite the underlying data. + +```{r} +location + 1 +!location +``` + +A `slice` is a special type of reference that refers to part of an object. For example, we could create a slice that points to the second row and last 5 columns of the map. If these values change, the slice reflects these changes. + +```{r} +row1 <- slice(map, 1, 1:5) +!row1 +``` + +```{r} +map[1, 3] <- "%" +!row1 +``` + +When dereferenced, the above `slice` calls `map[2, 6:10]` within the environment that map is located. Since `ref` objects automatically dereference when extraction calls are made, `slice` could even be used on another reference. + +```{r} +loc_row <- slice(location, 1) +!loc_row +``` + + +## Modifying Variables In Place + +The `ref` package contains another of functions to modify objects in place. For example, it includes variations on the standard `+=` and `-=` operators found in many languages such as Python. + +```{r} +person$col %+=% 3 +person$col +``` + +```{r} +person$col %-=% 3 +person$col +``` + +These functions can also accept other reference objects. When a reference object is used, the underlying object is modified. This can be dangerous, so use sparingly! + +```{r} +x <- 1:nrow(map) +slice_x <- slice(x, 3:6) +slice_x %+=% 10 +x +``` + + +Objects can also be modified in place with custom functions using `modify_by`. + +```{r} +modify_by(x, sqrt) +x +``` + +`modify_by` can also be used to completely overwrite the value of an object further up the search path by passing a value rather than a function. + +```{r} +modify_by(x, 5) +x +``` + +## Safer References + +The general `ref` function automatically dereferences when passed to a wide variety of functions and can modify the underlying objects in place. `sref` is an alternative version of `ref` that does away with this behavior. `sref` objects can still be dereferenced as normal, but attempts to modify or apply functions to the reference will throw an error. Use `sslice` to create `sref` versions of slices. + +```{r} +p <- sref(person) +!p +``` + +```{r eval=FALSE} +## These will spawn an error. Don't run! +p$row +modify_by(p, function(x){ x$row <- x$row + 1; x }) +``` + + diff --git a/inst/doc/introRef.html b/inst/doc/introRef.html new file mode 100644 index 0000000..9a6b672 --- /dev/null +++ b/inst/doc/introRef.html @@ -0,0 +1,288 @@ + + + + + + + + + + + + + + + + +An Introduction to ‘refer’ References + + + + + + + + + + + + + + + + + + + + + + + + + +

An Introduction to ‘refer’ References

+

Christopher Mann

+

2021-11-06

+ + + +

The refer package allows users to keep references to objects and modify objects in place with relying on reference classes. This article describes how to use ref objects by moving objects around a map. Please note that many of the operations in the refer package go against the philosophy of R and may lead to inconsistent and unclear code; use sparingly and with caution.

+

First, we need to load the refer package.

+
library(refer)
+
+

Creating References, Reference Expressions, and Slices

+

Our goal with this project is to population a map. We will use a character matrix and keep it small at 10x10.

+
map   <- matrix(' ', nrow=10, ncol=10)
+map
+#>       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
+#>  [1,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [2,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [3,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [4,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [5,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [6,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [7,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [8,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [9,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#> [10,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "
+

Next, let us create a person to place on the map. The person will keep track of its location and a reference to the map object. We will place a representative of the person on the map.

+
person <- list(
+  map     = ref(map), 
+  row     = 1,
+  col     = 1
+)
+map[1,1] <- 'X'
+

Since a reference of the map is placed inside 'person', we can always use it to indirectly access the map. Just calling person$map, though, only returns the reference not the actual item.

+
person$map
+#> <environment: R_GlobalEnv> => map
+

To return the underlying object, we must ‘dereference’ the item using either the deref() function or the ! operator.

+
!person$map
+#>       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
+#>  [1,] "X"  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [2,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [3,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [4,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [5,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [6,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [7,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [8,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [9,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#> [10,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "
+

If we add a new object to the original map, then the change is reflected when it is dereferenced from person.

+
map[1,5] <- "O"
+!person$map
+#>       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
+#>  [1,] "X"  " "  " "  " "  "O"  " "  " "  " "  " "  " "  
+#>  [2,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [3,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [4,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [5,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [6,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [7,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [8,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#>  [9,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "  
+#> [10,] " "  " "  " "  " "  " "  " "  " "  " "  " "  " "
+

ref can also be used to build expressions that contain references. For example, location below contains a reference to the row and col of person.Dereferencing location evaluates the expression, taking note of where person is located when originally created. The effect is similar to creating an active binding. However, active bindings are heavier and much more difficult to pass around, inspect, and so forth.

+
location <- ref(c(person$row, person$col))
+location
+#> <c(person$row, person$col)>
+
!location
+#> [1] 1 1
+

Since location is a reference, updating either row or col will change the dereferenced value of location.

+
person$row <- person$row + 1
+!location
+#> [1] 2 1
+

Note that ref objects automatically dereference when applied to many base functions such arithmetic operators. This includes the standard extraction operators: $, [, and [[. However, these do not overwrite the underlying data.

+
location + 1
+#> [1] 3 2
+!location
+#> [1] 2 1
+

A slice is a special type of reference that refers to part of an object. For example, we could create a slice that points to the second row and last 5 columns of the map. If these values change, the slice reflects these changes.

+
row1 <- slice(map, 1, 1:5)
+!row1
+#> [1] "X" " " " " " " "O"
+
map[1, 3] <- "%"
+!row1
+#> [1] "X" " " "%" " " "O"
+

When dereferenced, the above slice calls map[2, 6:10] within the environment that map is located. Since ref objects automatically dereference when extraction calls are made, slice could even be used on another reference.

+
loc_row <- slice(location, 1)
+!loc_row
+#> [1] 2
+
+
+

Modifying Variables In Place

+

The ref package contains another of functions to modify objects in place. For example, it includes variations on the standard += and -= operators found in many languages such as Python.

+
person$col %+=% 3
+person$col
+#> [1] 4
+
person$col %-=% 3
+person$col
+#> [1] 1
+

These functions can also accept other reference objects. When a reference object is used, the underlying object is modified. This can be dangerous, so use sparingly!

+
x <- 1:nrow(map)
+slice_x <- slice(x, 3:6)
+slice_x %+=% 10
+x
+#>  [1]  1  2 13 14 15 16  7  8  9 10
+

Objects can also be modified in place with custom functions using modify_by.

+
modify_by(x, sqrt)
+x
+#>  [1] 1.000000 1.414214 3.605551 3.741657 3.872983 4.000000 2.645751 2.828427
+#>  [9] 3.000000 3.162278
+

modify_by can also be used to completely overwrite the value of an object further up the search path by passing a value rather than a function.

+
modify_by(x, 5)
+x
+#> [1] 5
+
+
+

Safer References

+

The general ref function automatically dereferences when passed to a wide variety of functions and can modify the underlying objects in place. sref is an alternative version of ref that does away with this behavior. sref objects can still be dereferenced as normal, but attempts to modify or apply functions to the reference will throw an error. Use sslice to create sref versions of slices.

+
p <- sref(person)
+!p
+#> $map
+#> <environment: R_GlobalEnv> => map
+#> $row
+#> [1] 2
+#> 
+#> $col
+#> [1] 1
+
## These will spawn an error. Don't run!
+p$row
+modify_by(p, function(x){ x$row <- x$row + 1; x })
+
+ + + + + + + + + + + diff --git a/man/Extract.Rd b/man/Extract.Rd new file mode 100644 index 0000000..2dedfbf --- /dev/null +++ b/man/Extract.Rd @@ -0,0 +1,86 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/getset.R +\name{Extract} +\alias{Extract} +\alias{$.ref} +\alias{$.sref} +\alias{$<-.ref} +\alias{$<-.sref} +\alias{[.ref} +\alias{[.sref} +\alias{[<-.ref} +\alias{[<-.sref} +\alias{[[.ref} +\alias{[[.sref} +\alias{[[<-.ref} +\alias{[[<-.sref} +\title{Extract or Replace Parts of a Referenced Object} +\usage{ +\method{$}{ref}(x, name) + +\method{$}{sref}(x, ..., value) + +\method{$}{ref}(x, name) <- value + +\method{$}{sref}(x, ...) <- value + +\method{[}{ref}(x, ...) + +\method{[}{sref}(x, ..., value) + +\method{[}{ref}(x, ...) <- value + +\method{[}{sref}(x, ...) <- value + +\method{[[}{ref}(x, ...) + +\method{[[}{sref}(x, ..., value) + +\method{[[}{ref}(x, ...) <- value + +\method{[[}{sref}(x, ...) <- value +} +\arguments{ +\item{x}{object of class \code{"ref"}} + +\item{name}{literal character string or a name} + +\item{...}{values passed to the function after dereferencing} + +\item{value}{object, usually of a similar class as the dereferenced value of \code{x}, used for assigning in place} +} +\value{ +Object of class \code{"ref"} +} +\description{ +Operators acting on a \code{\link{ref}} object that extract part of the underlying object +at the supplied indices, or replaces parts. These operators modify or extract from the +object that is referenced, not the reference! Use \code{\link{sref}} is this behavior +is undesirable. +} +\examples{ +x <- list( + a = 1, + b = "hello", + "world" +) +ref_to_x <- ref(x) + +# Extract parts of 'x' from the reference +ref_to_x$a +ref_to_x[2:3] +ref_to_x[["b"]] + +# Replace parts of 'x' through the reference +ref_to_x[["a"]] <- 100 +x$a == 100 + +ref_to_x$b <- "bye" +x$b == "bye" + +ref_to_x[2:3] <- list(2, 3) +print(x) + + + +} diff --git a/man/Methods.Rd b/man/Methods.Rd new file mode 100644 index 0000000..8d205b8 --- /dev/null +++ b/man/Methods.Rd @@ -0,0 +1,340 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/methods.R +\name{Methods} +\alias{Methods} +\alias{Math.ref} +\alias{Ops.ref} +\alias{Complex.ref} +\alias{Summary.ref} +\alias{Math.rfexpr} +\alias{Ops.rfexpr} +\alias{Complex.rfexpr} +\alias{Summary.rfexpr} +\alias{all.equal.ref} +\alias{anyDuplicated.ref} +\alias{as.character.ref} +\alias{as.data.frame.ref} +\alias{as.Date.ref} +\alias{as.double.ref} +\alias{as.function.ref} +\alias{as.list.ref} +\alias{as.matrix.ref} +\alias{as.POSIXct.ref} +\alias{as.POSIXlt.ref} +\alias{as.single.ref} +\alias{as.table.ref} +\alias{c.ref} +\alias{cut.ref} +\alias{diff.ref} +\alias{dim.ref} +\alias{droplevels.ref} +\alias{duplicated.ref} +\alias{format.ref} +\alias{isSymmetric.ref} +\alias{kappa.ref} +\alias{labels.ref} +\alias{length.ref} +\alias{levels.ref} +\alias{mean.ref} +\alias{merge.ref} +\alias{qr.ref} +\alias{rep.ref} +\alias{rev.ref} +\alias{round.ref} +\alias{row.names.ref} +\alias{solve.ref} +\alias{sort.ref} +\alias{aggregate.ref} +\alias{coef.ref} +\alias{confint.ref} +\alias{fitted.ref} +\alias{median.ref} +\alias{model.frame.ref} +\alias{model.matrix.ref} +\alias{na.omit.ref} +\alias{plot.ref} +\alias{predict.ref} +\alias{residuals.ref} +\alias{summary.ref} +\alias{terms.ref} +\alias{vcov.ref} +\alias{window.ref} +\alias{all.equal.rfexpr} +\alias{anyDuplicated.rfexpr} +\alias{as.character.rfexpr} +\alias{as.data.frame.rfexpr} +\alias{as.Date.rfexpr} +\alias{as.double.rfexpr} +\alias{as.function.rfexpr} +\alias{as.list.rfexpr} +\alias{as.matrix.rfexpr} +\alias{as.POSIXct.rfexpr} +\alias{as.POSIXlt.rfexpr} +\alias{as.single.rfexpr} +\alias{as.table.rfexpr} +\alias{c.rfexpr} +\alias{cut.rfexpr} +\alias{diff.rfexpr} +\alias{dim.rfexpr} +\alias{droplevels.rfexpr} +\alias{duplicated.rfexpr} +\alias{format.rfexpr} +\alias{isSymmetric.rfexpr} +\alias{kappa.rfexpr} +\alias{labels.rfexpr} +\alias{length.rfexpr} +\alias{levels.rfexpr} +\alias{mean.rfexpr} +\alias{merge.rfexpr} +\alias{qr.rfexpr} +\alias{rep.rfexpr} +\alias{rev.rfexpr} +\alias{round.rfexpr} +\alias{row.names.rfexpr} +\alias{solve.rfexpr} +\alias{sort.rfexpr} +\alias{aggregate.rfexpr} +\alias{coef.rfexpr} +\alias{confint.rfexpr} +\alias{fitted.rfexpr} +\alias{median.rfexpr} +\alias{model.frame.rfexpr} +\alias{model.matrix.rfexpr} +\alias{na.omit.rfexpr} +\alias{plot.rfexpr} +\alias{predict.rfexpr} +\alias{residuals.rfexpr} +\alias{summary.rfexpr} +\alias{terms.rfexpr} +\alias{vcov.rfexpr} +\alias{window.rfexpr} +\title{S3 Methods for Automatic Dereferencing} +\usage{ +\method{Math}{ref}(x, ...) + +\method{Ops}{ref}(e1, e2) + +\method{Complex}{ref}(z) + +\method{Summary}{ref}(..., na.rm = FALSE) + +\method{Math}{rfexpr}(x, ...) + +\method{Ops}{rfexpr}(e1, e2) + +\method{Complex}{rfexpr}(z) + +\method{Summary}{rfexpr}(..., na.rm = FALSE) + +\method{all.equal}{ref}(target, current, ...) + +\method{anyDuplicated}{ref}(x, incomparables = FALSE, ...) + +\method{as.character}{ref}(x, ...) + +\method{as.data.frame}{ref}(x, row.names = NULL, optional = FALSE, ...) + +\method{as.Date}{ref}(x, ...) + +\method{as.double}{ref}(x, ...) + +\method{as.function}{ref}(x, ...) + +\method{as.list}{ref}(x, ...) + +\method{as.matrix}{ref}(x, ...) + +\method{as.POSIXct}{ref}(x, tz = "", ...) + +\method{as.POSIXlt}{ref}(x, tz = "", ...) + +\method{as.single}{ref}(x, ...) + +\method{as.table}{ref}(x, ...) + +\method{c}{ref}(...) + +\method{cut}{ref}(x, ...) + +\method{diff}{ref}(x, ...) + +\method{dim}{ref}(x) + +\method{droplevels}{ref}(x, ...) + +\method{duplicated}{ref}(x, incomparables = FALSE, ...) + +\method{format}{ref}(x, ...) + +\method{isSymmetric}{ref}(object, ...) + +\method{kappa}{ref}(z, ...) + +\method{labels}{ref}(object, ...) + +\method{length}{ref}(x) + +\method{levels}{ref}(x) + +\method{mean}{ref}(x, ...) + +\method{merge}{ref}(x, y, ...) + +\method{qr}{ref}(x, ...) + +\method{rep}{ref}(x, ...) + +\method{rev}{ref}(x) + +\method{round}{ref}(x, digits = 0) + +\method{row.names}{ref}(x) + +\method{solve}{ref}(a, b, ...) + +\method{sort}{ref}(x, decreasing = FALSE, ...) + +\method{aggregate}{ref}(x, ...) + +\method{coef}{ref}(object, ...) + +\method{confint}{ref}(object, parm, level = 0.95, ...) + +\method{fitted}{ref}(object, ...) + +\method{median}{ref}(x, na.rm = FALSE, ...) + +\method{model.frame}{ref}(formula, ...) + +\method{model.matrix}{ref}(object, ...) + +\method{na.omit}{ref}(object, ...) + +\method{plot}{ref}(x, y, ...) + +\method{predict}{ref}(object, ...) + +\method{residuals}{ref}(object, ...) + +\method{summary}{ref}(object, ...) + +\method{terms}{ref}(x, ...) + +\method{vcov}{ref}(object, ...) + +\method{window}{ref}(x, ...) + +\method{all.equal}{rfexpr}(target, current, ...) + +\method{anyDuplicated}{rfexpr}(x, incomparables = FALSE, ...) + +\method{as.character}{rfexpr}(x, ...) + +\method{as.data.frame}{rfexpr}(x, row.names = NULL, optional = FALSE, ...) + +\method{as.Date}{rfexpr}(x, ...) + +\method{as.double}{rfexpr}(x, ...) + +\method{as.function}{rfexpr}(x, ...) + +\method{as.list}{rfexpr}(x, ...) + +\method{as.matrix}{rfexpr}(x, ...) + +\method{as.POSIXct}{rfexpr}(x, tz = "", ...) + +\method{as.POSIXlt}{rfexpr}(x, tz = "", ...) + +\method{as.single}{rfexpr}(x, ...) + +\method{as.table}{rfexpr}(x, ...) + +\method{c}{rfexpr}(...) + +\method{cut}{rfexpr}(x, ...) + +\method{diff}{rfexpr}(x, ...) + +\method{dim}{rfexpr}(x) + +\method{droplevels}{rfexpr}(x, ...) + +\method{duplicated}{rfexpr}(x, incomparables = FALSE, ...) + +\method{format}{rfexpr}(x, ...) + +\method{isSymmetric}{rfexpr}(object, ...) + +\method{kappa}{rfexpr}(z, ...) + +\method{labels}{rfexpr}(object, ...) + +\method{length}{rfexpr}(x) + +\method{levels}{rfexpr}(x) + +\method{mean}{rfexpr}(x, ...) + +\method{merge}{rfexpr}(x, y, ...) + +\method{qr}{rfexpr}(x, ...) + +\method{rep}{rfexpr}(x, ...) + +\method{rev}{rfexpr}(x) + +\method{round}{rfexpr}(x, digits = 0) + +\method{row.names}{rfexpr}(x) + +\method{solve}{rfexpr}(a, b, ...) + +\method{sort}{rfexpr}(x, decreasing = FALSE, ...) + +\method{aggregate}{rfexpr}(x, ...) + +\method{coef}{rfexpr}(object, ...) + +\method{confint}{rfexpr}(object, parm, level = 0.95, ...) + +\method{fitted}{rfexpr}(object, ...) + +\method{median}{rfexpr}(x, na.rm = FALSE, ...) + +\method{model.frame}{rfexpr}(formula, ...) + +\method{model.matrix}{rfexpr}(object, ...) + +\method{na.omit}{rfexpr}(object, ...) + +\method{plot}{rfexpr}(x, y, ...) + +\method{predict}{rfexpr}(object, ...) + +\method{residuals}{rfexpr}(object, ...) + +\method{summary}{rfexpr}(object, ...) + +\method{terms}{rfexpr}(x, ...) + +\method{vcov}{rfexpr}(object, ...) + +\method{window}{rfexpr}(x, ...) +} +\arguments{ +\item{x, y, e1, e2, z, target, current, object, a, b, formula}{objects of class \code{"ref"}} + +\item{...}{other objects passed to the function} + +\item{incomparables, digits, tz, row.names, optional, decreasing, na.rm, parm, level}{function specific arguments. See the relevant +functions for more details} +} +\value{ +An R object depending on the function. +} +\description{ +These functions automatically call \code{\link{deref}} when applied to a \code{\link{ref}} or \code{"rfexpr"} +object. Therefore, there is no need to explicitly call \code{deref}. \code{\link{sref}} objects will need +to be explicitly dereferenced before applying these functions. All functions are from \code{base} R. +} diff --git a/man/decr.Rd b/man/decr.Rd new file mode 100644 index 0000000..989adb0 --- /dev/null +++ b/man/decr.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/incr.R +\name{decr} +\alias{decr} +\title{Decrease Value In Place} +\usage{ +decr(x, by = 1) +} +\arguments{ +\item{x}{object to be decreased; can be a symbol, character, or extraction language object.} + +\item{by}{value to decrease \code{x} by; defaults to \code{1}.} +} +\value{ +the value of \code{x} decreased by \code{by}, invisibly +} +\description{ +Decrease the value of an object on the search path. Equivalent to \code{x--} or +\code{x -= by} in other languages. See \code{\link{incr}} for details on implementation. +} +\examples{ +z <- 1:10 + +incr(z) +identical(z, 2:11) # TRUE + +incr(z[1:3], by=2) +identical(z[1:3], 4:6) # TRUE + +l <- list(a = 1, b = 2) +decr(l$a) +l$a == 0 # TRUE + +decr(l$b, by = 4) +l$b == -2 # TRUE +} diff --git a/man/deref.Rd b/man/deref.Rd new file mode 100644 index 0000000..72ec1f6 --- /dev/null +++ b/man/deref.Rd @@ -0,0 +1,85 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/deref.R +\name{deref} +\alias{deref} +\alias{!.ref} +\title{Dereference Object} +\usage{ +deref(x) + +\method{!}{ref}(x) +} +\arguments{ +\item{x}{reference object} +} +\value{ +R Obj or \code{NULL} +} +\description{ +Return object from a \code{\link{ref}}. \code{`!`} can also be used to dereference an object. +See \code{\link{ref}} for more details. +} +\details{ +\code{deref} is used to obtain the object originally referenced from \code{\link{ref}}. +\code{NULL} is returned if the object is no longer available. \code{ref} objects are +automatically dereferenced when using generic functions such as arithmetic operators. +Dereferencing a non-ref object just returns the object. +} +\examples{ +# Create a vectors of random numbers +x <- rnorm(10) +y <- runif(10) + +# Create a reference to the random numbers +ref_to_x <- ref(x) +ref_to_y <- ref(y) + +# Place references in a list +list_of_refs <- list(x = ref_to_x, y = ref_to_y) + +# Check sum of refs 'x' and 'y' +# Note that both `+` and `sum` automatically deref +sum1 <- sum(list_of_refs$x + list_of_refs$y) + +# Update 'x' and calculate new sum +x <- rnorm(10) +sum2 <- sum(list_of_refs$x + list_of_refs$y) + +# check diff in sums to see if 'list_of_refs' updated +sum2 - sum1 + +# Obtain a reference to an expression +ref_to_part <- ref(x[2:5] + 3) +deref(ref_to_part) + +# Another expression reference +refs_to_list <- ref(list(x, y)) +deref(refs_to_list) + +x <- "hello" +y <- "world" + +deref(refs_to_list) + +# Alternative, `!` can be used for dereferencing +!refs_to_list + +identical(!refs_to_list, deref(refs_to_list)) + +# Referencing data.frame columns +dat <- data.frame(first = 1:4, second = 5:8) +ref_to_first <- ref(dat$first) +mean1 <- mean(!ref_to_first) + +dat$first <- dat$first * 4 +mean2 <- mean(!ref_to_first) + +mean2 == 4*mean1 + +# Many operations automatically dereference +ref_to_first * 5 +ref_to_x == ref_to_y +cos(ref_to_first) +max(ref_to_first) + +} diff --git a/man/getEnv.Rd b/man/getEnv.Rd new file mode 100644 index 0000000..353387d --- /dev/null +++ b/man/getEnv.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/attributes.R +\name{getEnv} +\alias{getEnv} +\alias{setEnv} +\title{Extract or Set Reference Environment} +\usage{ +getEnv(x) + +setEnv(x, e) +} +\arguments{ +\item{x}{object of class \code{"ref"} or \code{"sref"}} + +\item{e}{new environment to which the reference points} +} +\value{ +environment for \code{getEnv} or reference object for \code{setEnv} +} +\description{ +Functions to obtain or set the environment to which a \code{\link{ref}} or \code{\link{sref}} object points. +} +\examples{ +x <- 1:10 +ref_to_x <- ref(x) +ref_env <- getEnv(ref_to_x) +ref_sym <- getSym(ref_to_x) + +identical(ref_env, .GlobalEnv) +identical(ref_sym, "x") + +e <- new.env() +e$x <- 100 +ref_to_x <- setEnv(ref_to_x, e) +!ref_to_x + +} diff --git a/man/getIndex.Rd b/man/getIndex.Rd new file mode 100644 index 0000000..8dcc56b --- /dev/null +++ b/man/getIndex.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/attributes.R +\name{getIndex} +\alias{getIndex} +\alias{setIndex} +\title{Extract or Set Slice Index} +\usage{ +getIndex(x) + +setIndex(x, ...) +} +\arguments{ +\item{x}{object of class \code{"slice"}} + +\item{...}{objects compatible with extracting or replacing a vector} +} +\value{ +object of class \code{"slice"} +} +\description{ +Functions to obtain or set the index to which a \code{\link{slice}} object points. +} +\examples{ +x <- matrix(1:9, nrow=3) +slice_x <- slice(x, 2:3, 1) +identical(getIndex(slice_x), list(2:3, 1)) # TRUE + +setIndex(slice_x, list(1, substitute())) +identical(!slice_x, c(1, 4, 7)) # TRUE + +} diff --git a/man/getSym.Rd b/man/getSym.Rd new file mode 100644 index 0000000..472e6ef --- /dev/null +++ b/man/getSym.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/attributes.R +\name{getSym} +\alias{getSym} +\alias{setSym} +\title{Extract or Set Reference Symbol} +\usage{ +getSym(x) + +setSym(x, sym) +} +\arguments{ +\item{x}{object of class \code{"ref"}} + +\item{sym}{symbol or character naming the object to which the reference points} +} +\value{ +character of length 1 +} +\description{ +Functions to obtain or set the object name to which a \code{\link{ref}} or \code{\link{sref}} object points. +} +\examples{ +x <- 1:10 +ref_to_x <- ref(x) +ref_env <- getEnv(ref_to_x) +ref_sym <- getSym(ref_to_x) + +identical(ref_env, .GlobalEnv) +identical(ref_sym, "x") + +y <- 500 +ref_to_x <- setSym(ref_to_x, y) +!ref_to_x + +} diff --git a/man/grapes-.-times-equals-grapes.Rd b/man/grapes-.-times-equals-grapes.Rd new file mode 100644 index 0000000..6d4b611 --- /dev/null +++ b/man/grapes-.-times-equals-grapes.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/incr.R +\name{\%.*=\%} +\alias{\%.*=\%} +\title{Matrix Multiplication In Place} +\usage{ +x \%.*=\% value +} +\arguments{ +\item{x}{object to be modified; can be a symbol, character, or extraction language object.} + +\item{value}{value with which to change \code{x} by} +} +\value{ +the new value of \code{x}, invisibly +} +\description{ +Change the value of an object on the search path through matrix multiplication. Similar to \code{'*='} in +other languages, except with matrix multiplication. See \code{\link{incr}} for details on implementation. +} +\examples{ +x <- 1:5 +x \%*=\% 6:10 +identical(x, 130) # TRUE +} diff --git a/man/grapes-equals-grapes.Rd b/man/grapes-equals-grapes.Rd new file mode 100644 index 0000000..00da956 --- /dev/null +++ b/man/grapes-equals-grapes.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/incr.R +\name{\%-=\%} +\alias{\%-=\%} +\title{Subtract In Place} +\usage{ +x \%-=\% value +} +\arguments{ +\item{x}{object to be modified; can be a symbol, character, or extraction language object.} + +\item{value}{value with which to change \code{x} by} +} +\value{ +the new value of \code{x}, invisibly +} +\description{ +Decrease the value of an object on the search path. Equivalent to \code{'-='} in other languages. +See \code{\link{incr}} for details on implementation. +} +\examples{ +x <- 11:20 +x \%-=\% 10 +identical(x, 1:10) # TRUE +} diff --git a/man/grapes-plus-equals-grapes.Rd b/man/grapes-plus-equals-grapes.Rd new file mode 100644 index 0000000..af57bc4 --- /dev/null +++ b/man/grapes-plus-equals-grapes.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/incr.R +\name{\%+=\%} +\alias{\%+=\%} +\title{Add In Place} +\usage{ +x \%+=\% value +} +\arguments{ +\item{x}{object to be modified; can be a symbol, character, or extraction language object.} + +\item{value}{value with which to change \code{x} by} +} +\value{ +the new value of \code{x}, invisibly +} +\description{ +Increase the value of an object on the search path. Equivalent to \code{'+='} in other languages. +See \code{\link{incr}} for details on implementation. +} +\examples{ +x <- 1:10 +x \%+=\% 10 +identical(x, 11:20) # TRUE +} diff --git a/man/grapes-pow-equals-grapes.Rd b/man/grapes-pow-equals-grapes.Rd new file mode 100644 index 0000000..ef4daa2 --- /dev/null +++ b/man/grapes-pow-equals-grapes.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/incr.R +\name{\%^=\%} +\alias{\%^=\%} +\title{Power In Place} +\usage{ +x \%^=\% value +} +\arguments{ +\item{x}{object to be modified; can be a symbol, character, or extraction language object.} + +\item{value}{value with which to change \code{x} by} +} +\value{ +the new value of \code{x}, invisibly +} +\description{ +Change the value of an object on the search path through exponentiation Equivalent to \code{'^='} in other languages. +See \code{\link{incr}} for details on implementation. +} +\examples{ +x <- 10 +x \%^=\% 2 +identical(x, 100) # TRUE +} diff --git a/man/grapes-slash-equals-grapes.Rd b/man/grapes-slash-equals-grapes.Rd new file mode 100644 index 0000000..be5d19f --- /dev/null +++ b/man/grapes-slash-equals-grapes.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/incr.R +\name{\%/=\%} +\alias{\%/=\%} +\title{Divide In Place} +\usage{ +x \%/=\% value +} +\arguments{ +\item{x}{object to be modified; can be a symbol, character, or extraction language object.} + +\item{value}{value with which to change \code{x} by} +} +\value{ +the new value of \code{x}, invisibly +} +\description{ +Change the value of an object on the search path through division. Equivalent to \code{'/='} in other languages. +See \code{\link{incr}} for details on implementation. +} +\examples{ +x <- 10 +x \%/=\% 2 +identical(x, 5) # TRUE +} diff --git a/man/grapes-times-equals-grapes.Rd b/man/grapes-times-equals-grapes.Rd new file mode 100644 index 0000000..18c2789 --- /dev/null +++ b/man/grapes-times-equals-grapes.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/incr.R +\name{\%*=\%} +\alias{\%*=\%} +\title{Multiply In Place} +\usage{ +x \%*=\% value +} +\arguments{ +\item{x}{object to be modified; can be a symbol, character, or extraction language object.} + +\item{value}{value with which to change \code{x} by} +} +\value{ +the new value of \code{x}, invisibly +} +\description{ +Change the value of an object on the search path through multiplication. Equivalent to \code{'*='} in other languages. +See \code{\link{incr}} for details on implementation. +} +\examples{ +x <- 5 +x \%*=\% 2 +identical(x, 10) # TRUE +} diff --git a/man/incr.Rd b/man/incr.Rd new file mode 100644 index 0000000..6973911 --- /dev/null +++ b/man/incr.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/incr.R +\name{incr} +\alias{incr} +\title{Increment Value In Place} +\usage{ +incr(x, by = 1) +} +\arguments{ +\item{x}{object to be incremented; can be a symbol, character, or extraction language object.} + +\item{by}{value to increase \code{x} by; defaults to \code{1}.} +} +\value{ +the value of \code{x} incremented by \code{by}, invisibly +} +\description{ +Increase the value of an object on the search path. Equivalent to \code{x++} or \code{x += by} in other languages. +} +\details{ +\code{incr} quotes object \code{x}, then attempts to determine the primary object to be modified. +For example, \code{z} will be the 'primary object' in \code{incr(z[1:4])}. \code{incr} then searches +for the primary object in the search path and records the environment. \code{x <- x + by} is then +evaluated within the recorded environment. + +The quoted object can be a symbol or character object. It can also be language object, though the primary +call must be either \code{`$`}, \code{`[`}, or \code{`[[`}. These can be nested. For example, \code{x[1]} +or \code{x[2, 1][3]} is acceptable, but \code{sqrt(x)} is not. + +See \code{\link{decr}} to decrease the value. +} +\examples{ +z <- 1:10 + +incr(z) +identical(z, as.numeric(2:11)) # TRUE + +incr(z[1:3], by=2) +identical(z[1:3], as.numeric(4:6)) # TRUE + +l <- list(a = 1, b = 2) +decr(l$a) +l$a == 0 # TRUE + +decr(l$b, by = 4) +l$b == -2 # TRUE +} diff --git a/man/is.nullref.Rd b/man/is.nullref.Rd new file mode 100644 index 0000000..997ce62 --- /dev/null +++ b/man/is.nullref.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/check.R +\name{is.nullref} +\alias{is.nullref} +\title{Is Reference Null?} +\usage{ +is.nullref(x) +} +\arguments{ +\item{x}{object of class \code{"ref"}} +} +\value{ +\code{TRUE} if \code{x} is not a reference or points to an object that does not exist; otherwise \code{FALSE}. +} +\description{ +Check whether a \code{\link{ref}} points to a \code{NULL} object or an object +that no longer exists. +} +\examples{ +# Create a vectors of random numbers and a reference +x <- rnorm(10) +ref_to_x <- ref(x) + +# Delete 'x' and check if NULL +is.nullref(ref_to_x) # FALSE +rm(x) +is.nullref(ref_to_x) # TRUE + +} diff --git a/man/is.ref.Rd b/man/is.ref.Rd new file mode 100644 index 0000000..c938a00 --- /dev/null +++ b/man/is.ref.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/check.R +\name{is.ref} +\alias{is.ref} +\alias{is.sref} +\alias{is.rfexpr} +\alias{is.slice} +\alias{is.a.ref} +\title{Is Object a Reference?} +\usage{ +is.ref(x) + +is.sref(x) + +is.rfexpr(x) + +is.slice(x) + +is.a.ref(x) +} +\arguments{ +\item{x}{object of any class} +} +\value{ +\code{TRUE} if \code{x} is a reference object, otherwise \code{FALSE} +} +\description{ +Check whether an R Object inherits a reference class. +} +\section{Functions}{ +\itemize{ +\item \code{is.sref}: check whether object is an 'sref' object + +\item \code{is.rfexpr}: check whether object is a reference expression + +\item \code{is.slice}: check whether object references a slice of a vector + +\item \code{is.a.ref}: check whether object is any type of reference class +}} + +\examples{ +# Create a vectors of random numbers +x <- rnorm(10) + +# Create a reference to the random numbers +ref_to_x <- ref(x) + +is.ref(ref_to_x) # TRUE + +} diff --git a/man/iter.ref.Rd b/man/iter.ref.Rd new file mode 100644 index 0000000..7e7e492 --- /dev/null +++ b/man/iter.ref.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/match.R +\name{iter.ref} +\alias{iter.ref} +\alias{iter.slice} +\alias{iter.rfexpr} +\title{Convert Reference to Iterable Object} +\usage{ +\method{iter}{ref}(x) + +\method{iter}{slice}(x) + +\method{iter}{rfexpr}(x) +} +\arguments{ +\item{x}{object to be looped across} +} +\value{ +a vector +} +\description{ +\code{\link{ref}} methods for use with \code{\link[eList]{iter}} in the \code{eList} package. +It allows \code{ref} objects to be used with the different vector comprehensions in the package +and with functions such as \code{\link[base]{lapply}} in base R. +} +\examples{ +x <- sample(1:10, 5, replace=TRUE) +slice_x <- slice(x, 1:2) + +lapply(eList::iter(slice_x), print) +} diff --git a/man/match_cond.ref.Rd b/man/match_cond.ref.Rd new file mode 100644 index 0000000..86ccb94 --- /dev/null +++ b/man/match_cond.ref.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/match.R +\name{match_cond.ref} +\alias{match_cond.ref} +\alias{match_cond.sref} +\alias{match_cond.slice} +\alias{match_cond.rfexpr} +\title{Check and Evaluate Match Condition} +\usage{ +\method{match_cond}{ref}(cond, x, do, ...) + +\method{match_cond}{sref}(cond, x, do, ...) + +\method{match_cond}{slice}(cond, x, do, ...) + +\method{match_cond}{rfexpr}(cond, x, do, ...) +} +\arguments{ +\item{cond}{match condition} + +\item{x}{object being matched} + +\item{do}{return expression associated with the condition. If \code{cond} is matched with \code{x}, then \code{do} +should be evaluated and returned in a list with \code{TRUE}: \code{list(TRUE, eval(do))}.} + +\item{...}{arguments passed to evaluation} +} +\value{ +\code{FALSE} if no match, or a list containing \code{TRUE} and the evaluated expression +} +\description{ +\code{\link{ref}} methods for use with \code{\link[matchr]{Match}} in the \code{matchr} package. +} +\details{ +See \code{\link[matchr]{Match}} for details about the implementation of \code{match_cond}. When matching, +\code{ref} conditions check whether \code{x} is a \code{ref} object. If so, then a match occurs if the condition +and \code{x} point to the same object. Otherwise, the condition is dereferenced and the resulting value +is checked using the appropriate match condition. Note that a \code{\link{slice}} is never matched with a +\code{\link{ref}} and vice versa, though \code{\link{ref}} and \code{\link{sref}} objects may match if they +point to the same object. +} +\examples{ +x <- 1:10 +ref_to_x <- ref(x) + +matchr::Match( + x, + is.character -> "is a character", + ref_to_x -> "same as reference", # <- MATCH + . -> "anything else" +) + +} diff --git a/man/modify_by.Rd b/man/modify_by.Rd new file mode 100644 index 0000000..413c82b --- /dev/null +++ b/man/modify_by.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modify.R +\name{modify_by} +\alias{modify_by} +\title{Modify an Object In Place} +\usage{ +modify_by(x, value, ...) +} +\arguments{ +\item{x}{object of class \code{"ref"}} + +\item{value}{new value or function applied to the object at the referenced location} + +\item{...}{additional arguments passed to the function} +} +\value{ +object of class \code{"ref"} +} +\description{ +Update the value pointed to by a \code{\link{ref}} object. If the new value is a function, +the old values will be applied to the function and overwritten. +} +\examples{ +x <- 1:10 +ref_to_x <- ref(x) + +# Apply the square root function +modify_by(ref_to_x, sqrt) +print(x) + +# Overwrite the original values +modify_by(ref_to_x, "hello world!") +print(x) + +} diff --git a/man/ref.Rd b/man/ref.Rd new file mode 100644 index 0000000..f785cb5 --- /dev/null +++ b/man/ref.Rd @@ -0,0 +1,106 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ref.R +\name{ref} +\alias{ref} +\title{Create Reference to an Object} +\usage{ +ref(x) +} +\arguments{ +\item{x}{object to be referenced. \code{x} can be a symbol, character, or an expression containing a symbol.} +} +\value{ +a list of class \code{"ref"} containing a reference to the environment of the object and the name of +the object to be found within the environment, or an expression of class \code{"rfexpr"} containing references +} +\description{ +Create a reference to an arbitrary R object. Use \code{\link{deref}} or \code{`!`} to obtain the values +within the referenced object. Use \code{\link{sref}} to create a safer reference that limits modification +in place. +} +\details{ +Since R does not have reference semantics outside of environments, \code{ref} records the environment location +of an object rather than its memory address.\code{ref(x)} searches for object with name \code{"x"} within the +search path. If found, a reference to the environment and the name \code{"x"} are recorded. Otherwise, an +error is returned. + +\code{ref} can also create a reference to objects within an expression. \code{ref} searches the uncalled names +within the expression and replaces them with a reference to the object and a call to deref. For example, +\code{ref(x[[y]][2])} inserts a reference to variable \code{x} and variable \code{y} from the search path into +the expression then wraps the expression into an object of class \code{"ref_exp"}. These objects are +dereferenced by evaluating the expression. An error is returned only if the corresponding variables cannot +be found along the search path. + +\code{\link{deref}} can be used to find the objects at the referenced location. This usually results in a +copy of the objects. If the object is no longer available, \code{NULL} will be returned. Generic functions on +a \code{ref} object, such as arithmetic or \code{`sqrt`}, will automatically dereference the object before +applying the generic function. See \link{Methods} and \link{Extract} for a list of available functions +where explicit dereferencing is not needed. If this behavior is not desired, then \code{\link{sref}} can +be used to force the explicit use of \code{deref}. + +See \link{Extract} and \code{\link{modify_by}} for functions that modify the underlying value in place. + +An active binding could also be used instead of creating a reference. Active bindings, though, can be more +difficult to pass around and may have additional overhead since they are functions. + +\code{ref} can provide unsafe or inconsistent code that is susceptible to side-effects. Apply caution and +restraint with its use and be sure to \code{deref} before exporting any \code{ref} objects. +} +\examples{ +# Create a vectors of random numbers +x <- rnorm(10) +y <- runif(10) + +# Create a reference to the random numbers +ref_to_x <- ref(x) +ref_to_y <- ref(y) + +# Place references in a list +list_of_refs <- list(x = ref_to_x, y = ref_to_y) + +# Check sum of refs 'x' and 'y' +# Note that both `+` and `sum` automatically deref +sum1 <- sum(list_of_refs$x + list_of_refs$y) + +# Update 'x' and calculate new sum +x <- rnorm(10) +sum2 <- sum(list_of_refs$x + list_of_refs$y) + +# check diff in sums to see if 'list_of_refs' updated +sum2 - sum1 + +# Obtain a reference to an expression +ref_to_part <- ref(x[2:5] + 3) +deref(ref_to_part) + +# Another expression reference +refs_to_list <- ref(list(x, y)) +deref(refs_to_list) + +x <- "hello" +y <- "world" + +deref(refs_to_list) + +# Alternative, `!` can be used for dereferencing +!refs_to_list + +identical(!refs_to_list, deref(refs_to_list)) + +# Referencing data.frame columns +dat <- data.frame(first = 1:4, second = 5:8) +ref_to_first <- ref(dat$first) +mean1 <- mean(!ref_to_first) + +dat$first <- dat$first * 4 +mean2 <- mean(!ref_to_first) + +mean2 == 4*mean1 + +# Many operations automatically dereference +ref_to_first * 5 +ref_to_x == ref_to_y +cos(ref_to_first) +max(ref_to_first) + +} diff --git a/man/ref_list.Rd b/man/ref_list.Rd new file mode 100644 index 0000000..4f7d872 --- /dev/null +++ b/man/ref_list.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ref.R +\name{ref_list} +\alias{ref_list} +\title{Create A List of References} +\usage{ +ref_list(...) +} +\arguments{ +\item{...}{objects to be referenced, possibly named.} +} +\value{ +a list containing object references +} +\description{ +Create a list of references or referenced expressions. See \code{\link{ref}} for more details. +} +\examples{ +x <- 1 +y <- "hello" +z <- list(a = 1, b = 2, c = 3) + +new_list <- ref_list(x, second = y, z) + +!new_list[[1]] +(!new_list$second) == y # TRUE + +y <- 18 +(!new_list$second) == 18 # TRUE + +} diff --git a/man/slice.Rd b/man/slice.Rd new file mode 100644 index 0000000..ed8d4a2 --- /dev/null +++ b/man/slice.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/slice.R +\name{slice} +\alias{slice} +\title{Create a Reference Slice to a Vector} +\usage{ +slice(x, ...) +} +\arguments{ +\item{x}{object to be referenced; must be a symbol or character} + +\item{...}{objects passed to \code{x[...]} when dereferenced} +} +\value{ +object of class \code{"slice"} and \code{"ref"} +} +\description{ +Create a reference to a 'part' of an R object. Use \code{\link{deref}} or \code{`!`} to obtain the values +within the referenced object. +} +\details{ +\code{slice} is similar to \code{\link{ref}}; it creates a reference to another R object. There are two +main differences with \code{ref}. First, \code{slice} only accepts names or characters instead of +expressions. Second, \code{slice} records a part of the underlying object. \code{slice(x, 1:2, 3)} +is equivalent to the reference of \code{x[1:2, 3]}. This is similar to \code{ref(x[1:2, 3])}, though the +implementation is different. \code{ref} would create an expression with a reference to \code{x}, while +\code{slice(x, 1:2, 3)} creates a list with a reference to \code{x} and the extract inputs. \code{slice} +is more efficient, but is limited in its capabilities. +} +\examples{ +## Vector Slice +x <- 10:1 + +slice_x <- slice(x, 2:4) +identical(!slice_x, 9:7) # TRUE + +x <- x - 2 +identical(!slice_x, 7:5) # TRUE + +## Matrix Slice +y <- matrix(1:9, nrow=3) +slice_y <- slice(y, 2, 3) + +identical(!slice_y, y[2, 3]) # TRUE +} diff --git a/man/sref.Rd b/man/sref.Rd new file mode 100644 index 0000000..e520e55 --- /dev/null +++ b/man/sref.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sref.R +\name{sref} +\alias{sref} +\title{Create a Safer Reference to an Object} +\usage{ +sref(x) +} +\arguments{ +\item{x}{object to be referenced. \code{x} can be a symbol, character, or an expression containing a symbol.} +} +\description{ +Create a reference to an arbitrary R object. See \code{\link{ref}} for more details. \code{sref} behaves +similar to \code{ref}, but does not have support for direct operations on the referenced object. +} +\details{ +\code{sref} is similar to \code{\link{ref}}; it accepts either an R object or an expression, then records +its location. \code{ref} objects prioritize convenience, while \code{sref} objects prioritize clarity and +safety. For example, \code{`[`} and \code{`$`} can be used on a \code{ref} object to access the elements +of the underlying object, while \code{`[<-`} and \code{`$<-`} can be used to overwrite elements within. +These do not work for \code{sref} objects. Furthermore, base mathematical functions such as \code{`+`} +and \code{sqrt} also will not automatically dereference before applying. +} +\examples{ +x <- 1:10 +ref_x <- ref(x) +sref_x <- sref(x) + +## These operations will run: +ref_x + 5 +ref_x[1:4] +ref_x[7] <- 5 + +## These operations will not run: +# sref_x + 5 +# sref_x[1:4] +# sref_x[7] <- 5 + +} diff --git a/man/sslice.Rd b/man/sslice.Rd new file mode 100644 index 0000000..560c171 --- /dev/null +++ b/man/sslice.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sref.R +\name{sslice} +\alias{sslice} +\title{Create a Safer Reference Slice to a Vector} +\usage{ +sslice(x, ...) +} +\arguments{ +\item{x}{object to be referenced; must be a symbol or character} + +\item{...}{objects passed to \code{x[...]} when dereferenced} +} +\value{ +object of class \code{"sslice"} and \code{"sref"} +} +\description{ +Create a reference to a 'part' of an R object. \code{sslice} behaves similar to \code{\link{slice}}, but does not +have support for direct operations on the referenced object. See \code{\link{sref}} for details about the behavior. +} diff --git a/vignettes/introRef.Rmd b/vignettes/introRef.Rmd new file mode 100644 index 0000000..c33dd8d --- /dev/null +++ b/vignettes/introRef.Rmd @@ -0,0 +1,164 @@ +--- +title: "An Introduction to 'refer' References" +author: "Christopher Mann" +date: "`r Sys.Date()`" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{An Introduction to 'refer' References} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +The `refer` package allows users to keep references to objects and modify objects in place with relying on reference classes. This article describes how to use `ref` objects by moving objects around a map. Please note that many of the operations in the `refer` package go against the philosophy of R and may lead to inconsistent and unclear code; use sparingly and with caution. + +First, we need to load the `refer` package. + +```{r} +library(refer) +``` + +## Creating References, Reference Expressions, and Slices + +Our goal with this project is to population a map. We will use a character matrix and keep it small at 10x10. + +```{r} +map <- matrix(' ', nrow=10, ncol=10) +map +``` + +Next, let us create a person to place on the map. The person will keep track of its location and a reference to the map object. We will place a representative of the person on the map. + +```{r} +person <- list( + map = ref(map), + row = 1, + col = 1 +) +map[1,1] <- 'X' +``` + +Since a reference of the map is placed inside `'person'`, we can always use it to indirectly access the map. Just calling `person$map`, though, only returns the reference not the actual item. + +```{r} +person$map +``` + +To return the underlying object, we must 'dereference' the item using either the `deref()` function or the `!` operator. + +```{r} +!person$map +``` + +If we add a new object to the original map, then the change is reflected when it is dereferenced from `person`. + +```{r} +map[1,5] <- "O" +!person$map +``` + +`ref` can also be used to build expressions that contain references. For example, `location` below contains a reference to the `row` and `col` of `person`.Dereferencing `location` evaluates the expression, taking note of where person is located when originally created. The effect is similar to creating an active binding. However, active bindings are heavier and much more difficult to pass around, inspect, and so forth. + +```{r} +location <- ref(c(person$row, person$col)) +location +``` + +```{r} +!location +``` + +Since `location` is a reference, updating either `row` or `col` will change the dereferenced value of location. + +```{r} +person$row <- person$row + 1 +!location +``` + +Note that `ref` objects automatically dereference when applied to many base functions such arithmetic operators. This includes the standard extraction operators: `$`, `[`, and `[[`. However, these do not overwrite the underlying data. + +```{r} +location + 1 +!location +``` + +A `slice` is a special type of reference that refers to part of an object. For example, we could create a slice that points to the second row and last 5 columns of the map. If these values change, the slice reflects these changes. + +```{r} +row1 <- slice(map, 1, 1:5) +!row1 +``` + +```{r} +map[1, 3] <- "%" +!row1 +``` + +When dereferenced, the above `slice` calls `map[2, 6:10]` within the environment that map is located. Since `ref` objects automatically dereference when extraction calls are made, `slice` could even be used on another reference. + +```{r} +loc_row <- slice(location, 1) +!loc_row +``` + + +## Modifying Variables In Place + +The `ref` package contains another of functions to modify objects in place. For example, it includes variations on the standard `+=` and `-=` operators found in many languages such as Python. + +```{r} +person$col %+=% 3 +person$col +``` + +```{r} +person$col %-=% 3 +person$col +``` + +These functions can also accept other reference objects. When a reference object is used, the underlying object is modified. This can be dangerous, so use sparingly! + +```{r} +x <- 1:nrow(map) +slice_x <- slice(x, 3:6) +slice_x %+=% 10 +x +``` + + +Objects can also be modified in place with custom functions using `modify_by`. + +```{r} +modify_by(x, sqrt) +x +``` + +`modify_by` can also be used to completely overwrite the value of an object further up the search path by passing a value rather than a function. + +```{r} +modify_by(x, 5) +x +``` + +## Safer References + +The general `ref` function automatically dereferences when passed to a wide variety of functions and can modify the underlying objects in place. `sref` is an alternative version of `ref` that does away with this behavior. `sref` objects can still be dereferenced as normal, but attempts to modify or apply functions to the reference will throw an error. Use `sslice` to create `sref` versions of slices. + +```{r} +p <- sref(person) +!p +``` + +```{r eval=FALSE} +## These will spawn an error. Don't run! +p$row +modify_by(p, function(x){ x$row <- x$row + 1; x }) +``` + +