Function accumulated - r

a <- function(x){
a = 2*x*x
return(a)
}
b (x) <- a(1) + a(2) + ... + a(x)
there is function a, I want to write a function b,which is a accumulation of function a.
I write it in R.

Maybe like this:
a <- function(x)
{2*x*x}
b<- function(y)
{sum(sapply(seq(y),a))}
so
b(3) = 28
since
b(3) = a(1) + a(2) + a(3)
= 2*1*1 + 2*2*2 + 2*3*3
= 2 + 8 + 18
= 28

Function b creates an expression and evaluates that expression to return the result.
a <- function(x){
return(2*x*x)
}
b <- function(x){
eval( parse( text = paste0( strsplit( paste0( "a(", x, ")"), " "), collapse = "+") ))
}
b(1:2)
# [1] 10
b(1:3)
# [1] 28
b(1:5)
# [1] 110
b(c(2,4,6))
# [1] 112

Related

R for loop that passes only once though a vector

I would like to concatenate an equation for a logistic model first followed by a linear model.
For model 1, o1=p1+p2+p3 (binomial will be input to family parameter in glm function)
For model 2, o2=p1+p2+p3 (gaussian will be input to family parameter in glm function)
In the real life example, there will be many more models.
Here is the basic scenario:
outcome <- c("o1", "o2")
predictor <- c("p1", "p2", "p3")
link=c("binomial", "gaussian")
try <- function(outcomes, predictors) {
for(o in outcome) {
eq <- paste(o, "~")
for(p in predictor) {
eq=paste0(eq, p, "+")
}
# remove extra +
eq <- substr(eq,1,nchar(eq)-1)
# model will go here
eq <- lapply(link, function(x) paste0(x, " - ", eq))
print(eq)
}
}
try(outcomes=outcome, predictors=predictor)
Output:
[[1]]
[1] "binomial - o1 ~p1+p2+p3"
[[2]]
[1] "gaussian - o1 ~p1+p2+p3"
[[1]]
[1] "binomial - o2 ~p1+p2+p3"
[[2]]
[1] "gaussian - o2 ~p1+p2+p3"
Instead, I want:
[1] "binomial - o1 ~p1+p2+p3"
[1] "gaussian - o2 ~p1+p2+p3"
We can do
try1 <- function(outcomes, predictors) {
Map(function(x, y) paste(y, '-',
deparse(reformulate(predictors, x))), outcomes, link)
}
-testing
try1(outcomes=outcome, predictors=predictor)
#$o1
#[1] "binomial - o1 ~ p1 + p2 + p3"
#$o2
#[1] "gaussian - o2 ~ p1 + p2 + p3"
Maybe try can be written like below
try <- function(outcomes, predictors) {
as.list(
paste0(
do.call(
paste,
c(data.frame(link, outcomes), sep = " - ")
),
paste0(" ~ ", paste0(predictors, collapse = " + "))
)
)
}
such that
> try(outcome, predictor)
[[1]]
[1] "binomial - o1 ~ p1 + p2 + p3"
[[2]]
[1] "gaussian - o2 ~ p1 + p2 + p3"

R: How to return the exact form of `...` in `fn(...)` without evaluating `...`?

Consider this code
fn = function(...) {
# print the content of ... without evaluation?
}
I want the output of fn(a = b) to be "a = b" and fn(a = gn(b), 3~b~a, dd, e = 2 + f, h = hn(jn(cdf))) to be list("a=gn(b)", "3~b~a", "dd", "e=2+f", "h= hn(jn(cdf)))".
I can't seem to find the right NSE function for it. I prefer Base R so I understand the process better. The closest I got was this
fn = function(...) {
res = rlang::enexprs(...)
paste0(names(res), ifelse(names(res)=="",names(res) , "=") , sapply(res, capture.output))
}
An alternative to match.call (see here) is the undocumented ...().
fn <- function(...) {
x <- substitute(...())
y <- ifelse(nchar(names(x)) > 0, paste(names(x), "=", x), as.character(x))
as.list(y)
}
fn(a = b)
fn(a = gn(b), 3~b~a, dd, e = 2 + f, h = hn(jn(cdf)))
You can use match.call :
fn = function(...) {
temp <- as.list(match.call())[-1]
as.list(sub('^=', '', paste0(names(temp), '=', temp)))
}
fn(a = b)
#[[1]]
#[1] "a=b"
fn(a = gn(b), 3~b~a, dd, e = 2 + f, h = hn(jn(cdf)))
#[[1]]
#[1] "a=gn(b)"
#[[2]]
#[1] "3 ~ b ~ a"
#[[3]]
#[1] "dd"
#[[4]]
#[1] "e=2 + f"
#[[5]]
#[1] "h=hn(jn(cdf))"

R Setter method in class

When I write a setter method in a class, the setter method does not change the value. I just cannot find the error here.
point <- function(x,y){
structure(class = "point", list(
# attributes
x = x,
y = y,
# methods
get_x = function() paste("(", x,",",y,")"),
set_x = function(x,y){ self.x = x; self.y = y}
))}
> p <- point(0,1)
> p$get_x()
[1] "( 0 , 1 )"
> p$set_x(6,5)
> p$get_x()
[1] "( 0 , 1 )"
Try to follow this change to your code.
In function set_x, it is the values of variables x and y created in function point that are assigned new values with <<-, not the x and y that exist in the .GlobalEnv.
point <- function(x, y){
structure(class = "point", list(
x = x,
y = y,
get_x = function() paste("(", x,",",y,")"),
set_x = function(x, y){
x <<- x
y <<- y
}
))
}
x <- 0
y <- 1
p <- point(0,1)
p$get_x()
#[1] "( 0 , 1 )"
p$set_x(6,5)
p$get_x()
#[1] "( 6 , 5 )"
x
#[1] 0
y
#[1] 1

sql query fun calc once for table

Trying to create a function to return data from a database. When used in the table, it works only on the first row.
> library(RODBC)
> f1 <- function(p){return (paste(p, "+", sep=""))}
> f2 <- function(p){
h <- odbcConnect("dsn")
r <- sqlQuery(h, paste("select '", p, "' + '+'", sep=""))
return (r[1])
}
> x <- data.frame(p = c("a", "b"))
> data.frame(x, p2 = f1(x$p))
p p2
1 a a+
2 b b+
> data.frame(p = x$p, p2 = f2(x$p))
p Var.2
1 a a+
2 b a+
Warning message:
In data.frame(p = x$p, p2 = f2(x$p)) :
имена строк взяты из короткой переменной и поэтому сброшены
>
Please give me an explanation of what I am doing wrong.
Thanks
Ilya
I think I need to do something like this:
f2 <- function(p){
# c("a", "b") -->> "('a'), ('b'), (NULL)"
s <- paste(<summary>_paste("('", p, "'),", sep=""), " (NULL)", sep = "")
# ms sql
qry <- paste("select x + '+' as p from values(", s, ")t(x) where x is not NULL", sep = "")
odbcConnect(..)
return(sqlQuery(h, qry))
}

Get arguments from list passed to function inside a function

I want to apply a function over a list of models. I would like to organize the output by having the name of the model precede its output. Here is a (very) simplified example using match.call() based on this r-help thread:
x <- rnorm(10)
y <- rnorm(10)
mod <- lm(y~x)
fun <- function(model){
name <- as.character(match.call()[[2]])
p <- summary(model)$coefficients[2,4]
return(paste(name, "; p =", p))
}
If I feed it a single model, it works fine:
> fun(model=mod)
[1] "mod ; p = 0.901618595026321"
But if I apply it to a list, named or not, it does not work:
> lapply(list(mod, mod), fun)
[[1]]
[1] "[[ ; p = 0.901618595026321" "X ; p = 0.901618595026321"
[3] "i ; p = 0.901618595026321"
[[2]]
[1] "[[ ; p = 0.901618595026321" "X ; p = 0.901618595026321"
[3] "i ; p = 0.901618595026321"
> lapply(list(modA=mod, modB=mod), fun)
$modA
[1] "[[ ; p = 0.901618595026321" "X ; p = 0.901618595026321"
[3] "i ; p = 0.901618595026321"
$modB
[1] "[[ ; p = 0.901618595026321" "X ; p = 0.901618595026321"
[3] "i ; p = 0.901618595026321"
For clarity, what I want is:
[[1]]
[1] "modA ; p = 0.901618595026321"
[[2]]
[1] "modB ; p = 0.901618595026321"
Is there a reason why you don't want to use lapply over the names of the list instead?
fun2 = function(models, name){
model <- models[[name]]
p <- summary(model)$coefficients[2,4]
return(paste(name, "; p =", p))
}
mods = list(modA = mod, modB = mod)
lapply(names(mods), fun2, models = mods)
# [[1]]
# [1] "modA ; p = 0.828746440943558"
# [[2]]
# [1] "modB ; p = 0.828746440943558"
Try this,
mLst <- list(modA=mod, mobB=mod)
p <- lapply(mLst, function(m) summary(m)$coefficients[2,4])
as.list(mapply(function(n,p) paste(n,p, sep=" ; "), names(mLst), p))

Resources