Initial commit (hits documentation bug r-lib/roxygen2#666)

.Rbuildignore

@@ -0,0 +1,2 @@
+^.*\.Rproj$
+^\.Rproj\.user$

.gitignore

@@ -0,0 +1,3 @@
+.Rproj.user
+.Rhistory
+.RData

DESCRIPTION

@@ -0,0 +1,10 @@
+Package: formulops
+Title: Mathematical Operations on R Formula
+Version: 0.0.0.9000
+Authors@R: person("Bill", "Denney", email="[email protected]", role=c("aut", "cre"), comment=c(ORCID="0000-0002-5759-428X"))
+Description: Perform mathematical operations on R formula (add, subtract, multiply, etc.).
+Depends: R (>= 3.5.1)
+License: GPL-3
+Encoding: UTF-8
+LazyData: true
+RoxygenNote: 6.1.0

NAMESPACE

@@ -0,0 +1,2 @@
+# Generated by roxygen2: do not edit by hand
+

R/formula_math.R

@@ -0,0 +1,237 @@
+#' Modify a formula by finding some part of it and replacing it with a new
+#' value.
+#' 
+#' @details Replacement occurs at the first match, so if the replacement list
+#'   would modify something in the find list, that change will not occur (make
+#'   two calls to the function for that effect).  See the "Replacement is not
+#'   sequential" examples below.
+#'
+#' @param formula The formula to modify (may also be a call)
+#' @param find A call or name (or list thereof) to search for within the formula
+#' @param replace A call or name (or list thereof) to replace the \code{find}
+#'   values
+#' @return \code{formula} modified
+#' @examples
+#' modify_formula(a~b, find=quote(a), replace=quote(c))
+#' modify_formula(a~b, find=quote(a), replace=quote(c+d))
+#' modify_formula(a~b/c, find=quote(b/c), replace=quote(d))
+#' # Replacement is not sequential
+#' modify_formula(a~b/c, find=list(quote(b/c), quote(d)), replace=list(quote(d), quote(e)))
+#' modify_formula(a~b/c+d, find=list(quote(b/c), quote(d)), replace=list(quote(d), quote(e)))
+#' @export
+modify_formula <- function(formula, find, replace) {
+  if (xor(is.list(find), is.list(replace))) {
+    stop("Both or neither of `find` and `replace` must be a list.")
+  }
+  if (!is.list(find)) {
+    find <- list(find)
+    replace <- list(replace)
+  }
+  if (length(find) != length(replace)) {
+    stop("`find` and `replace` lists must be the same length.")
+  }
+  if (length(find) == 0) {
+    stop("`find` and `replace` lists must have length > 0.")
+  }
+
+  replaced <- FALSE
+  for (idx in seq_along(find)) {
+    if (identical(formula, find[[idx]])) {
+      formula <- replace[[idx]]
+      replaced <- TRUE
+    }
+    if (replaced) {
+      break
+    }
+  }
+  if (!replaced && length(formula) > 1) {
+    for (idx in seq_along(formula)) {
+      formula[[idx]] <- modify_formula(formula[[idx]], find, replace)
+    }
+  }
+  formula
+}
+
+#' Add parentheses to a base formula to ensure clarify for order of operations
+#'
+#' @param base_formula A formula or name to modify with parts to be replaced
+#'   named `a` and `b` for \code{e1} and {e2}.
+#' @param e1,e2 a name or call
+#' @return \code{base_formula} revised such that `a` and `b` have parentheses
+#'   around them if \code{e1} and \code{e2} have lengths > 1, respectively.
+#' @examples
+#' add_parens_base_formula(a~b, quote(c+d), quote(e))
+#' @noRd
+add_parens_base_formula <- function(base_formula, e1, e2) {
+  if (length(e1) > 1) {
+    base_formula <- modify_formula(base_formula, find=quote(a), replace=quote((a)))
+  }
+  if (!missing(e2)) {
+    if (length(e2) > 1) {
+      base_formula <- modify_formula(base_formula, find=quote(b), replace=quote((b)))
+    }
+  }
+  base_formula
+}
+
+#' Perform a mathematical operation on two formula
+#'
+#' @details The method for combination depends if the two formula are one- or
+#'   two-sided.
+#' 
+#' If both formula are one-sided, the right hand side (RHS) of both are added
+#' together with additional parentheses added, if parentheses appear to be
+#' needed.  If both formula are two-sided, the left hand side (LHS) and RHS are
+#' separately added.  If one formula is one-sided and the other is two-sided,
+#' the LHS is selected from the two-sided formula and the RHS follows rules as
+#' though two one-sided formula were added.
+#'
+#' @param op The operation to perform either as a name or something that can be
+#'   coerced into a name.
+#' @param e1,e2 The formulae to combine
+#' @return \code{e1} and \code{e2} combined by the operation with the
+#'   environment from \code{e1}.  See Details.
+#' @examples
+#' op_formula("+", a~b, c~d)
+#' op_formula("+", a~b, ~d)
+#' op_formula("+", ~b, c~d)
+#' op_formula("+", ~b, ~d)
+#' op_formula("-", a~b)
+#' op_formula("-", -a~b) # Dumb, but accurate
+#' op_formula("-", -a~b, c~-d) # Dumb, but accurate
+#' 
+#' log(a~b)
+#' @export
+op_formula <- function(op, e1, e2) {
+  if (!is.name(op)) {
+    op <- as.name(op)
+  }
+  if (!(length(e1) %in% 2:3)) {
+    # is this possible?
+    stop("`e1` must be a one- or two-sided formula.") # nocov
+  }
+  if (!missing(e2) && !(length(e2) %in% 2:3)) {
+    # is this possible?
+    stop("`e2` must be a one- or two-sided formula.") # nocov
+  }
+  if (missing(e2)) {
+    # unary operator
+    base_formula <-
+      modify_formula(quote(-a), find=as.name("-"), replace=op)
+    out <- e1
+    out[[2]] <-
+      modify_formula(
+        add_parens_base_formula(base_formula, e1=e1[[2]]),
+        find=quote(a),
+        replace=e1[[2]]
+      )
+    if (length(e1) == 3) {
+      out[[3]] <-
+        modify_formula(
+          add_parens_base_formula(base_formula, e1=e1[[3]]),
+          find=quote(a),
+          replace=e1[[3]]
+        )
+    }
+  } else if (length(e1) != length(e2)) {
+    if ((length(e1) == 2) &
+        (length(e2) == 3)) {
+      out <- e2
+      other <- e1
+      environment(out) <- environment(e1)
+    } else if ((length(e1) == 3) &
+               (length(e2) == 2)) {
+      out <- e1
+      other <- e2
+    } else {
+      stop("Unknown how to handle a formula with different lengths that are != 2 or 3") # nocov
+    }
+    out[[3]] <- op_formula(op, out[c(1, 3)], other)[[2]]
+  } else if (length(e1) == length(e2)) {
+    out <- e1
+    # they are both one- or two-sided
+    base_formula <-
+      modify_formula(
+        quote(a+b),
+        find=as.name("+"),
+        replace=op
+      )
+    if (length(e1) == 2) {
+      # one-sided
+      out[[2]] <-
+        modify_formula(
+          formula=add_parens_base_formula(base_formula, e1[[2]], e2[[2]]),
+          find=list(quote(a), quote(b)),
+          replace=list(e1[[2]], e2[[2]])
+        )
+    } else if (length(e1) == 3) {
+      # two-sided
+      out[[2]] <-
+        modify_formula(
+          formula=add_parens_base_formula(base_formula, e1[[2]], e2[[2]]),
+          find=list(quote(a), quote(b)),
+          replace=list(e1[[2]], e2[[2]])
+        )
+      out[[3]] <-
+        modify_formula(
+          formula=add_parens_base_formula(base_formula, e1[[3]], e2[[3]]),
+          find=list(quote(a), quote(b)),
+          replace=list(e1[[3]], e2[[3]])
+        )
+    }
+  }
+  out
+}
+
+#' @describeIn op_formula Multiply two formula (identical to \code{(a~b) * (c~d)}
+#' @export
+multiply_formula <- function(e1, e2) {
+  op_formula("*", e1, e2)
+}
+
+#' @describeIn op_formula Divide two formula (identical to \code{(a~b) / (c~d)}
+#' @export
+divide_formula <- function(e1, e2) {
+  op_formula("/", e1, e2)
+}
+
+#' @describeIn op_formula Add two formula (identical to \code{(a~b) + (c~d)}
+#' @export
+add_formula <- function(e1, e2) {
+  op_formula("+", e1, e2)
+}
+
+#' @describeIn op_formula Multiply two formula (identical to \code{(a~b) - (c~d)}
+#' @export
+subtract_formula <- function(e1, e2) {
+  op_formula("-", e1, e2)
+}
+
+#' @describeIn op_formula Support generic binary operators and a couple of unary
+#'   operators (see ?Ops).
+#' @export
+Ops.formula <- function(e1, e2) {
+  if (missing(e2)) {
+    # Unary operators
+    op_formula(.Generic, e1)
+  } else {
+    op_formula(.Generic, e1, e2)
+  }
+}
+
+#' @describeIn op_formula Support generic unary operators (see ?Math).
+#' @export
+Math.formula <- function(x, ...) {
+  base_formula <-
+    modify_formula(quote(a(b)), find=quote(a), replace=as.name(.Generic))
+  out <- x
+  if (length(out) == 2) {
+    out[[2]] <- modify_formula(base_formula, find=quote(b), replace=out[[2]])
+  } else if (length(out) == 3) {
+    out[[2]] <- modify_formula(base_formula, find=quote(b), replace=out[[2]])
+    out[[3]] <- modify_formula(base_formula, find=quote(b), replace=out[[3]])
+  } else {
+    stop("Can only work with one- or two-sided formula")
+  }
+  out
+}

formulops.Rproj

@@ -0,0 +1,16 @@
+Version: 1.0
+
+RestoreWorkspace: No
+SaveWorkspace: No
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+Encoding: UTF-8
+
+AutoAppendNewline: Yes
+StripTrailingWhitespace: Yes
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace