Is it possible to change an if-else statement to include OR in an R-Script? Like 70% of the time would turn into this, while the remaining 30% would turn into something else. Similar to increasing the probability to change?
if (w0[i, j] == 1) { w1[i, j] <- rL[nNeigh + 1]
} else { w1[i, j] <- rD[nNeigh + 1] }
This is the statement where the result is deterministic, but I want to change it into a probabilistic function.
if (w0[i, j] == 1) { w1[i, j] <- rL[nNeigh + 1] || w1[i, j] <- rL[nNeigh]
} else { w1[i, j] <- rD[nNeigh + 1] || w1[i, j] <- rL[nNeigh] }
I know this is not the right way to even do it, but I'm at a loss
Just a quick idea:
coin <- rbinom(1, 1, 0.3)
if (w0[i, j] == 1) {
w1[i, j] <- coin * rL[nNeigh + 1] + (1 - coin) * rL[nNeigh]
} else {
w1[i, j] <- coin * rD[nNeigh + 1] + (1 - coin) * rL[nNeigh]
}
It's not clear what the larger context of the question is. However note that Martin Gal's useful answer can be simplified:
coin <- rbinom(1, 1, 0.3)
if (w0[i, j] == 1) {
w1[i, j] <- rL[nNeigh + coin]
} else {
w1[i, j] <- rD[nNeigh + coin]
}
Related
together with you, I have recently made the following function (the content is not important right now). It seems to be correct but when I try to process it, the following error turns up: Error: unexpected '}' in " }". Do you know what I´ve made wrong?
Here´s the function, thank you in advance (btw I have checked every bracket):
Edit: Now it works:
CI <- function(x, s, z, Fall) {
if (Fall == "Fall1") {
result <- mean(x) + c(-1,1)* qnorm(1-z/2)*(s/sqrt(length(x)))
} else if (Fall == "Fall2") {
result <- mean(x) + c(-1,1)* qt(p=1-a/2, df=length(x)- 1)*(sd(x)/sqrt(length(x)))
} else if (Fall == "Fall3") {
result <-mean(x)+c(-1,1)qnorm(1-z/2(s/sqrt(length(x))))
} else if (Fall == "Fall4"){
result <- mean(x)+c(-1,1)qt(p=1-a/2, df=length(x)-1)(sd(x)/sqrt(length(x)))
} else {result<-NA}
return(result)
}
CI(x=x, s=15, z=0.05, Fall="Fall1")
There are couple of errors - 1) else would not have a condition check, instead use else if, 2), the values to compare should be quoted "Fall1"
CI <- function(x, mean, sd, z, Fall)
{
if (Fall == "Fall1") {
result <- mean(x) + c(-1, 1) * qnorm(1 - z / 2) * (sd / sqrt(length(x)))
} else if (Fall == "Fall2") {
result <-
mean(x) + c(-1, 1) * qt(p = 1 - a / 2, df = length(x) - 1) * (sd(x) / sqrt(length(x)))
} else if (Fall == "Fall3") {
result <- mean(x) + c(-1, 1) * qnorm(1 - z / 2 *
(sd / sqrt(length(x))))
} else if (Fall == "Fall4") {
result <-
mean(x) + c(-1, 1) * qt(p = 1 - a / 2, df = length(x) - 1) * (sd(x) / sqrt(length(x)))
}
else {
result <- NA_real_
}
return(result)
}
So I am trying to do a for loop over the upper triangle part of a matrix, so I only want the elements 1 <= i < j <= n. And I tried it out in R as follows:
for(i in 1:n-1) {
for(j in i+1:n) {
...
}
}
But instead of iterating over 1 <= i < j <= n these for loops go over the elements i + 1 <= j <= i + n, 1 <= i < n.
I'm new to R, so I don't understand what is happening. Could someone give me a hint how to do it correctly?
Thanks.
for(i in seq(1, n - 1)) {
for(j in seq(i + 1, n)) {
...
}
}
alternatively
for(i in 1:(n - 1)) {
for(j in (i + 1):n) {
...
}
}
The issue is that R understands i+1:n as i + (1:n)
I was asked to implement function that calculates n-dimensional matrix determinant using Laplace expansion. This involves recursion. I developed this:
minor<-function(A,i,j) {
return(A[c(1:(i-1),(i+1):dim(A)[1]),c(1:(j-1),(j+1):dim(A)[2])])
}
determinantRec<-function(X,k) {
if (dim(X)[1] == 1 && dim(X)[2] == 1) return(X[1][1])
else {
s = 0
for (i in 1:dim(X)[2]) {
s = s + X[k][i]*(-1)^(k+i)*determinantRec(minor(X,k,i),k)
}
return(s)
}
}
where k in determinantRec(X,k) function indicates which row I want to use Laplace expansion along of.
My problem is when I run determinantRec(matrix(c(1,2,3,4),nrow = 2,ncol = 2),1) this error appears:
C stack usage 7970628 is too close to the limit
What is wrong with my code?
#julia, there is one simple type in your code. Just remove the '*' at the end of the definition of 's'. And don't indent the recursion.
determinantRek<-function(X,k) {
if (dim(X)[1] == 1 && dim(X)[2] == 1)
return(X[1,1])
if (dim(X)[1] == 2 && dim(X)[2] == 2)
return(X[1,1]*X[2,2]-X[1,2]*X[2,1])
else
s = 0
for (i in 1:dim(X)[2]) {
s = s + X[k,i]*(-1)^(k+i)
determinantRek(X[-k,-i],k)
}
return(s)
}
I did this way and works just fine, although it is super slow, compared to the det function in base R
laplace_expansion <- function(mat){
det1 <- function(mat){
mat[1]*mat[4]-mat[2]*mat[3]
}
determinant <- 0
for(j in 1:ncol(mat)){
mat1 <- mat[-1,-j]
if(nrow(mat1) == 2){
determinant <- determinant+mat[1,j]*(-1)^(1+j)*det1(mat1)
}else{
val <- mat[1,j]*(-1)^(1+j)
if(val != 0){
determinant <- determinant+val*laplace_expansion(mat1)
}
}
}
return(determinant)
}
This is my approach, I think it's cleaner.
deter <- function(X) {
stopifnot(is.matrix(X))
stopifnot(identical(ncol(X), nrow(X)))
if (all(dim(X) == c(1, 1))) return(as.numeric(X))
i <- 1:nrow(X)
out <- purrr::map_dbl(i, function(i){
X[i, 1] * (-1)^(i + 1) * deter(X[-i, -1, drop = FALSE])
})
return(sum(out))
}
Thank you #ArtemSokolov and #MrFlick for pointing the problem cause, it was it. I also discovered that this code does not calculate properly the determinant of 2x2 matrix. After all it looks like that:
determinantRek<-function(X,k) {
if (dim(X)[1] == 1 && dim(X)[2] == 1)
return(X[1,1])
if (dim(X)[1] == 2 && dim(X)[2] == 2)
return(X[1,1]*X[2,2]-X[1,2]*X[2,1])
else
s = 0
for (i in 1:dim(X)[2]) {
s = s + X[k,i]*(-1)^(k+i)*
determinantRek(X[-k,-i],k)
}
return(s)
}
Debuging with browser() was also helpful :)
simulate_queue<- function(open_time, rate, low, high){
i<-1
j<-1
a<-rexp(1,rate)
b<-runif(1,low,high)
c<-a+b
d<-a + rexp(1,rate)
e<-c()
while (d <= open_time) {
a[i+1]<- d
if (a[i+1] < c[i]){
c[i+1]<-c[i]+b
b<- runif(1,low,high)
}
else c[i+1]<-a[i+1]+b
e[i]<-( while(d <= open_time){
if (c[j] < a[i+1]) {sum(c[j]< a[i])
i <- i+1
}
else if (c[j] > a[i+1]) {0
j <- j+1
}
else 0
}
)
i<-i+1
d <- a[i] + rexp(1,rate)
}
L <- list(arrival_times=a,queue_lengths=e,departure_times=c)
L
}
I don't know why there is an error message
Error in if (c[j] < a[i + 1]) { : missing value where TRUE/FALSE needed
Please help me..
I know lots of people have posted about this, and I did look through the answers to write my code, but it's still not working... Can someone point out where i'm doing wrong please? many thanks in advance!
for(j in 1:1000){
for(i in 1:52){
if (i == 1){
r.sims[i,] <- r.sims[1]
}
else if (i == 2){
r.sims[i,] <- r.sims[2]
}
else (i > 2){
r.sims[i,] <- r.sims[i-1,]*ar1 + r.sims[i-2,]*ar2 + e.sims[i,] + e.sims[i-1,]*ma1
}
}
}
i have the following errors
Error: unexpected '{' in:
" }
else (i > 2){"
> r.sims[i,] <- r.sims[i-1,]*ar1 + r.sims[i-2,]*ar2 + e.sims[i,] + e.sims[i-1,]*ma1
Error in r.sims[i, ] <- r.sims[i - 1, ] * ar1 + r.sims[i - 2, ] * ar2 + :
replacement has length zero
> }
Error: unexpected '}' in " }"
>
> }
Error: unexpected '}' in " }"
>
> }
Error: unexpected '}' in " }"
>
Without understanding what your code is supposed to do, I have nevertheless made an example of how you might fix your script. I think the key is that you need to supply curly brackets {...} following your else statement in order for it to consider the following code.
Example:
r.sims <- matrix(runif(52)*100, nrow=52, ncol=100)
e.sims <- matrix(runif(52)*100, nrow=52, ncol=100)
ma1 <- 1
ar1 <- 2
ar2 <- 3
for(j in 1:1000) {
for(i in 1:52) {
if (i == 1) {
r.sims[i,] <- r.sims[1]
} else {
if(i == 2) {
r.sims[i,] <- r.sims[2]
} else {
if(i > 2) {
r.sims[i,] <- r.sims[i-1,]*ar1 + r.sims[i-2,]*ar2 + e.sims[i,] + e.sims[i-1,]*ma1
}
}
}
}
}
You seem to misunderstand the concept of else.
else covers all cases that didn't match previous if or else if statements.
Therefore, you cannot specify any condition for else.
To cover all cases where i is not 1 or 2 simply use else, without any () brackets.
If you want to have a condition, use else if (condition).