In Wolfram Mathematica, there is function NestList[f,x,n] that produces vector output of length n+1 with multiple application of function f on variable x. See documentation.
Is there something similar in R?
Executing do.call would make the same computations multiple times.
Example (reaction to USER_1's suggestion):
foo <- function(x) {x+1}
map(0, foo)
# [[1]]
# [1] 1
Just write one. Such a function has to loop anyway (rescursion is not advisable if n can get large).
NestList <- function(f, x, n) {
stopifnot(n > 0)
res <- rep(x, n + 1)
if (n == 1L) return(res)
for (i in seq_len(n)) res[i+1] <- f(res[i])
res
}
NestList(function(x) x^2, 2, 5)
#[1] 2 4 16 256 65536 4294967296
Related
I'm trying to convert a while loop to a recursion.
I know the while loop is more efficient, but I'm trying to understand how to convert a for/while loop to recursion, and recursion to a for/while/if loop.
my function as I'm using a while loop:
harmon_sum <- function(x){
n <- 1
sum <- 0
while (sum < x)
{
sum <- sum + (1/n)
n <- (n +1)
}
return(n)
}
This function takes some numeric value, suppose x=2, and returns the number of objects for the harmonic sum that you need to sum up in order to create a greater number then x. (for x=2, you'd need to sum up the first 5 objects of the harmonic sum)
[![harmonic sum][1]][1]
**example**: `harmon_sum <- function(x){
n <- 1
sum <- 0
while (sum < x)
{
sum <- sum + (1/n)
print(sum)
n <- (n +1)
print(n)
}
return(n)
}
> harmon_sum(x =2)
[1] 1
[1] 2
[1] 1.5
[1] 3
[1] 1.833333
[1] 4
[1] 2.083333
[1] 5
[1] 5`
my version for the recursive function:
harmon_sum2 <- function(x, n =1){
if( x<= 0){
return(n-1)
}
else {
x <- (x- (1/(n)))
harmon_sum2(x, n+1)
}
}
which returns me the wrong answer.
I'd rather find a solution with just one variable (x), instead of using two variables (x, n), but I couldn't figure a way to do that.
It seems to me that if you change return(n-1) to return(n) you do get the right results.
harmon_sum2 <- function(x, n=1){
if( x <= 0){
return(n)
}
else {
x <- (x- (1/(n)))
harmon_sum2(x, n+1)
}
}
harmon_sum(2)
[1] 5
harmon_sum2(2)
[1] 5
harmon_sum(4)
[1] 32
harmon_sum2(4)
[1] 32
Your function needs to know n. If you don't want to pass it, you need to store it somewhere where all functions on the call stack can access it. For your specific case you can use sys.nframe instead:
harmon_sum2 <- function(x){
if( x<= 0){
return(sys.nframe())
}
else {
x <- (x- (1/(sys.nframe())))
harmon_sum2(x)
}
}
harmon_sum(8)
#[1] 1675
harmon_sum2(8)
#[1] 1675
However, this doesn't work if you call your function from within another function:
print(harmon_sum2(8))
#[1] 4551
Another alternative is the approach I demonstrate in this answer.
I would like to apply the same function certain number of times on a vector using the output from the function every time.
A simplified example with a simple function just to demonstrate:
# sample vector
a <- c(1,2,3)
# function to be applied n times
f1 <- function(x) {
x^2 + x^3
}
I would like to apply f1 on a, n number of times, for example here lets say 3 times.
I heard purrr::reduce or purrr::map() might be a good idea for this but couldn't make it work.
The desired output if n = 3 would be equal to f1(f1(f1(a))).
Let's use Reduce (no external library requirements, generally good performance). I'll modify the function slightly to accept a second (ignored) argument:
f1 <- function(x, ign) x^2 + x^3
Reduce(f1, 1:3, init = a)
# [1] 1.872000e+03 6.563711e+09 1.102629e+14
Here's what's happening. Reduce:
uses a binary function to successively combine the elements of a given vector and a possibly given initial value.
The first argument is the function to use, and it should accept two arguments. The first is the value from the previous execution of the function in this reduction. On the first call of the function, it uses the init= value provided.
First call:
f1(c(1,2,3), 1)
# [1] 2 12 36
Second call:
f1(c(2,12,36), 2)
# [1] 12 1872 47952
Third call:
f1(c(12,1872,47952), 3)
# [1] 1.872000e+03 6.563711e+09 1.102629e+14
The second argument 1:3 is used just for its length. Anything of the proper length will work.
If you don't want to redefine f1 just for this reduction, you can always do
Reduce(function(a,ign) f1(a), ...)
Benchmark:
library(microbenchmark)
r <- Reduce(function(a,b) call("f1", a), 1:3, init=quote(a))
triple_f1 <- function(a) f1(f1(f1(a)))
microbenchmark::microbenchmark(
base = Reduce(function(a,ign) f1(a), 1:3, a),
accum = a %>% accumulate(~ .x %>% f1, .init = f1(a)) %>% extract2(3),
reduc = purrr::reduce(1:3, function(a,ign) f1(a), .init=a),
whil = {
i <- 1
a <- c(1,2,3)
while (i < 10) {
i <- i + 1
a <- f1(a)
}
},
forloop = {
out <- a
for(i in seq_len(3)) out <- f1(out)
},
evaluated = {
r <- Reduce(function(a,b) call("f1", a), 1:3, init=quote(a))
eval(r)
},
precompiled = eval(r),
anotherfun = triple_f1(a)
)
# Unit: microseconds
# expr min lq mean median uq max neval
# base 5.101 7.3015 18.28691 9.3010 10.8510 848.302 100
# accum 294.201 328.4015 381.21204 356.1520 402.6510 823.602 100
# reduc 27.000 38.1005 57.55694 45.2510 54.2005 747.401 100
# whil 1717.300 1814.3510 1949.03100 1861.8510 1948.9510 2931.001 100
# forloop 1110.001 1167.1010 1369.87696 1205.5010 1292.6500 9935.501 100
# evaluated 6.702 10.2505 22.18598 13.3015 15.5510 715.301 100
# precompiled 2.300 3.2005 4.69090 4.0005 4.5010 26.800 100
# anotherfun 1.400 2.0515 12.85201 2.5010 3.3505 1017.801 100
i <- 1
while (i < 10) {
i <- i + 1
x <- f(x)
}
Here is an option with accumulate
library(tidyverse)
n <- 3
a %>%
accumulate(~ .x %>%
f1, .init = f1(a)) %>%
extract2(n)
#[1] 1.872000e+03 6.563711e+09 1.102629e+14
NOTE: accumulate is similar to the base R option Reduce with accumulate = TRUE
checking with the OP's output
f1(f1(f1(a)))
#[1] 1.872000e+03 6.563711e+09 1.102629e+14
Or use a for loop (no external libraries used)
out <- a
for(i in seq_len(n)) out <- f1(out)
out
#[1] 1.872000e+03 6.563711e+09 1.102629e+14
Here's another way to do it with Reduce:
setting the stage
a <- 1:3
f1 <- function(x) x^2 + x^3
constructing a call and evaluating it
N <- 3 # how many times?
r <- Reduce(function(a,b) call("f1", a), rep(NA, N), init=a)
# f1(f1(f1(1:3)))
eval(r)
# [1] 1.872000e+03 6.563711e+09 1.102629e+14
alternative 2
# N defined as above
Reduce(function(x,y) y(x), replicate(N,f1), init=a)
# [1] 1.872000e+03 6.563711e+09 1.102629e+14
alternative 3 (recursive with a global-like variable)
doit <- function(N) {
i <- 0
function(fun, x){
i <<- i +1
if(i < N) Recall(fun, fun(x)) else fun(x)
}
}
doit(3)(f1, a)
# [1] 1.872000e+03 6.563711e+09 1.102629e+14
... or even
doit <- function(N, fun, x) (function(fun, x)
if((N <<- N - 1) > 0)
Recall(fun, fun(x)) else
fun(x))(fun, x)
doit(3, f1, a)
# [1] 1.872000e+03 6.563711e+09 1.102629e+14
I want to create a function which finds components of a vector which increase continually by k-times.
That is, if the contrived function is f(x,k) and x=c(2,3,4,3,5,6,5,7), then
the value of f(x,1) is 2,3,3,5,5 since only these components of x increase by 1 time.
In addition, if k=2, then the value of f(x,2) is 2,3 since only these components increase continually by 2 times.(2→3→4 and 3→5→6)
I guess that I ought to use repetitive syntax like for for this purpose.
1) Use rollapply from the zoo package:
library(zoo)
f <- function(x, k)
x[rollapply(x, k+1, function(x) all(diff(x) > 0), align = "left", fill = FALSE)]
Now test out f:
x <- c(2,3,4,3,5,6,5,7)
f(x, 1)
## [1] 2 3 3 5 5
f(x, 2)
## [1] 2 3
f(x, 3)
## numeric(0)
1a) This variation is slightly shorter and also works:
f2 <- function(x, k) head(x, -k)[ rollapply(diff(x) > 0, k, all) ]
2) Here is a version of 1a that uses no packages:
f3 <- function(x, k) head(x, -k)[ apply(embed(diff(x) > 0, k), 1, all) ]
A fully vectorized solution:
f <- function(x, k = 1) {
rlecumsum = function(x)
{ #cumsum with resetting
#http://stackoverflow.com/a/32524260/1412059
cs = cumsum(x)
cs - cummax((x == 0) * cs)
}
x[rev(rlecumsum(rev(c(diff(x) > 0, FALSE) ))) >= k]
}
f(x, 1)
#[1] 2 3 3 5 5
f(x, 2)
#[1] 2 3
f(x, 3)
#numeric(0)
I don't quite understand the second part of your question (that with k=2) but for the first part you can use something like this:
test<-c(2,3,4,3,5,6,5,7) #Your vector
diff(test) #Differentiates the vector
diff(test)>0 #Turns the vector in a logical vector with criterion >0
test[diff(test)>0] #Returns only the elements of test that correspond to a TRUE value in the previous line
I would like to get a feel of functional programming in R.
To that effect, I would like to write the vandermonde matrix computation, as it can involve a few constructs.
In imperative style that would be :
vandermonde.direct <- function (alpha, n)
{
if (!is.vector(alpha)) stop("argument alpha is not a vector")
if (!is.numeric(alpha)) stop("argument n is not a numeric vector")
m <- length(alpha)
V <- matrix(0, nrow = m, ncol = n)
V[, 1] <- rep(1, m)
j <- 2
while (j <= n) {
V[, j] <- alpha^(j - 1)
j <- j + 1
}
return(V)
}
How would you write that elegantly in R in functional style ?
The following does not work :
x10 <- runif(10)
n <- 3
Reduce(cbind, aaply(seq_len(n-1),1, function (i) { function (x) {x**i}}), matrix(1,length(x10),1))
As it tells me Error: Results must have one or more dimensions. for list of function which go from i in seq_len(3-1) to the function x -> x**i.
It does not seem very natural to use Reduce for this task.
The error message is caused by aaply, which tries to return an array:
you can use alply instead; you also need to call your functions, somewhere.
Here are a few idiomatic alternatives:
outer( x10, 0:n, `^` )
t(sapply( x10, function(u) u^(0:n) ))
sapply( 0:3, function(k) x10^k )
Here it is with Reduce:
m <- as.data.frame(Reduce(f=function(left, right) left * x10,
x=1:(n-1), init=rep(1,length(x10)), accumulate=TRUE))
names(m) <- 1:n - 1
Here's another option, that uses the environment features of R:
vdm <- function(a)
{
function(i, j) a[i]^(j-1)
}
This will work for arbitrary n (the number of columns).
To create the "Vandermonde functional" for a given a, use this:
v <- vdm(a=c(10,100))
To build a matrix all at once, use this:
> outer(1:3, 1:4, v)
[,1] [,2] [,3] [,4]
[1,] 1 10 100 1e+03
[2,] 1 100 10000 1e+06
[3,] 1 NA NA NA
Note that index a[3] is out of bounds, thus returning NA (except for the first column, which is 1).
I am wondering about the simple task of splitting a vector into two at a certain index:
splitAt <- function(x, pos){
list(x[1:pos-1], x[pos:length(x)])
}
a <- c(1, 2, 2, 3)
> splitAt(a, 4)
[[1]]
[1] 1 2 2
[[2]]
[1] 3
My question: There must be some existing function for this, but I can't find it? Is maybe split a possibility? My naive implementation also does not work if pos=0 or pos>length(a).
An improvement would be:
splitAt <- function(x, pos) unname(split(x, cumsum(seq_along(x) %in% pos)))
which can now take a vector of positions:
splitAt(a, c(2, 4))
# [[1]]
# [1] 1
#
# [[2]]
# [1] 2 2
#
# [[3]]
# [1] 3
And it does behave properly (subjective) if pos <= 0 or pos >= length(x) in the sense that it returns the whole original vector in a single list item. If you'd like it to error out instead, use stopifnot at the top of the function.
I tried to use flodel's answer, but it was too slow in my case with a very large x (and the function has to be called repeatedly). So I created the following function that is much faster, but also very ugly and doesn't behave properly. In particular, it doesn't check anything and will return buggy results at least for pos >= length(x) or pos <= 0 (you can add those checks yourself if you're unsure about your inputs and not too concerned about speed), and perhaps some other cases as well, so be careful.
splitAt2 <- function(x, pos) {
out <- list()
pos2 <- c(1, pos, length(x)+1)
for (i in seq_along(pos2[-1])) {
out[[i]] <- x[pos2[i]:(pos2[i+1]-1)]
}
return(out)
}
However, splitAt2 runs about 20 times faster with an x of length 106:
library(microbenchmark)
W <- rnorm(1e6)
splits <- cumsum(rep(1e5, 9))
tm <- microbenchmark(
splitAt(W, splits),
splitAt2(W, splits),
times=10)
tm
Another alternative that might be faster and/or more readable/elegant than flodel's solution:
splitAt <- function(x, pos) {
unname(split(x, findInterval(x, pos)))
}