Question

我正在R中开发一个（复杂的）CTMC模型（R中的初学者），以模拟鱼的8个不同身体部位的寄生虫负荷（计数）的分布；假设寄生虫可以从一个身体部位随机移动到另一个身体部位。从下面的简单代码块开始，它可以模拟CTMC，但在尝试重复多次（对于某些运行）时，会在下面返回错误。

Error in sample.int(x, size, replace, prob) : too few positive
probabilities

警告消息：

In rexp(1, Qt) : NAs produced

我意识到，Q（矩阵）中的大多数速率值均为零，因此，在这种情况下进行采样会返回诸如错误的结果。我想知道是否有任何纠正此错误的方法，以便多次运行该模型而没有此类错误。

为简单起见，我从以下代码开始：

Fishsim_model <- function(b,d,m,X0,Ti){
  #b=birth rate; d=death rate; m=movement rate; Ti=finishing time
  #X0=initial distribution; X= states 
  X <- X0
  Ti <- floor(Ti)
  ti <- 0 # (initial) time
  day <- 1

 saved <- matrix(0, Ti+1, 8) #Matrix of zeros to save final results
  saved[day,] <- X0

  Q <- rep(0, 36) # vector of rates
  Qt <- 0 # Qt = sum(Q) is departure rate from current state

  while (ti < Ti){
    #Calculate rates
    Q[1]<-X[1]*b
    Q[2]<-X[2]*b
    Q[3]<-X[3]*b
    Q[4]<-X[4]*b
    Q[5]<-X[5]*b
    Q[6]<-X[6]*b
    Q[7]<-X[7]*b
    Q[8]<-X[8]*b
    Q[9]<-X[1]*d
    Q[10]<-X[2]*d
    Q[11]<-X[3]*d
    Q[12]<-X[4]*d
    Q[13]<-X[5]*d
    Q[14]<-X[6]*d
    Q[15]<-X[7]*d
    Q[16]<-X[8]*d
    Q[17]<-X[1]*m
    Q[18]<-X[3]*m/3
    Q[19]<-X[4]*m/5
    Q[20]<-X[6]*m/2
    Q[21]<-X[4]*m/5
    Q[22]<-X[5]*m/2
    Q[23]<-X[2]*m/2
    Q[24]<-X[5]*m/2
    Q[25]<-X[3]*m/2
    Q[26]<-X[2]*m/2
    Q[27]<-X[3]*m/3
    Q[28]<-X[7]*m/2
    Q[29]<-X[8]*m/2
    Q[30]<-X[4]*m/5
    Q[31]<-X[4]*m/4
    Q[32]<-X[7]*m/2
    Q[33]<-X[6]*m/2
    Q[34]<-X[8]*m/2
    Q[35]<-X[3]*m/4
    Q[36]<-X[4]*m/5 
     Qt <- sum(Q) 

    # time for next jump
    ti <- ti + rexp(1, Qt)
    # new state
    j <- sample(36, 1, prob = Q)

    if (j == 1) {
      X[1] <- X[1] + 1
    } else if (j==2){
      X[2]<- X[2]+1
    } else if (j==3){
      X[3]<-X[3]+1
    } else if (j==4){
      X[4]<-X[4]+1
    } else if (j==5){
      X[5]<-X[5]+1
    } else if (j==6){
      X[6]<-X[6]+1
    } else if (j==7){
      X[7]<-X[7]+1
    } else if (j==8){
      X[8]<-X[8]+1
    } else if (j==9){
      X[1]<-X[1]-1
    } else if (j==10){
      X[2]<-X[2]-1
    } else if (j==11){
      X[3]<-X[3]-1
    } else if (j==12){
      X[4]<-X[4]-1
    } else if (j==13){
      X[5]<-X[5]-1
    } else if (j==14){
      X[6]<-X[6]-1
    } else if (j==15){
      X[7]<-X[7]-1
    }else if (j==16){
      X[8]=X[8]-1
    } else if (j==17){
      X[1]=X[1]-1
      X[3]=X[3]+1
    } else if (j==18){
      X[1]=X[1]+1
      X[3]=X[3]-1
    } else if (j==19){
      X[4]=X[4]-1
      X[6]=X[6]+1
    } else if (j==20){
      X[4]=X[4]+1
      X[6]=X[6]-1
    } else if (j==21){
      X[4]=X[4]-1
      X[5]=X[5]+1
    } else if (j==22){
      X[4]=X[4]+1
      X[5]=X[5]-1
    } else if (j==23){
      X[2]=X[2]-1
      X[5]=X[5]+1
    } else if (j==24){
      X[2]=X[2]+1
      X[5]=X[5]-1
    } else if (j==25){
      X[3]=X[3]-1
      X[2]=X[2]+1
    } else if (j==26){
      X[3]=X[3]+1
      X[2]=X[2]-1
    } else if (j==27){
      X[3]=X[3]-1
      X[7]=X[7]+1
    } else if (j==28){
      X[3]=X[3]+1
      X[7]=X[7]-1
    } else if (j==29){
      X[8]=X[8]-1
      X[4]=X[4]+1
    } else if (j==30){
      X[8]=X[8]+1
      X[4]=X[4]-1
    } else if (j==31){
      X[4]=X[4]-1
      X[7]=X[7]+1
    } else if (j==32){
      X[4]=X[4]+1
      X[7]=X[7]-1
    } else if (j==33){
      X[6]=X[6]-1
      X[8]=X[8]+1
    } else if (j==34){
      X[6]=X[6]+1
      X[8]=X[8]-1
    } else if (j==35){
      X[3]=X[3]-1
      X[4]=X[4]+1
    } else if (j==36){
      X[3]=X[3]+1
      X[4]=X[4]-1
    }

    day.old <- day #Keep track of previous days
    day=ceiling(ti)
    if (day > day.old){ 
      saved[(day.old+1):day,] <- 
        matrix(saved[day.old,], (day - day.old), 8, byrow=TRUE) # What was this intended to achieve?
      saved[day,] <- X
      cat("day =", day, X, "\n")
      #cat('day:', sprintf('%7.4f',day.old), ' tail:', X[1], ' Anal:', X[2], ' LB:', X[3],' UB:',
      #    X[4],' Pelvic:', X[5],' Pectoral:', X[6],' dorsal:', X[7],' Head:', X[8], '\n')
    }
  }
  return(saved)   
}


#Suppose parasite prefer tail
b <- 0.5    #birth rate per day
d <- 0.14  #death rate  
m <- 0.3  #movement rate
X0 <- c(2,0,0,0,0,0,0,0)# initial condition of gyro that prefers the tail
Ti <- 17  #finishing time

#set.seed(12)
Results <- Fishsim_model(b, d, m, X0, Ti)
Results

Answer 1

两条错误消息都建议在某些时候Q向量中的所有值均为0，这将导致第一个错误。示例：sample(3,1, prob = c(0,0,0))。

因此，u传递给指数分布随机生成器的速率（Qt）也为0，并且返回NaN，这导致了第二个错误。范例：rexp(1,0)

不幸的是，我难以阅读您的代码，所以我对其进行了重构。您可以在下面找到与示例输入配合使用的增强版本。我的猜测是某个地方出错导致Q变为0状态，您可以使用一些打印语句和调试功能对其进行跟踪。您可以进一步重构这段代码，使其更具可读性和性能。

通常，您可以研究初始输入的数学条件，以确保Q矢量永远不会处于0状态。我不确定您是否也在寻找如何执行此操作的指示。 HTH

CHANGE_MATRIX <- matrix(
  c(-1, 0, 1, 0, 0, 0, 0, 0
  , 1, 0, -1, 0, 0, 0, 0, 0
  , 0, 0, 0, -1, 0, 1, 0, 0
  , 0, 0, 0, 1, 0, -1, 0, 0
  , 0, 0, 0, -1, 1, 0, 0, 0
  , 0, 0, 0, 1, -1, 0, 0, 0
  , 0, -1, 0, 0, 1, 0, 0, 0
  , 0, 1, 0, 0, -1, 0, 0, 0
  , 0, 1, -1, 0, 0, 0, 0, 0
  , 0, -1, 1, 0, 0, 0, 0, 0
  , 0, 0, -1, 0, 0, 0, 1, 0
  , 0, 0, 1, 0, 0, 0, -1, 0
  , 0, 0, 0, 1, 0, 0, 0, -1
  , 0, 0, 0, -1, 0, 0, 0, 1
  , 0, 0, 0, -1, 0, 0, 1, 0
  , 0, 0, 0, 1, 0, 0, -1, 0
  , 0, 0, 0, 0, 0, -1, 0, 1
  , 0, 0, 0, 0, 0, 1, 0, -1
  , 0, 0, -1, 1, 0, 0, 0, 0
  , 0, 0, 1, -1, 0, 0, 0, 0)
  , ncol = 8
  , byrow = T
)

UPDATE_LOCATION <- c(1, 3, 4, 6, 4, 5
                     , 2, 5, 3, 2, 3, 7
                     , 8, 4, 4, 7, 6, 8
                     , 3, 4)

UPDATE_WEIGHT <- c(1, 3, 5, 2, 5, 2
                   , 2, 2, 2, 2, 3, 2
                   , 2, 5, 4, 2, 2, 2
                   , 4, 5)

UPDATE_INDEX <- seq(17, 36)

BODY_PARTS <- c(' Tail'
                ,' Anal'
                ,' LB'
                ,' UB'
                ,' Pelvic'
                ,' Pectoral'
                ,' dorsal'
                ,' Head')


Fishsim_model <- function(b,d,m,X0,Ti){
  #b=birth rate; d=death rate; m=movement rate; Ti=finishing time
  #X0=initial distribution; X= states 
  X <- X0
  Ti <- floor(Ti)
  ti <- 0 # (initial) time
  day <- 1

  saved <- matrix(0, Ti+1, 8) #Matrix of zeros to save final results
  saved[day,] <- X0

  Q <- vector('numeric', 36)
  Qt <- 0 # Qt = sum(Q) is departure rate from current state

  while (ti < Ti){
    #Calculate rates
    Q[1:8] <- X*b
    Q[9:16] <- X*d
    Q[UPDATE_INDEX]<-X[UPDATE_LOCATION[seq_along(UPDATE_INDEX)]]*
      (m*(1/UPDATE_WEIGHT[seq_along(UPDATE_INDEX)]))

    Qt <- sum(Q) 

    # time for next jump
    ti <- ti + rexp(1, Qt)

    # new state
    j <- sample(36, 1, prob = Q)

    if (j <= 8) {
      X[j] <- X[j] + 1
    } else if (j <= 16){
      X[j-8] <- X[j-8] - 1
    } else{
      X <- X + CHANGE_MATRIX[j-16, ]
    }


    day.old <- day #Keep track of previous days
    day <- ceiling(ti)

    if (day > day.old){

      # What was this intended to achieve?
      # saved[(day.old+1):day,] <- matrix(saved[day.old,]
      #                                   , (day - day.old)
      #                                   , 8
      #                                   , byrow=TRUE)

      saved[day, ] <- X
      cat(
          paste('day:', day)
          , '\n'
          , paste(BODY_PARTS, ':', X)
          , '\n'
      )

    }

  }

  return(saved)   
}


#Suppose parasite prefer tail
b <- 0.5    #birth rate per day
d <- 0.14  #death rate  
m <- 0.3  #movement rate
X0 <- c(2,0,0,0,0,0,0,0)# initial condition of gyro that prefers the tail
Ti <- 17  #finishing time

#set.seed(12)
Results <- Fishsim_model(b, d, m, X0, Ti)
Results

Answer 2

我已经能够找出解决办法，以防止在此收到的先前建议为基础的错误。这将帮助我多次运行模型而没有任何错误消息。我只需要打破比率总和等于0时的运行循环。下面是我需要包含在代码中的一行代码；

enter code here


Qt=sum(Q)

if (Qt == 0) break #Just this line code to help break the loop and return to the next


ti <- ti + rexp(1,Qt)
j=sample(152,1,prob=Q)

开发连续时间马尔可夫链模型以模拟R中鱼上寄生虫的分布（计数）

2 个答案: