CODEWITHSUNDEEP
rconditional-statements
richpiana
richpiana

Reputation: 421

Extend conditions in a dynamic way

I am trying to build a decision table. At time 3 for example I have to take the previous results in time t=1 and time t=2 in order to make my decision in time 3. The decision table is going to be pretty big so I am considering an efficient way to do it by building a function. For instance at time 3: 

rm(list=ls())   # clear memory
names <- c("a","b","c","d","e","f","g","h","i","j","k50","l50","m50","n50","o50")

proba <- c(1,1,1,1,1,1,1,1,1,1,0.5,0.5,0.5,0.5,0.5)
need <- 4
re <- 0.5
w <- 1000000000

  # t1
  t1 <- as.integer(names %in% (sample(names,need,prob=proba,replace=F)))

  # t2
  t2 <- rep(t1)

  # t3
  proba3 <- ifelse(t2==1,proba*re,proba)
  t3 <- as.integer(names %in% (sample(names,need,prob=proba3,replace=F)))

Now the table is going to be big until t=7 with proba7 which takes condition from t=1 to t=6. After t=7 it always takes the 6 previous outcomes plus the random part proba in order to make decision. In other words the ifelse must be dynamic in order that I can call it later. I have been trying something like 

probF <- function(a){
  test <- ifelse(paste0("t",a,sep="")==1,proba*re,proba)
  return(test)
}

test <- probF(2)

but there is an error as I got just one value and not a vector. I know that it looks complicated

For the conditions requested by one person (i know it's not very good written) : 

proba7 <- ifelse(t2==1 & t3==1 & t4==0 & t5==0 & t6==0,proba,
                 ifelse(t2==1 & t3==0 & t4==0 & t5==1 & t6==1,proba*re,
                        ifelse(t2==1 & t3==0 & t4==0 & t5==0 & t6==1, w,
                               ifelse(t2==0 & t3==1 & t4==1 & t5==0 & t6==0,proba,
                                      ifelse(t2==0 & t3==1 & t4==1 & t5==1 & t6==0,0,
                                             ifelse(t2==0 & t3==0 & t4==1 & t5==1 & t6==1,0,
                                                    ifelse(t2==0 & t3==0 & t4==1 & t5==1 &t6==0,0,
                                                           ifelse(t2==0 & t3==0 & t4==0 & t5==1 & t6==1, proba*re,
                                                                  ifelse(t2==0 & t3==0 & t4==0 & t5==0 & t6==1,w,proba)))))))))

t7 <- as.integer(names %in% (sample(names,need,prob=proba7,replace=F)))

Upvotes: 0

Views: 147

Answers (1)

Joris Meys
Joris Meys

Reputation: 108613

If you take a bit of a different approach, you'll gain quite a lot of speed.

First of all, it is really a terribly bad idea to store every step as a separate t1, proba1, etc. If you need to keep all that information, predefine a matrix or list of the right size and store everything in there. That way you can use simple indices instead of having to resort to the bug-prone use of get(). If you find yourself typing get(), almost always it's time to stop and rethink your solution.

Secondly, you can use a simple principle to select the indices of the test t:

seq(max(0, i-7), i-1)

will allow you to use a loop index i and refer to the 6 previous positions if they exist.

Thirdly, depending on what you want, you can reformulate your decision as well. If you store every t as a row in the matrix, you can simply use colSums() and check whether that one is larger than 0. Based on that index, you can update the probabilities in such a way that a 1 in any of the previous 6 rows halfs the probability.

wrapping everything in a function would then look like :

myfun <- function(names, proba, need, re,
                  w=100){

  # For convenience, so I don't have to type this twice
  resample <- function(p){
    as.integer(
      names %in% sample(names,need,prob=p, replace = FALSE)
    )
  } 
  # get the number of needed columns
  nnames <- length(names)

  # create two matrices to store all the t-steps and the probabilities used
  theT <- matrix(nrow = w, ncol = nnames)
  theproba <- matrix(nrow = w, ncol = nnames)

  # Create a first step, using the original probabilities
  theT[1,] <- resample(proba)
  theproba[1,] <- proba

  # loop over the other simulations, each time checking the condition
  # recalculating the probability and storing the result in the next
  # row of the matrices

  for(i in 2:w){

    # the id vector to select the (maximal) 6 previous rows. If 
    # i-6 is smaller than 1 (i.e. there are no 6 steps yet), the
    # max(1, i-6) guarantees that you start minimal at 1.
    tid <- seq(max(1, i-6), i-1)

    # Create the probability vector from the original one
    p <- proba
    # look for which columns in the 6 previous steps contain a 1
    pid <- colSums(theT[tid,,drop = FALSE]) > 0
    # update the probability vector
    p[pid] <- p[pid]*0.5

    # store the next step and the used probabilities in the matrices
    theT[i,] <- resample(p)
    theproba[i,] <- p

  }

  # Return both matrices in a single list for convenience
  return(list(decisions = theT,
              proba = theproba)
  )
}

which can be used as:

myres <- myfun(names, proba, need, re, w)
head(myres$decisions)
head(myres$proba)

This returns you a matrix where every row is one t-point in the decision table.

Upvotes: 1

Related Questions