Suppose I have a following formula:
fr <- formula(y~myfun(x)+z)
Given object fr
is there a function in R which returns myfun(x)
? I've written my own function (code below) which basically does what I need, but maybe there is some standard way of doing that?
The code for my function:
selectmds <- function(expr,funcn) {
if(length(expr)>2) {
a <- expr[[2]]
b <- expr[[3]]
if(length(a)>1) {
if(as.name(a[[1]])==funcn) {
if(length(grep(funcn,all.names(b)))>0) {
return(list(a,selectmds(b,funcn)))
}
else return(list(a))
}
}
if(length(b)>1) {
if(as.name(b[[1]])==funcn) {
if(length(grep(funcn,all.names(a)))>0) {
return(list(b,selectmds(a,funcn)))
}
else return(list(b))
}
}
for(i in 2:length(expr)) {
if(length(grep(funcn,all.names(expr[[i]])))>0)return(selectmds(expr[[i]],funcn))
}
}
return(NULL)
}
Here are several examples:
> selectmds(formula(y~myfun(x)+z),"myfun")
[[1]]
myfun(x)
> unlist(selectmds(formula(y~myfun(x)+z+myfun(zz)),"myfun"))
[[1]]
myfun(zz)
[[2]]
myfun(x)
Not sure this is best, but you can do it by:
f <- function(fm, fun) {
l <- as.list(attr(terms(fm), "variables"))[-1]
l[grep(fun, l)]
}
then,
> f(formula(y~myfun(x)+z),"myfun")
[[1]]
myfun(x)
> f(formula(y~myfun(x)+z+myfun(zz)),"myfun")
[[1]]
myfun(x)
[[2]]
myfun(zz)
There is a specials
argument to terms
that allows you to flag named functions in the formula for extraction by position.
So, you can write
selectmds<-function(form,fn) {
tt<-terms(form,specials=fn);
idx<-attr(tt,"specials");
v<-as.list(attr(tt,"variables"))[-1];
unlist(lapply(idx,function(i) v[i]))
}
Then your testcases give
> selectmds(formula(y~myfun(x)+z),"myfun")
$myfun
myfun(x)
> selectmds(formula(y~myfun(x)+z+myfun(zz)),"myfun")
$myfun1
myfun(x)
$myfun2
myfun(zz)
But, you can also do
> selectmds(formula(y~myfun(x)+myfun(x2)+z+yourfun(zz)),c("myfun","yourfun"))
$myfun1
myfun(x)
$myfun2
myfun(x2)
$yourfun
yourfun(zz)
Where you could strike the unlist
to have this nested by named function instead.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With