I need to calculate a derivative, say f = x^2. I am using the code
D(expression(x^2), 'x')
How do I use the output of D(x^2) = 2x as a function that will take values?
k<-deriv(~ x^2, "x")
x <- -1:10
eval(k)
Here is a way to convert the results to a function:
> myfun <- function(x) {}
> body(myfun) <- D( expression(x^2), 'x' )
>
> myfun( 1:10 )
[1] 2 4 6 8 10 12 14 16 18 20
Related
I am working on a complicated project, and each time I need to run my function using the result of the previous run of the function. To make my point clearer, suppose that I have a vector x, and a function myfunc. Then, I need to run myfunc using the vector x. Then, I take the output of my function and plug them again as an argument of the same function. I need to repeat this automatically several times.
For example,
x <- c(1,2,3)
myfunc <- function(x){
res <- 2*x
return(res)
}
Then,
x <- myfunc(x)
> x
[1] 2 4 6
x <- myfunc(x)
> x
[1] 4 8 12
How can I do this automatically (repeat for, say, 5 times)? In the end, I need the result of the final run only. For example, the result of the fifth run.
x <- c(1,2,3)
for (i in 1:5) {
x = myfunc(x);
}
outputs [1] 32 64 96, as does myfunc(myfunc(myfunc(myfunc(myfunc(x))))).
Just keep reassigning in a loop?
A good way to do so would be to include an argument repeats in your function itself.
myfunc <- function(x, repeats=1){
res <- x
for(i in 1:repeats) {
res <- 2*res
}
return(res)
}
> myfunc(x, 5)
[1] 32 64 96
Here's a one liner. Recall allows for recursive calling based on a condition. Here I assume whatever happens in the expression in my_fun is vectorized, as * is. If it is not, wrap the function in Vectorize.
f <- function(n, rep) if(rep) Recall(n * 2, rep - 1) else n
f(1:3, 5)
[1] 32 64 96
Here is another option with reduce
library(purrr)
reduce(1:5, ~ .x *2, .init = x)
[1] 32 64 96
You can use:
x <- c(1,2,3)
myfunc <- function(x){
res <- 2*x
x <<- res
return(res)
}
The double assign operator makes sure that your initial x gets overwritten in each function call.
Here‘s the result for 5 runs:
replicate(5, myfunc(x))
[,1] [,2] [,3] [,4] [,5]
[1,] 2 4 8 16 32
[2,] 4 8 16 32 64
[3,] 6 12 24 48 96
Im trying to write a function based on the Luhn algorithm (mod 10 algorithm), and I need a function that sums all integers > 9 in my number vector individually. E.g. 10 should sum to 1+0=1, and 19 should sum to 1+9=10. Example code:
nmr <- ("1_9_8_2_0_5_0_1_3_3_4_8")
nmr <- strsplit(nmr, "_")
nmr <- as.numeric(as.character(unlist(nmr[[1]])))
luhn_alg <- c(0,0,2,1,2,1,2,1,2,1,2,0)
x <- nmr*luhn_alg
x
[1] 0 0 16 2 0 5 0 1 6 3 8 0
sum(x)
[1] 41
I dont want the sum of x to equal 41. Instead I want the sum to equal: 0+0+1+6+2+0+5+0+1+6+3+8+0=32. I tried with a for loop but doesn't seem to get it right. Any help is much appreciated.
You may need to split the data again after multiplying it with luhn_alg.
Luhn_sum <- function(x, y) {
nmr <- as.numeric(unlist(strsplit(x, "_")))
x1 <- nmr*y
x1 <- as.numeric(unlist(strsplit(as.character(x1), '')))
sum(x1)
}
nmr <- ("1_9_8_2_0_5_0_1_3_3_4_8")
luhn_alg <- c(0,0,2,1,2,1,2,1,2,1,2,0)
Luhn_sum(nmr, luhn_alg)
#[1] 32
You can use substring and seq to create a vector of single digit numbers, then you only need to do a sum over them:
sum(
as.numeric(
substring(
paste(x, collapse = ""),
seq(1, sum(nchar(x)), 1),
seq(1, sum(nchar(x)), 1)
)
)
)
This is my function:
g <- function(x,y){
x <- (x-y):x
y <- 1:30 # ------> (y is always fixed 1:30)
z<- outer(x,y,fv) # ---->(fv is a previous function)
s <- colSums(z)
which(s==max(s),arr.ind=T)
}
It tells me the position of the max value in s. I basically have a problem in choosing y because given a small y, the max(s) appears more than once in s. For example:
#given x=53
> g(53,1)
[1] 13 16 20 22 25 26 27
> g(53,2)
[1] 20 25 26
> g(53,3)
[1] 20 25 26
> g(53,4)
[1] 20 25 26
> g(53,5)
[1] 20 25
> g(53,6)
[1] 25 -----> This is the only result i would like from my function (right y=6)
Another example:
# given x=71
> g(71,1)
[1] 7 9 14
> g(71,2)
[1] 7 14
> g(71,3)
[1] 14 -----> my desired result (right y=3)
Therefore, i would like a function resulting in the first unique solution given y as small as possible ( ex: g(53)=25 , g(71)=14, ...). Any help? Thanks
This is a simplify example. I hope to be more clear in questioning:
#The idea is the same:
n <- 1:9
e <- rep(nn,500)
p<- sample(e) # --->(Need to sample in order to have more max later (mixed matrix)
mat <- matrix(p,90)
g <- function(x,y){
x <- (x-y):x
k <- rowSums(mat[,x])
which(k==max(k), arr.ind=T)
}
#In my sample matrix :
k <- rowSums(mat[,44:45])
which(k==max(k), arr.ind=T)
[1] 44 71 90
#In fact
g(45,1)
[1] 44 71 90 # ---> more than one solution
g(45,2)
[1] 90 # ----> I would like to pick up this value wich is the first unique solution given x=45
Therefore, i would like a function resulting in the first unique solution for y as small as possible given x ( in this new ex: g(45)=90... ).
I got it. It is a bit long but i think right.
Taking into consideration the second simplify example:
g <- function(x,y){
x <- (x-y):x
k <- rowSums(mat[,x])
q <- which(k==max(k), arr.ind=T)
length(q)
}
gv <- Vectorize(g)
l <- function(x){
y<- 1:30 # <- (until 30 to be sure)
z<- outer(x,y,gv)
y <- which.min(z) # <- (min is surely length=1 and which.min takes the first)
x <- (x-y):x
k <- rowSums(mat[,x])
q <- which(k==max(k), arr.ind=T)
q
}
l(45)
[1] 90
It seems like you could just do this with a recursive function. Consider the following:
set.seed(42)
n = 1:9
e = rep(n, 500)
p = sample(e)
mat = matrix(p, 90)
g <- function(x, y=1) {
xv <- (x-y):x
k <- rowSums(mat[, xv])
i <- which(k == max(k), arr.ind=T)
n <- length(i)
if (n == 1) {
return(y) # want to know the min y that solves the problem, right?
} else {
y <- y + 1 # increase y by 1
g(x,y) # run our function again with a new value of y
}
}
You should now be able to run g(45) and get 1 as the result, since that is the value of y that solves the problem, and g(33) to get 2.
Here are two examples using sapply, the first example works but the second example produces NA when x is large numbers. Can anyone help?
This works
x = 1:10
y = 5:15
sapply(x, function (i) min(abs(x[i]-y)))
But this does not work
x = 100000:100010
y = 5:15
sapply(x, function (i) min(abs(x[i]-y)))
The argument in the inline function in sapply is what each value of the first argument is inserted into, so in your case x[i] is not using i from 1 to 10 or whatever, but i from x[1] to x[end].
sapply(x,function(i) min(abs(i-y)))
That's what you're trying to do (take each element of x and subtract y from).
> x = 100000:100010
> y=5:15
> sapply(x,function(i) min(abs(i-y)))
# [1] 99985 99986 99987 99988 99989 99990 99991 99992 99993 99994 99995
When using i as you are using it, you'll need use a sequence in the X argument of sapply.
It's just like using i in a for loop
> x <- 1:10
> y <- 5:15
> sapply(seq_along(x), function(i) min(abs(x[i] - y)))
# [1] 4 3 2 1 0 0 0 0 0 0
> x <- 100000:100010
> y <- 5:15
> sapply(seq_along(x), function(i) min(abs(x[i] - y)))
# [1] 99985 99986 99987 99988 99989 99990 99991 99992 99993 99994 99995
I am trying to sum the functions in a list to create a new function. This is easy for a small number of functions. Here is an example:
f <- function(x){x}
g <- function(x){x+1}
Now we sum f and g.
fg <- function(x){f(x) + g(x)}
But if I have 100 functions that I want to sum, this method becomes clumsy. Is there a way to create a function like fg above automatically from a list?
I prefer Reduce:
f <- function(x){x}
g <- function(x){x+1}
h <- function(x){x*2}
funs<-list(f,g,h)
x <- 1:3
Reduce("+", lapply(funs, function(f, y) f(y), y=x))
#[1] 5 9 13
Of course, the return values of all functions must have the same length.
You could use sapply to loop over the functions and apply then
f <- function(x){x}
g <- function(x){x+1}
h <- function(x){x*2}
funs<-list(f,g,h)
x <- 2
rowSums(matrix(sapply(funs, function(f, z) f(z), z=x), nrow=length(x)))
# [1] 9
I use the matrix and rowSums functions just in case you want to be able to call it when x is a vector of values as well
x <- 1:3
rowSums(matrix(sapply(funs, function(f, z) f(z), z=x), nrow=length(x)))
# [1] 5 9 13
You can make it cleaner by making a helper function
getfunsum <- function(funs) {
force(funs)
function(x) {
rowSums(matrix(sapply(funs, function(f, z) f(z), z=x), nrow=length(x)))
}
}
fgh <- getfunsum(funs)
fgh(1:3)
# [1] 5 9 13
You may try:
fun1 <- function(i,a) {
eval(substitute(function(x, a) {x+i*a}, list(i=i)))}
n <- 0:3
lst <- lapply(n, fun1)
rowSums(sapply(lst, function(f) f(12:14, 3)))
#[1] 66 70 74