So, I'm trying to write a function that builds a large complicated formula recursively. Basically, what I would love to work simply, is the following:
f <- function(x) {
g <- function(y) y
for( i in 1:4 ) {
h <- g
g <- function(y) h(y)^2
}
g(x)
}
Please refrain from laughing at this insane motivation. Now what I would like to get, is a function that returns ((((x^2)^2)^2)^2), but what actually happens is that my runtime just crashes immediately, probably because there's some sort of call to an unreferenced function or something, since I'm overwriting the expression for g every time (obviously I don't really know how r works in this scenario).
How can I achieve this idea of retaining the information from the older g references?
1) Recursion We can use recursion like this:
h1 <- function(f, n) if (n == 1) f else function(x) f(h1(f, n-1)(x))
# test using g from questioun
h1(g, 4)(3)
## [1] 43046721
(((3^2)^2)^2)^2
## [1] 43046721
2) Reduce This uses Reduce to compose a function f with itself iteratively n times.
h2 <- function(f, n) function(y) Reduce(function(x, f) f(x), rep(list(f), n), y)
h2(g, 4)(3)
## [1] 43046721
3) for
h3 <- function(f, n) {
function(x) {
for(i in 1:n) x <- f(x)
x
}
}
h3(g, 4)(3)
## [1] 43046721
4) Fixed If there are a small fixed number we could just write it out
explicitly:
h4 <- function(x) g(g(g(g(x))))
h4(3)
## [1] 43046721
5) Compose We could slightly simplify any of the above using Compose from the functional package. (The purrr package also has a compose function. Use that if you are already using purrr; otherwise, functional has a smaller footprint.)
library(functional)
h1a <- function(f, n) if (n == 1) f else Compose(f, h(f, n-1))
h2a <- function(f, n) Reduce(Compose, rep(list(f), n))
h2b <- function(f, n) do.call(Compose, rep(list(f), n))
h3a <- function(f, n) {
for(i in 1:n) ff <- if (i == 1) f else Compose(ff, f)
ff
}
h4a <- Compose(g, g, g, g)
Related
I have a function f(x,y) where both the inputs are integers. Given a natural number K, I would like to evaluate f at all points in the set { (x,y) : 0 <= x <= K-1 , x < y <= K }. In other words, evaluating f at all feasible 0 <=x,y <= K which satisfy y>x.
I know this can be done with nested for loops but I am wondering if there is a more efficient way to do it through one of the apply functions perhaps.
Here is one way of doing what the question asks for. It's a simple double *apply loop with a function call in the inner most loop.
f <- function(x, y) {x + y + x*y}
K <- 10
sapply(0:(K - 1), function(x){
sapply((x + 1):K, function(y) f(x, y))
})
This is easily rewritten as a function of K and f.
fun <- function(K, FUN){
f <- match.fun(FUN)
lapply(0:(K - 1), function(x){
sapply((x + 1):K, function(y) f(x, y))
})
}
fun(10, f)
Suppose I have a variable x and a function f. I would like to perform f on x, then again on the result, n times.
I have built a simple function for this:
iterate <- function(x, f, n) {
assertthat::assert_that(n >= 0)
if (n > 0) {
for (i in 1:n) {
x <- f(x)
}
}
x
}
Which works as follows:
iterate(256, f = sqrt, n = 3)
Is this already built into R?
You can do this with a functional programming approach, with Reduce and Compose from functional package. The idea is to create the list of function you want and chain them using Compose. You simply apply this function to x afterwards.
x = 256
n = 3
f = sqrt
library(functional)
Reduce(Compose, replicate(n, f))(x)
#[1] 2
Or use freduce from magrittr:
library(magrittr)
freduce(x, replicate(n, f))
#[1] 2
The problem with my R script is that it takes too much time and the main solution that I consider is to parallelize it. I don't know where to start.
My code look like this:
n<- nrow (aa)
output <- matrix (0, n, n)
akl<- function (dii){
ddi<- as.matrix (dii)
m<- rowMeans(ddi)
M<- mean(ddi)
r<- sweep (ddi, 1, m)
b<- sweep (r, 2, m)
return (b + M)
}
for (i in 1:n)
{
A<- akl(dist(aa[i,]))
dVarX <- sqrt(mean (A * A))
for (j in i:n)
{
B<- akl(dist(aa[j,]))
V <- sqrt (dVarX * (sqrt(mean(B * B))))
output[i,j] <- (sqrt(mean(A * B))) / V
}
}
I would like to parallelize on different cpus. How can I do that?
I saw the SNOW package, is it suitable for my purpose?
Thank you for suggestions,
Gab
There are two ways in which your code could be made to run faster that I could think of:
First: As #Dwin was saying (with a small twist), you could precompute akl (yes, not necesarily dist, but the whole of akl).
# a random square matrix
aa <- matrix(runif(100), ncol=10)
n <- nrow(aa)
output <- matrix (0, n, n)
akl <- function(dii) {
ddi <- as.matrix(dii)
m <- rowMeans(ddi)
M <- mean(m) # mean(ddi) == mean(m)
r <- sweep(ddi, 1, m)
b <- sweep(r, 2, m)
return(b + M)
}
# precompute akl here
require(plyr)
akl.list <- llply(1:nrow(aa), function(i) {
akl(dist(aa[i, ]))
})
# Now, apply your function, but index the list instead of computing everytime
for (i in 1:n) {
A <- akl.list[[i]]
dVarX <- sqrt(mean(A * A))
for (j in i:n) {
B <- akl.list[[j]]
V <- sqrt (dVarX * (sqrt(mean(B * B))))
output[i,j] <- (sqrt(mean(A * B))) / V
}
}
This should already get your code to run faster than before (as you compute akl everytime in the inner loop) on larger matrices.
Second: In addition to that, you can get it faster by parallelising as follows:
# now, the parallelisation you require can be achieved as follows
# with the help of `plyr` and `doMC`.
# First step of parallelisation is to compute akl in parallel
require(plyr)
require(doMC)
registerDoMC(10) # 10 Cores/CPUs
akl.list <- llply(1:nrow(aa), function(i) {
akl(dist(aa[i, ]))
}, .parallel = TRUE)
# then, you could write your for-loop using plyr again as follows
output <- laply(1:n, function(i) {
A <- akl.list[[i]]
dVarX <- sqrt(mean(A * A))
t <- laply(i:n, function(j) {
B <- akl.list[[j]]
V <- sqrt(dVarX * (sqrt(mean(B*B))))
sqrt(mean(A * B))/V
})
c(rep(0, n-length(t)), t)
}, .parallel = TRUE)
Note that I have added .parallel = TRUE only on the outer loop. This is because, you assign 10 processors to the outer loop. Now, if you add it to both outer and inner loops, then the total number of processers will be 10 * 10 = 100. Please take care of this.
In Lambda calculus, Y -combinator returns itself like this Y a = a Y a, specifially here. Suppose some trivial function such as y(x)=2*x+1 (suppose Church numbers for the sake of simplicity) and I want to do it Y y to which I want some sort of break-out -function. I want to do something like this
calculate y(1) --->3
calculate y(3) --->7
calculate y(7) ...
...
terminate on the n-th case
How can I do this in R using the functional way of thinking? Is there something built-in?
I don't really understand the notation of the lambda calculus, so can't know for sure what the Y-combinator is, but I wonder if the R function Recall() (help page here) wouldn't help you build what you're after. Here is an example of its use to calculate a factorial:
# Calculate 4!
(function(n) {if (n<=1) 1 else n*Recall(n-1)})(4)
And here it is applied to the example you described:
(function(x, n) {if (n<=1) x else Recall(2*x+1, n-1)})(x=1, n=1)
# [1] 1
(function(x, n) {if (n<=1) x else Recall(2*x+1, n-1)})(x=1, n=2)
# [1] 3
(function(x, n) {if (n<=1) x else Recall(2*x+1, n-1)})(x=1, n=3)
# [1] 7
Try this:
myfun = function(x) { 2*x+1 }
N = 10; seed = 3; i = 1
for(i in 1:N){
seed = Y = myfun(seed)
print(Y)
}
If you just want a function, g, that transforms a function f
into function(x) f(f(f(f(...f(x))))) (n times, with n not known in advance),
the following should do.
compose_with_itself_n_times <- function(f,n) {
function(x) {
for(i in seq_len(n)) {
x <- f(x)
}
x
}
}
f <- function(x) 2*x+1
g <- compose_with_itself_n_times(f,10)
g(1)
I want to apply a function to progressive subsets of a vector in R. I have looked at what i could find, and the apply and friends aren't quite there, and rollapply does not work on straight vectors, only zoo/ts objects.
vapply <- function(x, n, FUN=sd) {
v <- c(rep(NA, length(x)))
for (i in n:length(x) ) {
v[i] <- FUN(x[(i-n+1):i])
}
return(v)
}
Is there something built in that is equivalent? Is there a better way to do it? I am trying to avoid dependencies on 3rd party libraries as I the code needs to be standalone for distribution.
With your choice of function name, I just HAD to make a version that actually uses vapply internally :)
...it turns out to be about 50% faster in the example below. But that of course depends a lot on how much work is done in FUN...
# Your original version - renamed...
slideapply.org <- function(x, n, FUN=sd) {
v <- c(rep(NA, length(x)))
for (i in n:length(x) ) {
v[i] <- FUN(x[(i-n+1):i])
}
return(v)
}
slideapply <- function(x, n, FUN=sd, result=numeric(1)) {
stopifnot(length(x) >= n)
FUN <- match.fun(FUN)
nm1 <- n-1L
y <- vapply(n:length(x), function(i) FUN(x[(i-nm1):i]), result)
c(rep(NA, nm1), y) # Why do you want NA in the first entries?
}
x <- 1:2e5+0 # A double vector...
system.time( a <- slideapply.org(x, 50, sum) ) # 1.25 seconds
system.time( b <- slideapply(x, 50, sum) ) # 0.80 seconds
identical(a, b) # TRUE