Here is the code that I am working with:
y <- c(0,5,10)
n <- 9
R <- t(c(2.05, 2.05, 2.05, 2.55, 2.55, 2.55, 2.95, 2.95, 2.95))
R <- (replicate(3,R))
R <- (matrix(R, nrow=3))
R <- t(apply(R,1,sort))
mat <- t(sapply(y, function(test) pmax(seq(test, (test-n+1), -1), 0) ))
mat
P <- replicate(ncol(R),(c(6447.88,6447.88,6447.88)))
EnvTest <- new.env()
EnvTest$Orig <- 548453.5
FuncTest <- function(pp){
EnvTest$Orig <- EnvTest$Orig-(P[,pp]-EnvTest$Orig*R[,pp]/1200)
return(EnvTest$Orig)
}
Test<- rbind(EnvTest$Orig,
do.call(rbind,lapply(1:9, FuncTest)))
x <- t(Test)
x
This produces:
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 548453.5 542942.6 537422.2 531892.4 526574.8 521245.9 515905.7 510726.1 505533.7 500328.6
[2,] 548453.5 542942.6 537422.2 531892.4 526574.8 521245.9 515905.7 510726.1 505533.7 500328.6
[3,] 548453.5 542942.6 537422.2 531892.4 526574.8 521245.9 515905.7 510726.1 505533.7 500328.6
Which is what I am telling the function to do so that is correct. But now I want to use some information from the matrix R*(mat==0) which is:
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
[1,] 2.05 2.05 2.05 2.55 2.55 2.55 2.95 2.95 2.95
[2,] 0.00 0.00 0.00 0.00 0.00 2.55 2.95 2.95 2.95
[3,] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
So I tried to do something like this...
FuncTest2 <- function(pp){
EnvTest$Orig <- ifelse(R*(mat==0)==0,EnvTest$Orig,EnvTest$Orig-(P[,pp]-EnvTest$Orig*R[,pp]/1200))
return(EnvTest$Orig)
}
Test2<- rbind(EnvTest$Orig,
do.call(rbind,lapply(1:9, FuncTest2)))
x2 <- t(Test2)
x2
But that did not produce the desired outcome which is:
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 548453.5 542942.6 537422.2 531892.4 526574.8 521245.9 515905.7 510726.1 505533.7 500328.6
[2,] 548453.5 548453.5 548453.5 548453.5 548453.5 543171.1 538058.5 532933.3 527795.5 522645.1
[3,] 548453.5 548453.5 548453.5 548453.5 548453.5 548453.5 548453.5 548453.5 548453.5 548453.5
So basically if R*(mat==0) = 0 then EnvTest$Orig <- 548453.5 does not change until the R*(mat==0) is greater than zero the EnvTest$Orig does update.
Another Attempt
I also tried to do the following, but it did not work but I think that something along these lines will prove fruitful.
maybe <- R*(mat==0)
FuncTest2 <- function(pp, maybe){
EnvTest$Orig <- if(maybe == 0) (EnvTest$Orig-0) else
(EnvTest$Orig-(P[,pp]-EnvTest$Orig*R[,pp]/1200))
return(EnvTest$Orig)
}
Test2<- rbind(EnvTest$Orig,
do.call(rbind,lapply(1:9, FuncTest2)))
x2 <- t(Test2)
x2
Firstly, with respect to your FuncTest() and FuncTest2() computations, R is a constant, as it is not modified during those function calls or by the surrounding data manipulation (referring to the do.call()/rbind()/t() stuff). This is R:
R;
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
## [1,] 2.05 2.05 2.05 2.55 2.55 2.55 2.95 2.95 2.95
## [2,] 2.05 2.05 2.05 2.55 2.55 2.55 2.95 2.95 2.95
## [3,] 2.05 2.05 2.05 2.55 2.55 2.55 2.95 2.95 2.95
As you can see, none of its elements are zero. This means that the expression
R*(mat==0)==0
is equivalent to
mat!=0
since multiplication by R cannot turn a non-zero value into zero, or turn a zero into a non-zero value.
If you still want to parameterize the ifelse() conditional on R, perhaps because you may want to run this code for different values of R that can contain zeroes, then it should be rewritten as
R==0|mat!=0
Secondly, your code has a bit of a suspicious pattern with respect to the dimensionality of the state variable EnvTest$Orig. You initialize it to a one-element vector (548453.5), but on first run of FuncTest() it is immediately overwritten with a three-element vector, where the initial scalar was cycled 3 times to accommodate the three-element vectors P[,pp] and R[,pp]. From that point forward it is permanently a three-element vector. In FuncTest2() (first attempt), since mat and R are 3x9 matrices, the true and false arguments of the ifelse() vectorized ternary will be cycled to cover that dimensionality, and then EnvTest$Orig will be overwritten by the resulting 3x9 matrix. From that point forward it is permanently a 3x9 matrix.
You should probably think carefully about what dimensionality you want for EnvTest$Orig and stick to that from beginning to end. Judging from your expected output, it looks like you want it to be a vector of length 3, and thus you should be indexing the matrix in the ifelse() conditional:
FuncTest2 <- function(pp) {
EnvTest$Orig <- ifelse(R[,pp]==0|mat[,pp]!=0,EnvTest$Orig,EnvTest$Orig-(P[,pp]-EnvTest$Orig*R[,pp]/1200));
return(EnvTest$Orig);
};
EnvTest$Orig <- 548453.5;
Test2 <- rbind(EnvTest$Orig,do.call(rbind,lapply(1:9,FuncTest2)));
x2 <- t(Test2);
x2;
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,] 548453.5 542942.6 537422.2 531892.4 526574.8 521245.9 515905.7 510726.1 505533.7 500328.6
## [2,] 548453.5 548453.5 548453.5 548453.5 548453.5 548453.5 543171.1 538058.5 532933.3 527795.6
## [3,] 548453.5 548453.5 548453.5 548453.5 548453.5 548453.5 548453.5 548453.5 548453.5 548453.5
However, this result does not exactly match your expected output in the second row, and I'm not sure why.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With