specify dynamic array indexes programmatically - r

I'd like to generalize this code to handle an array of any number of dimensions but I'm not sure how to specify array indexes programatically. I think its possible with some combination of paste eval substitute quote but I can't figure it out.
x <- array(runif(1000),dim=c(10,10,10))
w <- vector("list")
for (i in seq(dim(x)[1]))
{
w[i] <- list(which(x[i,,] == max(x[i,,]),arr.ind=TRUE))
}
for (i in seq(dim(x)[1]))
{
# looking for something like:
# s <- paste(i,",",paste(w[[i]],collapse=","),sep="")
# v <- x[s]
v <- x[i,w[[i]][[1]],w[[i]][[2]]]
print(paste("the max at index",i,"is",round(v,4)),quote=FALSE)
}

nvm, figured out how to do it
x <- array(runif(1000),dim=c(10,10,10))
w <- vector("list")
for (i in seq(dim(x)[1]))
{
w[i] <- list(which(x[i,,] == max(x[i,,]),arr.ind=TRUE))
}
for (i in seq(dim(x)[1]))
{
v <- do.call(`[`,c(list(x,i),w[[i]]))
print(paste("the max at index",i,"is",round(v,4)),quote=FALSE)
}

Related

How to indicate the level of the for loop in R

Suppose I have a function including a for loop part. This for loop will work for, say, 10 iteration. How can I know from the result that the function is working now at level (iteration) number, say, 5.
That is, I would like my function to let me know the current iteration number.
For example,
I would like the result to be such this:
Iteration 1 starts
some result
iteration 1 ends
iteration 2 starts
some result
iteration 2 ends
...
...
Please note this is not my original function. In my original function I use optim function over a list of models, and I really need to know what is the current model.
Here is a general example:
Myfun <- function(x,y){
v <- list()
for(i in 1:100){
v[[i]] <- sum(x[[i]], y[[i]])
cat(v, "\n")
}
v
}
x <- rnorm(100)
y <- rnorm(100)
Myfun(x=x, y=y)
Method 1
Output the current iteration step inside the for loop.
Myfun <- function(x,y) {
v <- list()
for (i in 1:100) {
v[[i]] <- sum(x[[i]], y[[i]])
cat(sprintf("Step %i / 100 done\n", i))
}
v
}
Method 2
Use a progress bar (see ?txtProgressBar for details).
Myfun <- function(x,y) {
v <- list()
pb <- txtProgressBar(min = 0, max = 100, style = 3)
for (i in 1:100) {
v[[i]] <- sum(x[[i]], y[[i]])
setTxtProgressBar(pb, i)
}
close(pb)
v
}
Note that the line cat(v, "\n") from your original Myfun will give an error.

Limit the values used in a function to their sum

I created a function with that I want to calculate (several) vectors of data.
Actually the vctors should be for a range (1:100) for one variable while the others stay constant at differnt values in turn.
The function is:EI <- function(x,y,z) {(x+y)/(2*(2*x+y)+z)}
my Problem is, the sum of x+y+z has to be limited to 100. And i don't know how to tell it the function.
For example, if x = 20, y can only take values from 0:80 , i.e. (100-20), and z can takey values from 0 : 100-(x+y).
I used the following code where z is not regarded all. I thought, I would get at least one large vector, but all I get is a single number:
for(x in 1:100) {
for(y in 0:(100-x)) {
for(z in 0:(100-(x+y))) {
v1 <- c(EI(x,y,z))
}
}
}
I need to tell the function EI() that the sum of x+y+z has alwys to be 100.
Has anybody an idea how to solve this problem?
If you want to create a vector you need to do that:
v1 <- c()
for(x in 1:100) {
for(y in 0:(100-x)) {
for(z in 0:(100-(x+y))) {
v1 <- c(v1, EI(x,y,z))
}
}
}
Unfortunately this will be slow (because at each step you are reallocating a new vector), a better alternative is to begin by allocate your vector with the appropriate size:
v1 <- numeric(171700)
k <- 0
for(x in 1:100) {
for(y in 0:(100-x)) {
for(z in 0:(100-(x+y))) {
k <- k + 1
v1[k] <- EI(x,y,z)
}
}
}
You can also write the same thing with sapply function and this is slightly faster:
v1 <- unlist(sapply(1:100,
function(x) {
unlist(sapply(0:(100-x),
function(y) {
sapply(0:(100-(x+y)),
function(z) {EI(x,y,z)}) }))}))

General code for a summation in R

I'm writing some code in R and I came across following problem:
Basically, I want to calculate a variable X[k], where X takes on values for each k, like this:
where A is a known variable which takes on different values for each index.
For the moment, I have something like this:
k <- NULL
X <- NULL
z<- 1: n
for (k in seq(along =z)){
for (j in seq (along = 1:k)){
X[k] = 1/k*sum(A[n-k]/A[n-j+1])
}
}
which can't be right. Any idea on how to fix this one?
As always, any help would be dearly appreciated.
Try this
# define A
A <- c(1,2,3,4)
n <- length(A)
z <- 1:n
#predefine X (don't worry, all values will be overwritten, but it will have the same length as A
X <- A
for(k in z){
for(j in 1:k){
X[k] = 1/k*sum(A[n-k]/A[n-j+1])
}
}
You don't need to define z, it is only used inside the for. In this case, do for(k in 1:n){
As
You can do the following
set.seed(42)
A <- rnorm(10)
k <- sample(length(A), 4)
calc_x <- function(A, k){
n <- length(A)
c_sum <- cumsum(1/rev(A)[1:max(k)])
A[n-k]/k * c_sum[k]
}
calc_x(A,k)
what returns:
[1] 0.07775603 2.35789999 -0.45393983 0.13323284

Using If trying to get a vector a certain length

I'm trying to use if function to create a vector X that follows the pattern of the if statement, that is length 5. However, when I print X, I get 5 vectors with length 1. How do I fix this
for (i in 1:5) {
if (i <2){
a<-i
}
else {
a<-(i-1)
}
X<-a
print(X)
}
R overwrites the contents of your variables a and X with each loop. To avoid this, you can make X a list, and put your value in a different position with each loop.
X <- list()
a <- list()
for(i in 1:5) {
if(i<2){
a <- i
} else {
a <- i-1
}
X[i] <- a
}
Since your final plan is to create a vector, you may initialize a vector ("X") first, and then add a value ("a") in each 'for' loop.
X = vector("numeric",0)
for (i in 1:5){
if (i<2){
a <- i
}
else{
a <- (i-1)
}
X = c(X, a)
print(X)
}
X
# [1] 1 1 2 3 4

looping through a matrix with a function

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

Resources