Related
I'm struggling to work out how to code this sum in R; I'm guessing we can use a for loop somehow but can't get my head around it.
The equation I am trying to code is:
n-\sum_{k=0}^{n-1}choose(n-1,k)beta_kexp(kLn-k) for n=1,2,..
where:
beta_k is a vector I already have
L is a constant.
I've coded this manually but would like to put it into some kind of for loop.
mu3<-3-choose(2,1)*beta1*exp(-1*lambdaL*(3-1))-choose(2,2)*beta2*exp(-2*lambdaL*(3-2))
mu4<-4-choose(3,1)*beta1*exp(-1*lambdaL*(4-1))-choose(3,2)*beta2*exp(-2*lambdaL*(4-2))-choose(3,3)*beta3*exp(-3*lambdaL*(4-3))
mu5<-5-choose(4,1)*beta1*exp(-1*lambdaL*(5-1))-choose(4,2)*beta2*exp(-2*lambdaL*(5-2))-choose(4,3)*beta3*exp(-3*lambdaL*(5-3))-choose(4,4)*beta4*exp(-4*lambdaL*(5-4))
etc
lambdaL<-0.5
This is my list of beta's
betarec(10,0.5)
[1] 0.0000000 1.0000000 0.7869387 1.0278660 1.5510843 2.3702034 3.4694342
4.7718938
[9] 6.1685468 7.5667952 8.9154479
Thank you!
Consider a nested apply call with mapply iteratively passing n and k args to an embedded sapply to loop through all successive betas from 1 to current k and iteratively sum the results.
Input
lambdaL <- 0.5
beta <- c(0.0000000,1.0000000,0.7869387,1.0278660,1.5510843,2.3702034,
3.4694342,4.7718938,6.1685468,7.5667952,8.9154479)
Current version
mu3<-3-choose(2,1)*beta[1]*exp(-1*lambdaL*(3-1))-choose(2,2)*beta[2]*exp(-2*lambdaL*(3-2))
mu3
# [1] 2.632121
mu4<-4-choose(3,1)*beta[1]*exp(-1*lambdaL*(4-1))-choose(3,2)*beta[2]*exp(-2*lambdaL*(4-2))-choose(3,3)*beta[3]*exp(-3*lambdaL*(4-3))
mu4
# [1] 3.418404
mu5<-5-choose(4,1)*beta[1]*exp(-1*lambdaL*(5-1))-choose(4,2)*beta[2]*exp(-2*lambdaL*(5-2))-choose(4,3)*beta[3]*exp(-3*lambdaL*(5-3))-choose(4,4)*beta[4]*exp(-4*lambdaL*(5-4))
mu5
# [1] 4.405454
Loop version (output equivalent to previous version)
mu_formula <- function(n,k) {
n + sum(sapply(seq(k), function(i)
-choose((n-1),i)*beta[i]*exp(-i*lambdaL*(n-i))))
}
mu_vector <- setNames(mapply(mu_formula, 3:5, 2:4), paste0("mu", 3:5))
mu_vector
# mu3 mu4 mu5
# 2.632121 3.418404 4.405454
mu_list <- setNames(Map(mu_formula, 3:5, 2:4),paste0("mu", 3:5))
mu_list
# $mu3
# [1] 2.632121
# $mu4
# [1] 3.418404
# $mu5
# [1] 4.405454
Generalized Loop (for all betas)
mu_list <- setNames(Map(mu_formula,seq_along(beta)[-1]+1,seq_along(beta)[-1]),
paste0("mu",seq_along(beta)[-1]+1))
mu_list
# $mu3
# [1] 2.632121
# $mu4
# [1] 3.418404
# $mu5
# [1] 4.405454
# $mu6
# [1] 5.507972
# $mu7
# [1] 6.640989
# $mu8
# [1] 7.756735
# $mu9
# [1] 8.840919
# $mu10
# [1] 9.896983
# $mu11
# [1] 10.93315
# $mu12
# [1] 11.95646
I tried to create a repeat loop function based on logical case as follow:
n=5 # number of element in lambda
t=10 # limit state
lambda=c(runif(n,2,4)) #vector to be tested
tes=function(x)
{
if(x>=t) {a=0;b=0;c=0}
else
{
repeat
{
a=runif(1,0.5,0.8)
b=runif(1, 5, 8)
c=x+a+b
print(a)
print(b)
if (c>=t) {break}
}
}
return(list(a,b,c))
}
I need to save all of the repeat loop iterations output into an object in the workspace to be used afterwards. however my function only save the latest value of the iterations.
here's the example of iteration for lambda[1]:
The iteration:
[1] 0.6714837
[1] 5.840948
[1] 0.7914275
[1] 7.264076
The saved result in the list:
[[1]]
[[1]][[1]]
[1] 0.7914275
[[1]][[2]]
[1] 7.264076
[[1]][[3]]
[1] 11.03819
how to save each of the result per iterations in the output list?
I’ve looked through other thread, but I haven’t found a suitable solution for my case yet. Thank you.
You can accumulate the results onto a data.frame.
I would also recommend you not assign identifiers like c and t, since those are built-in functions which can be masked by locals, especially if you're passing around functions as arguments, such as do.call(c,...).
I also suggest that it's probably appropriate to pass the limit state variable as another argument to the function.
tes <- function(x,lim) {
res <- data.frame(a=double(),b=double(),c=double());
if (x >= lim) {
res[1L,] <- c(0,0,0);
} else {
i <- 1L;
repeat {
ta <- runif(1L,0.5,0.8);
tb <- runif(1L,5,8);
tc <- x+ta+tb;
res[i,] <- c(ta,tb,tc);
print(ta);
print(tb);
if (tc >= lim) break;
i <- i+1L;
};
};
return(res);
};
Demo:
set.seed(5L);
n <- 5L; ## number of elements in lambda
lambda <- runif(n,2,4); ## vector to be tested
lambda;
## [1] 2.400429 3.370437 3.833752 2.568799 2.209300
res <- lapply(lambda,tes,10);
## [1] 0.7103172
## [1] 6.58388
## [1] 0.7423806
## [1] 7.8695
## [1] 0.5331359
## [1] 5.819855
## [1] 0.647154
## [1] 5.955212
## [1] 0.6677518
## [1] 5.787779
## [1] 0.5605626
## [1] 6.162577
## [1] 0.7663609
## [1] 6.664768
## [1] 0.7526538
## [1] 7.670621
## [1] 0.7162103
## [1] 5.634021
## [1] 0.5677152
## [1] 5.419951
## [1] 0.6439742
## [1] 6.312236
## [1] 0.7897892
## [1] 5.425742
## [1] 0.7864937
## [1] 6.334192
## [1] 0.5178087
## [1] 5.825448
## [1] 0.5093445
## [1] 5.043447
## [1] 0.6461507
## [1] 6.785455
## [1] 0.6793559
## [1] 6.193042
## [1] 0.6190491
## [1] 7.448228
res;
## [[1]]
## a b c
## 1 0.7103172 6.58388 9.694626
## 2 0.7423806 7.86950 11.012310
##
## [[2]]
## a b c
## 1 0.5331359 5.819855 9.723428
## 2 0.6471540 5.955212 9.972803
## 3 0.6677518 5.787779 9.825968
## 4 0.5605626 6.162577 10.093577
##
## [[3]]
## a b c
## 1 0.7663609 6.664768 11.26488
##
## [[4]]
## a b c
## 1 0.7526538 7.670621 10.99207
##
## [[5]]
## a b c
## 1 0.7162103 5.634021 8.559531
## 2 0.5677152 5.419951 8.196967
## 3 0.6439742 6.312236 9.165510
## 4 0.7897892 5.425742 8.424831
## 5 0.7864937 6.334192 9.329986
## 6 0.5178087 5.825448 8.552557
## 7 0.5093445 5.043447 7.762092
## 8 0.6461507 6.785455 9.640906
## 9 0.6793559 6.193042 9.081698
## 10 0.6190491 7.448228 10.276578
You can save the intermediate results in a list, then return it (loop_results). See below. I have also formatted a bit your code so that, intermediate results are printed in a more intelligible/compact way, and the returned list is named.
tes <- function(x) {
if(x>=t) {
a=0;b=0;c=0
} else {
loop_results <- list()
i=0
repeat
{
i <- i+1
a=runif(1,0.5,0.8)
b=runif(1, 5, 8)
c=x+a+b
cat("iteration ", i, "a: ", a, "b: ", b, "\n")
loop_results[[i]] <- list(a=a, b=b, c=c)
if (c>=t) {break}
}
}
return(list(a=a, b=b, c=c, loop_results=loop_results))
}
I took the liberty to add an argument in the function and a "maximum iteration" argument coupled with a warning. i think the optimal result form is the data frame for vectors a, b, and c.
Then, to apply it on a vector, I propose to use an lapply function.
n <- 5 # number of element in lambda
limitstate <- 10 # limit state
lambda <- c(runif(n,2,4)) #vector to be tested
tes <- function(x, t, maxiter = 1000) {
if( x >= t) {
return(data.frame(a=0, b=0, c=0))
} else {
iter <- 1
a <- c()
b <- c()
c <- c()
repeat {
a[iter] <- runif(1, 0.5, 0.8)
b[iter] <- runif(1, 5, 8)
c[iter] <- x + a[iter] + b[iter]
if (c[iter] >= t) break
iter <- iter+1
if (iter >= maxiter) {
warning("Maximum iteration reached")
break
}
}
}
return(data.frame(a=a,b=b,c=c))
}
tes(2, 10)
lapply(lambda, tes, t=limitstate)
A similar problem is faced in this question, that I hope you find useful. So, you should insert a cumulative function inside of your's, as in the following example. It simulate a game where, in case of victory you earn money, otherwise you will lose it. This procedure stores your savings fluctuations during all the process.
x <- y <- 10
while (x > 0) {
if (rbinom(1, 1, 0.5) == 1) {
x <- x + 10
} else {
x <- x - 1
}
y <- c(y, x)
}
Otherwise, if your problem goes on a superior dimensional level, you could try a vectorized approach, which is much faster. But for your problem the approach exposed should be fine.
Suppose x is a vector, and myfunc is a function of two arguments. I wish to get a vector of the results of myfunc on subsequent pairs of elements from x. By definition, that vector should be of length 1 less than x's length.
For example, if x <- 1:4 and
myfunc <- function(a,b) {
return(log(b/a))
}
Then I would expect
> apply_on_pairs(x, myfunc)
[1] 0.6931472 0.4054651 0.2876821
(which is equivalent to c(myfunc(1,2), myfunc(2,3), myfunc(3,4)))
mapply(myfunc,x[-length(x)],x[-1])
# [1] 0.6931472 0.4054651 0.2876821
mapply(...) "applies" the function in the first argument to the subsequent arguments, in this case we pass x[1:3] and x[2:4] as the second the third arguments to mapply(...).
library(zoo)
x <- 1:4
rollapply(x, width=2, FUN=function(x) return(log(x[2]/x[1])))
## [1] 0.6931472 0.4054651 0.2876821
In this case you can diff() the log() of your vector.
x <- 1:4
diff(log(x))
Yields:
> diff(log(x))
[1] 0.6931472 0.4054651 0.2876821
Update: I more general solution uses head() and tail() to remove the last and first elements. You want to do your best to stick to vectorized solutions, which should be faster and more memory efficient.
myFun <- function(x) log(tail(x, -1)) - log(head(x, -1))
There's a slight speed edge to diff().
> x <- seq(1e8)
> system.time(A <- diff(log(x)))
user system elapsed
8.42 1.28 9.90
> myFun <- function(x) log(tail(x, -1)) - log(head(x, -1))
> system.time(B <- myFun(x))
user system elapsed
9.29 1.40 10.78
> all.equal(A, B)
[1] TRUE
I'm trying to learn R and I can't figure out how to append to a list.
If this were Python I would . . .
#Python
vector = []
values = ['a','b','c','d','e','f','g']
for i in range(0,len(values)):
vector.append(values[i])
How do you do this in R?
#R Programming
> vector = c()
> values = c('a','b','c','d','e','f','g')
> for (i in 1:length(values))
+ #append value[i] to empty vector
Appending to an object in a for loop causes the entire object to be copied on every iteration, which causes a lot of people to say "R is slow", or "R loops should be avoided".
As BrodieG mentioned in the comments: it is much better to pre-allocate a vector of the desired length, then set the element values in the loop.
Here are several ways to append values to a vector. All of them are discouraged.
Appending to a vector in a loop
# one way
for (i in 1:length(values))
vector[i] <- values[i]
# another way
for (i in 1:length(values))
vector <- c(vector, values[i])
# yet another way?!?
for (v in values)
vector <- c(vector, v)
# ... more ways
help("append") would have answered your question and saved the time it took you to write this question (but would have caused you to develop bad habits). ;-)
Note that vector <- c() isn't an empty vector; it's NULL. If you want an empty character vector, use vector <- character().
Pre-allocate the vector before looping
If you absolutely must use a for loop, you should pre-allocate the entire vector before the loop. This will be much faster than appending for larger vectors.
set.seed(21)
values <- sample(letters, 1e4, TRUE)
vector <- character(0)
# slow
system.time( for (i in 1:length(values)) vector[i] <- values[i] )
# user system elapsed
# 0.340 0.000 0.343
vector <- character(length(values))
# fast(er)
system.time( for (i in 1:length(values)) vector[i] <- values[i] )
# user system elapsed
# 0.024 0.000 0.023
FWIW: analogous to python's append():
b <- 1
b <- c(b, 2)
You have a few options:
c(vector, values)
append(vector, values)
vector[(length(vector) + 1):(length(vector) + length(values))] <- values
The first one is the standard approach. The second one gives you the option to append someplace other than the end. The last one is a bit contorted but has the advantage of modifying vector (though really, you could just as easily do vector <- c(vector, values).
Notice that in R you don't need to cycle through vectors. You can just operate on them in whole.
Also, this is fairly basic stuff, so you should go through some of the references.
Some more options based on OP feedback:
for(i in values) vector <- c(vector, i)
Just for the sake of completeness, appending values to a vector in a for loop is not really the philosophy in R. R works better by operating on vectors as a whole, as #BrodieG pointed out. See if your code can't be rewritten as:
ouput <- sapply(values, function(v) return(2*v))
Output will be a vector of return values. You can also use lapply if values is a list instead of a vector.
Sometimes we have to use loops, for example, when we don't know how many iterations we need to get the result. Take while loops as an example. Below are methods you absolutely should avoid:
a=numeric(0)
b=1
system.time(
{
while(b<=1e5){
b=b+1
a<-c(a,pi)
}
}
)
# user system elapsed
# 13.2 0.0 13.2
a=numeric(0)
b=1
system.time(
{
while(b<=1e5){
b=b+1
a<-append(a,pi)
}
}
)
# user system elapsed
# 11.06 5.72 16.84
These are very inefficient because R copies the vector every time it appends.
The most efficient way to append is to use index. Note that this time I let it iterate 1e7 times, but it's still much faster than c.
a=numeric(0)
system.time(
{
while(length(a)<1e7){
a[length(a)+1]=pi
}
}
)
# user system elapsed
# 5.71 0.39 6.12
This is acceptable. And we can make it a bit faster by replacing [ with [[.
a=numeric(0)
system.time(
{
while(length(a)<1e7){
a[[length(a)+1]]=pi
}
}
)
# user system elapsed
# 5.29 0.38 5.69
Maybe you already noticed that length can be time consuming. If we replace length with a counter:
a=numeric(0)
b=1
system.time(
{
while(b<=1e7){
a[[b]]=pi
b=b+1
}
}
)
# user system elapsed
# 3.35 0.41 3.76
As other users mentioned, pre-allocating the vector is very helpful. But this is a trade-off between speed and memory usage if you don't know how many loops you need to get the result.
a=rep(NaN,2*1e7)
b=1
system.time(
{
while(b<=1e7){
a[[b]]=pi
b=b+1
}
a=a[!is.na(a)]
}
)
# user system elapsed
# 1.57 0.06 1.63
An intermediate method is to gradually add blocks of results.
a=numeric(0)
b=0
step_count=0
step=1e6
system.time(
{
repeat{
a_step=rep(NaN,step)
for(i in seq_len(step)){
b=b+1
a_step[[i]]=pi
if(b>=1e7){
a_step=a_step[1:i]
break
}
}
a[(step_count*step+1):b]=a_step
if(b>=1e7) break
step_count=step_count+1
}
}
)
#user system elapsed
#1.71 0.17 1.89
In R, you can try out this way:
X = NULL
X
# NULL
values = letters[1:10]
values
# [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j"
X = append(X,values)
X
# [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j"
X = append(X,letters[23:26])
X
# [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "w" "x" "y" "z"
> vec <- c(letters[1:3]) # vec <- c("a","b","c") ; or just empty vector: vec <- c()
> values<- c(1,2,3)
> for (i in 1:length(values)){
print(paste("length of vec", length(vec)));
vec[length(vec)+1] <- values[i] #Appends value at the end of vector
}
[1] "length of vec 3"
[1] "length of vec 4"
[1] "length of vec 5"
> vec
[1] "a" "b" "c" "1" "2" "3"
What you're using in the python code is called a list in python, and it's tottaly different from R vectors, if i get what you wanna do:
# you can do like this if you'll put them manually
v <- c("a", "b", "c")
# if your values are in a list
v <- as.vector(your_list)
# if you just need to append
v <- append(v, value, after=length(v))
in R you create a "list" doing this:
v <- numeric() (is a numeric vector, or int in Python)
v <- character() (is a character vector, or str in Python)
then, if you want yo append a single value you have to do this:
v[1] <- 10 (append to vector "v", in position "1" a value 10)
v[2] <- 11 (append to vector "v", in position "2" a value 11)
So, if yoy want yo append multiple values in a for loop, try this:
v <- numeric()
for (value in 1:10) {
v[value] <- value
}
v
[1] 1 2 3 4 5 6 7 8 9 10
I have a vector, such as c(1, 3, 4, 5, 9, 10, 17, 29, 30) and I would like to group together the 'neighboring' elements that form a regular, consecutive sequence, i.e. an increase by 1, in a ragged vector resulting in:
L1: 1
L2: 3,4,5
L3: 9,10
L4: 17
L5: 29,30
Naive code (of an ex-C programmer):
partition.neighbors <- function(v)
{
result <<- list() #jagged array
currentList <<- v[1] #current series
for(i in 2:length(v))
{
if(v[i] - v [i-1] == 1)
{
currentList <<- c(currentList, v[i])
}
else
{
result <<- c(result, list(currentList))
currentList <<- v[i] #next series
}
}
return(result)
}
Now I understand that a) R is not C (despite the curly brackets) b) global variables are pure evil c) that is a horribly inefficient way of achieving the result
, so any better solutions are welcome.
Making heavy use of some R idioms:
> split(v, cumsum(c(1, diff(v) != 1)))
$`1`
[1] 1
$`2`
[1] 3 4 5
$`3`
[1] 9 10
$`4`
[1] 17
$`5`
[1] 29 30
daroczig writes "you could write a lot neater code based on diff"...
Here's one way:
split(v, cumsum(diff(c(-Inf, v)) != 1))
EDIT (added timings):
Tommy discovered this could be faster by being careful with types; the reason it got faster is that split is faster on integers, and is actually faster still on factors.
Here's Joshua's solution; the result from the cumsum is a numeric because it's being c'd with 1, so it's the slowest.
system.time({
a <- cumsum(c(1, diff(v) != 1))
split(v, a)
})
# user system elapsed
# 1.839 0.004 1.848
Just cing with 1L so the result is an integer speeds it up considerably.
system.time({
a <- cumsum(c(1L, diff(v) != 1))
split(v, a)
})
# user system elapsed
# 0.744 0.000 0.746
This is Tommy's solution, for reference; it's also splitting on an integer.
> system.time({
a <- cumsum(c(TRUE, diff(v) != 1L))
split(v, a)
})
# user system elapsed
# 0.742 0.000 0.746
Here's my original solution; it also is splitting on an integer.
system.time({
a <- cumsum(diff(c(-Inf, v)) != 1)
split(v, a)
})
# user system elapsed
# 0.750 0.000 0.754
Here's Joshua's, with the result converted to an integer before the split.
system.time({
a <- cumsum(c(1, diff(v) != 1))
a <- as.integer(a)
split(v, a)
})
# user system elapsed
# 0.736 0.002 0.740
All the versions that split on an integer vector are about the same; it could be even faster if that integer vector was already a factor, as the conversion from integer to factor actually takes about half the time. Here I make it into a factor directly; this is not recommended in general because it depends on the structure of the factor class. It'ss done here for comparison purposes only.
system.time({
a <- cumsum(c(1L, diff(v) != 1))
a <- structure(a, class = "factor", levels = 1L:a[length(a)])
split(v,a)
})
# user system elapsed
# 0.356 0.000 0.357
Joshua and Aaron were spot on. However, their code can still be made more than twice as fast by careful use of the correct types, integers and logicals:
split(v, cumsum(c(TRUE, diff(v) != 1L)))
v <- rep(c(1:5, 19), len = 1e6) # Huge vector...
system.time( split(v, cumsum(c(1, diff(v) != 1))) ) # Joshua's code
# user system elapsed
# 2.64 0.00 2.64
system.time( split(v, cumsum(c(TRUE, diff(v) != 1L))) ) # Modified code
# user system elapsed
# 1.09 0.00 1.12
You could define the cut-points easily:
which(diff(v) != 1)
Based on that try:
v <- c(1,3,4,5,9,10,17,29,30)
cutpoints <- c(0, which(diff(v) != 1), length(v))
ragged.vector <- vector("list", length(cutpoints)-1)
for (i in 2:length(cutpoints)) ragged.vector[[i-1]] <- v[(cutpoints[i-1]+1):cutpoints[i]]
Which results in:
> ragged.vector
[[1]]
[1] 1
[[2]]
[1] 3 4 5
[[3]]
[1] 9 10
[[4]]
[1] 17
[[5]]
[1] 29 30
This algorithm is not a nice one but you could write a lot neater code based on diff :) Good luck!
You can create a data.frame and assign the elements to groups using diff, ifelse and cumsum, then aggregate using tapply:
v.df <- data.frame(v = v)
v.df$group <- cumsum(ifelse(c(1, diff(v) - 1), 1, 0))
tapply(v.df$v, v.df$group, function(x) x)
$`1`
[1] 1
$`2`
[1] 3 4 5
$`3`
[1] 9 10
$`4`
[1] 17
$`5`
[1] 29 30