I have generated an infinite loop and don't know how to fix it.
I essentially want to go through the data frame rnumbers and generate rstate2 with 1, -1, or 0 depending on what is in rnumbers
The function step_generator is getting stuck at the repeat function. I am not sure how to make the code put -1 in rstate2 if rnumber is less than C and then repeat an ifelse function for the next rows until a value of D or greater is obtained. Once D is obtained exit the repeat function and go back into the original for loop.
Here is my code:
rnumbers <- data.frame(replicate(5,runif(20000, 0, 1)))
dt <- c(.01)
A <- .01
B <- .0025
C <- .0003
D <- .003
E <- .05
rstate <- rnumbers # copy the structure
rstate[] <- NA # preserve structure with NA's
# Init:
rstate[1, ] <- c(0)
step_generator <- function(col, rnum){
for (i in 2:length(col) ){
if( rnum[i] < C) {
col[i] <- -1
repeat {
ifelse(rnum[i] < E, -1, if(rnum[i] >= D) {break})
}
}
else { if (rnum[i] < B) {col[i] <- -1 }
else {ifelse(rnum[i] < A, 1, 0) } }
}
return(col)
}
# Run for each column index:
for(cl in 1:5){ rstate[ , cl] <-
step_generator(rstate[,cl], rnumbers[,cl]) }
Thanks for any help.
The problem is that you are not increasing i inside repeat loop, so basically you are testing the same i all the time, and because rnum[i] < C (from if condition) it will always be rnum[i] < E since C < E, and loop never breaks.
However, if you increase i inside repeat it still will come back to value resulting from for loop, so you have to do it in different way, for example using while loop. I'm not exactly sure if I understand what you are trying to do, but basing on your description I've made this function:
step_generator <- function(col, rnum){
i <- 2
while (i <= length(col)){
if (rnum[i] < C) {
col[i] <- -1
while ((i < length(col)) & (rnum[i + 1] < D)){
i <- i + 1
col[i] <- -1
}
} else if (rnum[i] < B){
col[i] <- -1
} else if (rnum[i] < A){
col[i] <- 1
} else {
col [i] <- 0
}
i <- i + 1
}
return(col)
}
Related
How can I set a loop to run to a maximum value (Dend)?
I just want to see how fast and deep it will grow but I want to set a maximum to say that it can't grow beyond Dend.
I get an error stating
In if (D == Dend) { :
the condition has length > 1 and only the first element will be used
Code
D0 <- 0
Dend <- 4200
r <- 5 growth rate
days <- 1000
n_steps <- days*1
D <- rep(NA, n_steps+1)
D <- D0
for (time in seq_len(n_steps)){
if (D == Dend){
break} else
D[time + 1] <- r + D[time]
}
D
plot(-D, las=1)
If you want a for loop, it might be something like below
for (time in seq_len(n_steps)){
if (tail(D,1) >= Dend) break
D[time + 1] <- r + D[time]
}
I think what you want can be achieved with seq without any loops :
D <- seq(D0, Dend, r)
If you have to use for loop you can use :
for (time in seq_len(n_steps)){
temp <- r + D[time]
if (temp >= Dend) break
D[time + 1] <- temp
}
We can also use a while loop :
i <- 1
while(TRUE) {
temp <- r + D[i]
if(temp > Dend) break
i <- i + 1
D[i] <- temp
}
Here is my code:
n <- 10
set.seed(100)
d <- rep(NA, n)
d[1] <- 0
y <- runif(n)
a <- 5
for (i in (2:(length(y)+1))) {
d[i] <- d[i-1] + y[i-1]
}
store.x <- NULL
for(j in 1:a) {
x <- runif(1, min = 0, max = sum(y))
for (i in 1:(length(y))) {
if(x <= d[i+1] && x > d[i]) {
store.x[j] <- i
break
}
}
}
store.x
Now store.x prints out 7, 9, 4, 6, 8. I want to be able to put these into a matrix where the numbers that store.x prints correspond to the columns and the row is in order of the numbers. So the first entry would be in row 1 column 7, next would be row 2 column 9 and so on. I want to start with a n by n matrix filled with zeros and then add one the row/column that these numbers are in. I'm not sure how to go about doing this. Any help would be appreciated!
So creating a matrix mt that will be filled and then NA's changed to zeros.
n <- 10
set.seed(100)
d <- rep(NA, n)
d[1] <- 0
y <- runif(n)
a <- 220
mt = matrix(nrow = n, ncol = n)
mt[is.na(mt)] = 0
for (i in (2:(length(y)+1))) {
d[i] <- d[i-1] + y[i-1]
}
store.x <- NULL
for(j in 1:a) {
x <- runif(1, min = 0, max = sum(y))
for (i in 1:(length(y))) {
if(x <= d[i+1] && x > d[i]) {
store.x[j] <- i
if(length(which(i == store.x)) > 1){
mt[which(mt[,i] != 0),i] = mt[which(mt[,i] != 0),i] + 1
} else {
mt[(which(rowSums(mt) == 0)[1]),i] = 1
}
break
}
}
}
what i added was this following logic
if(length(which(i == store.x)) > 1){
mt[which(mt[,i] != 0),i] = mt[which(mt[,i] != 0),i] + 1
} else {
mt[(which(rowSums(mt) == 0)[1]),i] = 1
}
if the number created exists in store.x more than once then we find the existing entry (column corresponds to i and row will be the one which is not 0). If the number does not exist we then find the first row which has no entry and use that.
I hope this question is new as I couldn't find a solution that worked for me.
I have a vector x that can be filled with any real numbers. The elements in this vector should be transformed by a function in the following way:
x = 0, if x < a
x = (x-a)/(b-a), if a <= x <= b
x = 1, if x > b
This is the function I came up with:
transf <- function(x, a = 0, b = 1){
if(a > b) stop("\nThe lower bound must be smaller than the upper bound!")
if(x < a){
y = 0
}
else if(a <= x <= b){
y = (x-a)/(b-a)
}
else{
y = 1
}
return(y)
print(y)
}
I get a bunch of error messages that I can't quite put together. I also tried replacing else if and else with a simple if, but that didn't work either.
Any help on how to solve this would be very much appreciated
I'd use logical indexing:
i.low <- x < a
i.mid <- x >= a & x <= b
i.high <- x > b
x[i.low] <- 0
x[i.mid] <- (x[i.mid] - a) / (b - a)
x[i.high] <- 1
Your original post didn't say what the errors were, but I'd guess you were passing the vector in as your function argument and the errors were complaining "the condition has length > 1 and only the first element will be used". This is because you're testing the condition of a vector of logicals.
I'd like to perform this function on a matrix 100 times. How can I do this?
v = 1
m <- matrix(0,10,10)
rad <- function(x) {
idx <- sample(length(x), size=1)
flip = sample(0:1,1,rep=T)
if(flip == 1) {
x[idx] <- x[idx] + v
} else if(flip == 0) {
x[idx] <- x[idx] - v
return(x)
}
}
This is what I have so far but doesn't work.
for (i in 1:100) {
rad(m)
}
I also tried this, which seemed to work, but gave me an output of like 5226 rows for some reason. The output should just be a 10X10 matrix with changed values depending on the conditions of the function.
reps <- unlist(lapply(seq_len(100), function(x) rad(m)))
Ok I think I got it.
The return statement in your function is only inside a branch of an if statement, so it returns a matrix with a probability of ~50% while in the other cases it does not return anything; you should change the code function into this:
rad <- function(x) {
idx <- sample(length(x), size=1)
flip = sample(0:1,1,rep=T)
if(flip == 1) {
x[idx] <- x[idx] + v
} else if(flip == 0) {
x[idx] <- x[idx] - v
}
return(x)
}
Then you can do:
for (i in 1:n) {
m <- rad(m)
}
Note that this is semantically equal to:
for (i in 1:n) {
tmp <- rad(m) # return a modified verion of m (m is not changed yet)
# and put it into tmp
m <- tmp # set m equal to tmp, then in the next iteration we will
# start from a modified m
}
When you run rad(m) is not do changes on m.
Why?
It do a local copy of m matrix and work on it in the function. When function end it disappear.
Then you need to save what function return.
As #digEmAll write the right code is:
for (i in 1:100) {
m <- rad(m)
}
You don't need a loop here. The whole operation can be vectorized.
v <- 1
m <- matrix(0,10,10)
n <- 100 # number of random replacements
idx <- sample(length(m), n, replace = TRUE) # indices
flip <- sample(c(-1, 1), n, replace = TRUE) # subtract or add
newVal <- aggregate(v * flip ~ idx, FUN = sum) # calculate new values for indices
m[newVal[[1]]] <- m[newVal[[1]]] + newVal[[2]] # add new values
I am trying write a function that generates simulated data but if the simulated data does not meet the condition, I need to skip it and if it does meet the condition, then I will apply the function summary.
I would like to loop it until I find 10 valid datasets and then stop. (I actually have to do this until it reaches 10000). Here is the code. The code sort of works except it does not stop. I think I probably placed the next and break function in the wrong place. I hope someone could help me write this together.
Another way I could approach this is to generate all the valid data first and then apply the function find_MLE (summary) to the final list.
Edit: I put break inside repeat. I edit the code to make it reproducible. Still the code keeps generating data and does not break.
here is a reproducible version
validData <- function(GM, GSD,sampleSize, p) {
count=0
for (i in 1:n) {
repeat {
lod <- quantile(rlnorm(1000000, log(GM), log(GSD)), p = p)
X_before <- rlnorm(sampleSize, log(GM), log(GSD))
Xs <- ifelse(X_before <= lod, lod, X_before)
delta <- ifelse(X_before <= lod, 1, 0)
pct_cens <- sum(delta)/length(delta)
print(pct_cens)
if (pct_cens == 0 & pct_cens ==1) next
else {
sumStats <- summary(Xs)
Med <- sumStats[3]
Ave <- sumStats[4]
}
count<- count+1
if (count == 10) break
}}
return(c(pct_cens, Med, Ave))
}
validData(GM=1,GSD=2,sampleSize=10,p=0.1)
Thanks for your help. I was able to write a function without using break function! I posted it here in case other people might find it helpful.
dset <- function (GM, GSD, n, p) {
Mean <- array()
Median <- array()
count = 0
while(count < 10) {
lod <- quantile(rlnorm(1000000, log(GM), log(GSD)), p = p)
X_before <- rlnorm(n, log(GM), log(GSD))
Xs <- ifelse(X_before <= lod, lod, X_before)
delta <- ifelse(X_before <= lod, 1, 0)
pct_cens <- sum(delta)/length(delta)
print(pct_cens)
if (pct_cens == 0 | pct_cens == 1 ) next
else {count <- count +1
if (pct_cens > 0 & pct_cens < 1) {
sumStats <- summary(Xs)
Median[count] <- sumStats[3]
Mean [count]<- sumStats[4]
print(list(pct_cens=pct_cens,Xs=Xs, delta=delta, Median=Median,Mean=Mean))
}
}
}
return(data.frame( Mean=Mean, Median=Median)) }
Since your code isn't replicable, I cannot fully test and debug your code, but here is what I think it would look like without being able to replicate with an MLE function. This is roughly how I would set it up. But check out the documentation/Google on break, next, for/while loops related to R when testing your code.
validData <- function(GM, GSD,Size, p) {
for (i in 1:20) {
count <- 1
repeat {
lod <- quantile(rlnorm(1000000, log(GM), log(GSD)), p = p)
X_before <- rlnorm(Size, log(GM), log(GSD))
Xs <- ifelse(X_before <= lod, lod, X_before)
delta <- ifelse(X_before <= lod, 1, 0)
pct_cens <- sum(delta)/length(delta)
if (pct_cens == 0 & pct_cens ==1)
function() #your foo goes here
else {
mles <- find_MLE(c(0,0), Xs, delta)
GM_est <- mles[1]
GSD_est <- mles[2]
AM_est <- exp(log(GM_est) + 1 )
SD_est<- sqrt((AM_est)^2*exp(log(GSD_est)^2))
D95th_est <- GM_est*(GSD_est^1.645)
} }
return(c(GM_est,GSD_est,AM_est,SD_est,D95th_est))
count<- count+1
if (count == 10) break
}}
To skip to the outer loop based on a condition, simply use break()
Here's a simple example where the inner loop will try to run 10 times, but a condition will usually be met which prevents it
# OUTER LOOP
for(i in 1:2) {
print(paste("Outer loop iteration", i))
# INNER LOOP (will run max 10 times)
for(j in 1:10) {
print(paste("Inner loop iteration", j))
if (runif(1) > 0.4) { # Randomly break the inner loop
print(paste("Breaking inner loop", j))
break()
}
}
}
If you want to skip to the outer loop when there's an error (rather than based on a condition), see here