for loop storage issue (nested for loops) - r

I am having difficulty storing all of my data from my middle for loop. when i try and retrieve the data after the outside for loop has run the only data that i am able to attain is the final run. how do i store all of the runs of D in a single matrix?
set.seed(3690)
iterations <- 20
mean_birthrate <- 0.4
stand_dev_birthrate <- 0.1
mean_survival_rate <- 0.68
stand_dev_survival <- 0.07
initial_population <- 100
period <- 20
End_Year <- 2013+period
birthrate <- rnorm(n=1,mean=mean_birthrate,sd=stand_dev_birthrate)
birthrate
survival <- rnorm(n=1,mean=mean_survival_rate,sd=stand_dev_survival)
survival
growth_rate <- birthrate - (1-survival)
growth_rate
for (k in 1:50) {
D <- numeric(period)
D[1] <- initial_population
for (i in 1:period) {
D[i+1] <- D[i] + ((rnorm(n=1,mean=mean_birthrate,sd=stand_dev_birthrate) - (1-rnorm(n=1,mean=mean_survival_rate,sd=stand_dev_survival))) * D[i])
}
print(D)
if (k==1)
plot(D, typ="l",ylab="Number of Bobcats",xlab="Year",ylim=c(50,1700),xaxt='n')
if (k>1)
lines(D,col = rgb(0,0,0,0.1),xaxt='n')
}

if you have nested for loops, you need nested lists (or some other form to capture the n x m many results)
#outter loop
for (i in...)
D[[i]] <- list()
#inner loop
for (j in ...)
D[[i]][[j]] <- value
# or different syntax:
D[[c(i, j)]] <- calue

I had a similar problem, and solved it with a pre-defined variable, like this:
DATA <- list()
j <- 0
for(k in 1:10){
for(i in 1:5){
temp.DATA <- i*k #or whatever the loop does
j <- j+1
DATA[[j]] <- temp.DATA
}
}
DATA2 <- do.call(rbind.data.frame, DATA)
Hope that helps!

Related

Function with variables that are different dataframe sizes

So I´m trying to run the fuction below hoping to get 224 vectors in the output, but only get one and I have no idea why.
ee <- 0.95
td <- 480
tt <- c(60,10,14,143,60)
tt <- as.data.frame(tt)
r <- vector()
m <- function(d)
{
n <- length(tt)
c <- nrow(d)
for (j in 1:c)
{
for (i in 1:n)
{
r[i] <- tt[i]/(td*ee/d[j,])
}
return(r)
}
#where d is a data frame of 224 obs. of 1 variable
and the output i´m getting is
[[1]]
[1] 1026.3158 171.0526 239.4737 2446.0526 1026.3158
The problem comes from the fact that your function returns only the last r vector that is computed, due to where return is placed within your loop.
One way to do this is to store the results in a list:
r <- vector()
m_bis <- function(d) {
res <- list() # store all the vectors here
n <- length(tt)
c <- nrow(d)
for (j in 1:c) {
for (i in 1:n) {
r[i] <- tt[i] / (td * ee / d[j,])
}
res[j] <- r
}
return(res)
}
That should yield something like this:
m_bis(as.data.frame(mtcars$mpg))
> [[1]]
[1] 2.7631579 0.4605263 0.6447368 6.5855263 2.7631579
...
[[32]]
[1] 2.8157895 0.4692982 0.6570175 6.7109649 2.8157895
outer(as.vector(tt[,1]), as.vector(d[,1]), function(x,y){x*y/(td*ee)})
Use vectorization to accelerate the computation.

How to keep track of a data frame and save it in each round of a loop?

I simply need to save df each time it goes through the loop and save it as a csv or something similar!
#Q are matrices and trees are phyllo objects
library(ape)
library(phytools)
for(l in 1:length(Q.all)){
for(k in 1:length(trees)){
tree<- trees[[k]]
Q<- Q.all[[l]]
file1<- sim.history (tree, Q, nsim=10)
df<- getStates(file1, type="tips")
df2 <- as.data.frame(matrix(nrow=nrow(df),ncol=length(file1)))
for(i in 1:length(file1)){
for(j in 1:nrow(df)){
x <- df[j,i]
num <- sum(df[,i] == x) - 1
rarity <- 1 - num/(nrow(df)-1)
df2[j,i] <- rarity
}
}
Thanks

Function: save returned data frame to workspace

I cannot really get my head around this problem:
I have a function that returns a data frame. However, the data frame is only printed in my console although I would like to have it stored in the work space. How can I achieve this?
Sample data:
n <- 32640
t <- seq(3*pi,n)
data_sim <- 30+ 2*sin(3*t)+rnorm(n)*10
data_sim <- floor(data_sim)
Function:
compress <- function (name, SR){
## -------------------------------------------------------
## COMPRESSION
library(zoo)
data <- get(name)
if (is.data.frame(data)==F){
data = as.data.frame(data)
}
SR <- SR
acrossmin <- 60
a <- nrow(data)
m <- acrossmin*SR*60
data_compress <- matrix(NA, nrow = a/m)
no_mov_subset <- matrix(NA, nrow = m)
for (i in 1:(a/m)){
subset <- data[(((i-1)*m)+1):((i*m)),]
b <- length(subset)
for (k in 1:b){
r <- subset[k]
if (r == 0){
no_mov_subset[k] <- 0
} else {
no_mov_subset[k] <- 1
}
sum_no_mov_subset <- sum(no_mov_subset)
data_compress[i] <- sum_no_mov_subset
}
colnames(data_compress) <- c("activity_count")
return(data_compress)
}
Run the code:
compress("data_sim", 4/60)
Obviously, the function returns something, but I would like it to be stored in the workspace rather than returned!
Instead of the return command you can use
data_compress <<- data_compress
This way, the data frame is stored in the workspace. So your function looks like this:
compress <- function (name, SR){
## -------------------------------------------------------
## COMPRESSION
library(zoo)
data <- get(name)
if (is.data.frame(data)==F){
data = as.data.frame(data)
}
SR <- SR
acrossmin <- 60
a <- nrow(data)
m <- acrossmin*SR*60
data_compress <- matrix(NA, nrow = a/m)
no_mov_subset <- matrix(NA, nrow = m)
for (i in 1:(a/m)){
subset <- data[(((i-1)*m)+1):((i*m)),]
b <- length(subset)
for (k in 1:b){
r <- subset[k]
if (r == 0){
no_mov_subset[k] <- 0
} else {
no_mov_subset[k] <- 1
}
sum_no_mov_subset <- sum(no_mov_subset)
data_compress[i] <- sum_no_mov_subset
}
colnames(data_compress) <- c("activity_count")
data_compress <<- data_compress
}
}
Edit: As commented by Heroka and hrbrmstr, this solution is not safe. It is better to assign the output of the function call to a variable:
data_compr <- compress("data_sim", 4/60)

For loop returning just one output in R

I am getting a 49*49 matrix as input from a csv and trying to print the sum as a 49*49 matrix but I am getting just one value as output for sum.
w <- read.csv(file="ma.csv", header=F, sep=",");
sum <- 4
for(i in 1:49){
for(j in 1:49)
{
sum = sum + w[i,j];
}
}
May be
w1 <- matrix(NA, ncol=3, nrow=3)
sum1 <- 4
for(i in 1:3){
for(j in 1:3){
w1[i,j] = sum1 + w[i,j];
}
}
w1[] <- cumsum(w1)
Or without any loop
w2 <- w
w2[] <- cumsum(w+sum1)
identical(w2, w1)
#[1] TRUE
data
set.seed(24)
w <- matrix(sample(0:20, 3*3, replace=TRUE), ncol=3)

double for loop in Binomial Tree in R

I want set up a model for interest rate in binomial tree. The interest rate is path dependent. I want return interest rate (discount factor and payoff) at every step in all scenarios(2^N). The reason I want to return every single interest rate is that I want use the interest rate is compute discount factor. I know how to do this in a complex way. Here I want to use a double loop (or something simpler) to get the results.
w is for "0" or "1" dummy variable matrix representing all scenarios.
r is interest rate. if there is a head(1), then r1=r0+u=r0+0.005; if there is a tail(0), then r1=r0-d.
D is discount factor. D1=1/(1+r0), D2=D1/(1+r1)...
P is payoff.
In this case, period N is 10. therefore, I can compute step by step. However,if N gets larger and larger, I cannot use my method. I want a simple way to compute this. Thank you.
#Real Price
N <- 10
r0 <- 0.06
K <- 0.05
u <- 0.005
d <- 0.004
q <- 0.5
w <- expand.grid(rep(list(0:1),N))
r <- D <- P <- matrix(0,0,nrow=2^N,ncol=N)
for(i in 1:dim(w)[1])
{
r[i,1] <- r0 + u*w[i,1] - d*(1-w[i,1])
r[i,2] <- r[i,1] + u*w[i,2] - d*(1-w[i,2])
r[i,3] <- r[i,2]+u*w[i,3]-d*(1-w[i,3])
r[i,4] <- r[i,3]+u*w[i,4]-d*(1-w[i,4])
r[i,5] <- r[i,4]+u*w[i,5]-d*(1-w[i,5])
r[i,6] <- r[i,5]+u*w[i,6]-d*(1-w[i,6])
r[i,7] <- r[i,6]+u*w[i,7]-d*(1-w[i,7])
r[i,8] <- r[i,7]+u*w[i,8]-d*(1-w[i,8])
r[i,9] <- r[i,8]+u*w[i,9]-d*(1-w[i,9])
r[i,10] <- r[i,9]*+u*w[i,10]-d*(1-w[i,10])
D[i,1] <- 1/(1+r0)
D[i,2] <- D[i,1]/(1+r[i,1])
D[i,3] <- D[i,2]/(1+r[i,2])
D[i,4] <- D[i,3]/(1+r[i,3])
D[i,5] <- D[i,4]/(1+r[i,4])
D[i,6] <- D[i,5]/(1+r[i,5])
D[i,7] <- D[i,6]/(1+r[i,6])
D[i,8] <- D[i,7]/(1+r[i,7])
D[i,9] <- D[i,8]/(1+r[i,8])
D[i,10] <- D[i,9]/(1+r[i,9])
P[i,1] <- D[i,1]*pmax(K-r0,0)*(0.5^N)
P[i,2] <- D[i,2]*pmax(K-r[i,1],0)*(0.5^N)
P[i,3] <- D[i,3]*pmax(K-r[i,2],0)*(0.5^N)
P[i,4] <- D[i,4]*pmax(K-r[i,3],0)*(0.5^N)
P[i,5] <- D[i,5]*pmax(K-r[i,4],0)*(0.5^N)
P[i,6] <- D[i,6]*pmax(K-r[i,5],0)*(0.5^N)
P[i,7] <- D[i,7]*pmax(K-r[i,6],0)*(0.5^N)
P[i,8] <- D[i,8]*pmax(K-r[i,7],0)*(0.5^N)
P[i,9] <- D[i,9]*pmax(K-r[i,8],0)*(0.5^N)
P[i,10] <- D[i,10]*pmax(K-r[i,9],0)*(0.5^N)
}
true.price <- sum(P)
#> true.price
# > true.price
# [1] 0.00292045
You can just use a nested loop, looping over 2:(ncol(w)) within the i loop:
for(i in 1:nrow(w)) {
r[i, 1] <- r0 + u*w[i, 1] - d*(1-w[i, 1])
D[i, 1] <- 1/(1+r0)
P[i, 1] <- D[i, 1]*pmax(K-r0, 0)*(0.5^N)
for (j in 2:(ncol(w))) {
r[i,j] <- r[i, j-1] + u*w[i, j] - d*(1-w[i, j])
D[i,j] <- D[i, j-1]/(1+r[i, j-1])
P[i,j] <- D[i, j]*pmax(K-r[i, j-1], 0)*(0.5^N)
}
}
true.price <- sum(P)

Resources