Update formula objects in R with offset function - r

I have an R formula object:
R> formula.obj <- Y ~ 1 + X + offset(Z)
I want to get rid of offset(Z) and obtain:
R> formula.obj.want <- Y ~ 1 + X
It seems that update function does NOT work in this scenario:
R> update(formula.obj,.~.-offset(Z))
Y ~ X + offset(Z)
Is there way to get formula.obj.want from formula.obj?

You can't do this in update. "-" is not supported for offset formulas http://stat.ethz.ch/R-manual/R-patched/library/stats/html/offset.html
Define another function as u did

You can use the list structure and the language
> formula.obj[[3]] <- quote(1 + X)
> formula.obj
Y ~ 1 + X
> class(formula.obj)
[1] "formula"
Note that I did try update, and it did not want to include the 1
> update(formula.obj, .~ 1 + X)
Y ~ X

Related

Treat a literal variable as a constant with Ryacas (or an alternative)

With Ryacas, one has:
> yac_str("Simplify(2*x^2*4 + x^2*5)")
[1] "13*x^2"
Now, instead of 4 and 5, I would like to give two letters treated as constants. That is, Ryacas does:
> yac_str("Simplify(2*x^2*a + x^2*b)")
[1] "2*x^2*a+x^2*b"
but I would like that it treats x as an unknown variable and a and b as constants, i.e. I would like to get the result:
(2*a+b)*x^2
I spent one hour to try with no luck. Is it possible? Otherwise, with another package?
This seems to be just how yacas wants to simplify that expression. SymPy does it the way you want though, and it has an R wrapper called caracas
library(caracas)
a <- as_sym("a")
b <- as_sym("b")
x <- as_sym("x")
caracas::simplify(2*x^2*a+x^2*b)
#> [caracas]: 2
#> x *(2*a + b)
I don't like the way it prints x^2, but you can't have everything.
I found the way with caracas.
library(caracas)
def_sym(x, y, z, a, b)
as.character(sympy_func(x^2 + a*x^2 + 2*y + b*y + x*z + a*x*z, "Poly", domain = "RR[a,b]"))
# "Poly((1.0*a + 1.0)*x^2 + (1.0*a + 1.0)*x*z + (1.0*b + 2.0)*y, x, y, z, domain='RR[a,b]')"
You can also work with rational numbers:
poly <-
sympy_func(x^2 + a*x^2 + 2/3*y + b*y + x*z + a*x*z, "Poly", domain = "QQ[a,b]")
as.character(poly)
# "Poly((a + 1)*x^2 + (a + 1)*x*z + (b + 2/3)*y, x, y, z, domain='QQ[a,b]')"
To get the coefficient of a term, e.g. xz (i.e. x^1y^0z^1):
sympy <- get_sympy()
sympy$Poly$nth(poly$pyobj, 1, 0, 1)
# a + 1

Subsetting formula objects in R

Given any formula object (e.g., f) below, I was wondering how I could separate tilda sign and everything after it and convert it into a formula object?
My desired output only in this example case is: ~ es.type+weeks as a formula object.
NOTE: f could be ANY formula, the above f is just an example. I'm looking for a general solution.
f <- formula(dint ~ es.type+weeks) # Only as an example
g <- paste0(f[[1]], f[[3]]) # No success
as.formula(g) # No success
You can just manipulate the formula directly:
f <- y ~ x1 + x2:x3
f[[2]] <- f[[3]]
f[[3]] <- NULL
identical(f, ~ x1 + x2:x3)
# TRUE
An option is to drop the terms based on the number of terms in the formula
g <- formula(drop.terms(terms(f), 3))
g
#~es.type + weeks
f1 <- formula(dint ~ es.type:weeks)
formula(drop.terms(terms(f1), 3))
#~es.type:weeks
It would be better to create a function to applied for different formulas
form1 <- function(form) {
i1 <- length(terms(form)) + 1
formula(drop.terms(terms(form), i1))
}
f1 <- formula(dint ~ es.type+weeks+dd)
f2 <- formula(dint ~ es.type+weeks)
form1(f1)
#~es.type + weeks + dd
form1(f2)
#~es.type + weeks
If we need to add a new term
update(form1(f2), ~time +.)
#~time + es.type + weeks

Use variable in R substitute

I have an expression stored in a variable
a <- expression(10 + x + y)
I want to use substitute to fill the expression with x = 2
substitute(a, list(x=2))
But this returns a and a evaluates to expression(10 + x + y)
Ideally a would evaluate to expression(12 + y) (or (10 + 2 + y))
Is there any way to implement this behavior while using an expression stored in the variable a (mandated by other parts of my project)?
Use do.call. substitute won't descend into some objects but if you use a[[1]] here then it will work.
a <- expression(10 + x + y)
do.call("substitute", list(a[[1]], list(x = 2)))
## 10 + 2 + y
You could do that with pryr if you can use an alternative (i.e. quote instead of expression):
a <- quote(10 + x + y)
library(pryr)
substitute_q(a, list(x=2))
#10 + 2 + y
Maybe this one snippet can be useful
x <- 1; y <- 2
a <- expression(10 + x + y)
eval(a)

How to wrap RHS terms of a formula with a function

I can construct a formula that does what I desire starting with the character versions of terms in a formula, but I'm stumbling in starting with a formula object:
form1 <- Y ~ A + B
form1[-c(1,2)][[1]]
#A + B
Now how to build a formula object that looks like:
Y ~ poly(A, 2) + poly(B, 2) + poly(C, 2)
Or:
Y ~ pspline(A, 4) + pspline(B, 4) + pspline(C, 4)
Seems that it might involve a recursive walk along the RHS but I'm not getting progress. It just occurred to me that I might use
> attr( terms(form1), "term.labels")
[1] "A" "B"
And then use the as.formula(character-expr) approach, but I's sorly of like to see an lapply (RHS_form, somefunc) version of a polyize (or perhaps polymer?) function.
If I borrow some functions I originally wrote here, you could do something like this. First, the helper functions...
extract_rhs_symbols <- function(x) {
as.list(attr(delete.response(terms(x)), "variables"))[-1]
}
symbols_to_formula <- function(x) {
as.call(list(quote(`~`), x))
}
sum_symbols <- function(...) {
Reduce(function(a,b) bquote(.(a)+.(b)), do.call(`c`, list(...), quote=T))
}
transform_terms <- function(x, f) {
symbols_to_formula(sum_symbols(sapply(extract_rhs_symbols(x), function(x) do.call("substitute",list(f, list(x=x))))))
}
And then you can use
update(form1, transform_terms(form1, quote(poly(x, 2))))
# Y ~ poly(A, 2) + poly(B, 2)
update(form1, transform_terms(form1, quote(pspline(x, 4))))
# Y ~ pspline(A, 4) + pspline(B, 4)
There's a formula.tools package that provides various utility functions for working with formulas.
f <- y ~ a + b
rhs(f) # a + b
x <- get.vars(rhs(f)) # "a" "b"
r <- paste(sprintf("poly(%s, 4)", x), collapse=" + ") # "poly(a, 4) + poly(b, 4)"
rhs(f) <- parse(text=r)[[1]]
f # y ~ poly(a, 4) + poly(b, 4)

How to apply a formula to a vector in R?

not for the first time, I guess that the answer is quite simple. But searching for R solutions is regularly hard work and after two hours its probably at time to ask someone...
I am working with a non-linear formula (this is only the first work on it, it will actually become non-linear soon) and to test my initial values, i would like to simply calculate the values over a series of x values.
Here is some code:
x <- c(1,2,3,4,5,6,7,8,9,10,11,12) #etc
y <- c(NA,332,248,234,84,56,26,24,27,33,37,25) #etc
# This is my formula I shall soon expand
fEst <- y ~ 1 / (x / a + 1) * b
# Initial value
a <- 800
# Initial value based on inverted formula and second measure
b <- y[2] * (x[2] / a + 1)
# Can i use my formula fEst to do this step?
p <- 1 / (x / a + 1) * b
The point is that I am working on the formula - and it seems strange to make each change, twice...
What I found was a package nls2 where something like this was possible and a function apply.a.formula which seems to be an element from another package - but as this is a very basic use of a function, I guess that the R base packe already has the appropriate functions. Just ... where?
Thanks!
I came across this thread whilst looking up the avenues you'd tried and the solution posted by Gabor. Note that apply.a.formula() is a made up function name that the OP in the thread was looking to find a real function for.
Using the example that Gabor provided in the thread this is a solution using the nls2 package:
## your data
x <- c(1,2,3,4,5,6,7,8,9,10,11,12) #etc
y <- c(NA,332,248,234,84,56,26,24,27,33,37,25) #etc
# This is my formula I shall soon expand
fEst <- y ~ 1 / (x / a + 1) * b
# Initial value
a <- 800
# Initial value based on inverted formula and second measure
b <- y[2] * (x[2] / a + 1)
## install.packages("nls2", depend = TRUE) if not installed
require(nls2)
fitted(nls2(fEst, start = c(a = a, b = b), alg = "brute"))
The last line gives:
R> fitted(nls2(fEst, start = c(a = a, b = b), alg = "brute"))
[1] 332.4145 332.0000 331.5866 331.1741 330.7627 330.3524 329.9430 329.5347
[9] 329.1273 328.7210 328.3157 327.9113
attr(,"label")
[1] "Fitted values"
which is essentially the same as 1 / (x / a + 1) * b would give:
R> 1 / (x / a + 1) * b
[1] 332.4145 332.0000 331.5866 331.1741 330.7627 330.3524 329.9430 329.5347
[9] 329.1273 328.7210 328.3157 327.9113
From the comments, Carl Witthoft notes that if you want to generalise equations like 1 / (x / a + 1) * b then a function might be a useful way of encapsulating the operation without typing out 1 / (x / a + 1) * b every time. For example
myeqn <- function(a, b, x) { 1 / (x / a + 1) * b }
R> myeqn(a, b, x)
[1] 332.4145 332.0000 331.5866 331.1741 330.7627 330.3524 329.9430 329.5347
[9] 329.1273 328.7210 328.3157 327.9113

Resources