以动态方式扩展条件

时间:2016-02-22 15:37:59

标签: r conditional-statements

我正在尝试建立一个决策表。例如,在时间3,我必须在时间t = 1和时间t = 2时采用先前的结果,以便在时间3做出我的决定。决策表将会非常大,所以我正在考虑一种有效的方法它通过构建一个功能。例如,在时间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)))

现在这个表在t = 7之前会很大,而proba7的条件是从t = 1到t = 6。在t = 7之后,它总是需要先前的6个结果加上随机部分proba才能做出决定。换句话说,ifelse必须是动态的,以便我稍后可以调用它。我一直在尝试像

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

test <- probF(2)

但是有一个错误,因为我只得到一个值而不是向量。我知道它看起来很复杂

对于一个人要求的条件(我知道它写得不是很好):

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)))

1 个答案:

答案 0 :(得分:1)

如果你采取一些不同的方法,你将获得相当快的速度。

首先,将每个步骤存储为单独的t1,proba1等确实是一个非常糟糕的主意。如果您需要保留所有信息,请预定义矩阵或正确大小的列表并将所有内容存储在那里。这样你就可以使用简单的索引,而不必诉诸于get()的容易出错的使用。如果您发现自己键入get(),几乎总是有时间停下来并重新考虑您的解决方案。

其次,您可以使用一个简单的原则来选择测试t的索引:

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

允许您使用循环索引i并参考之前的6个位置(如果存在)。

第三,根据你的需要,你也可以重新制定你的决定。如果将每个t作为一行存储在矩阵中,则可以简单地使用colSums()并检查该值是否大于0.基于该索引,您可以以任意方式更新概率前6行中概率的一半。

将函数中的所有内容包装起来如下:

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)
  )
}

可以用作:

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

这会返回一个矩阵,其中每一行都是决策表中的一个t点。