开发一个连续时间马尔可夫链模型来模拟R区鱼类寄生虫的分布（计数）

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

警告信息：

我意识到，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

---

Fishsim_model两条错误消息都表明，在某一点上，Q向量中的所有值都是0，这导致了第一个错误。示例：
sample（3,1，prob=c（0,0,0））

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

不幸的是，你的代码对我来说很难阅读，所以我重构了它。您可以在下面找到一个扩展版本，它与示例输入一起工作。我的猜测是，某个地方有一个错误导致Q处于0状态，您可以使用一些打印语句和调试功能来跟踪它。您可以进一步重构这段代码，使其更具可读性和性能

通常，您可以研究初始输入的数学条件，以确保Q向量永远不会处于0状态。我不确定你是否也在寻找如何做到这一点的指针。
嗯

CHANGE\u MATRIX我已经找到了防止错误发生的方法，这是基于之前在这里收到的建议。这将帮助我在没有任何错误消息的情况下多次运行模型。我只需要在速率之和等于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)

在此处输入代码
Qt=总和（Q）
如果（Qt==0）break#只需这行代码就可以帮助中断循环并返回下一个循环
太棒了。它似乎工作得很好，一切都被完全理解了。我试着复制了大约100次代码，只是为了看看这样的错误是否不会像以前那样出现。但在复制时，该错误似乎出现了100次。这些是使用replicate（100，Fishsim_模型（b，d，m，X0，Ti））尝试至少100次复制时产生的错误：sample.int中的错误（x，size，replace，prob）：正概率太少我的主要问题是如何防止Q向量占用0，以便在使用rexp（）更新时间时避免NAs。在跑了10多次之后，这种症状似乎一直存在。
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

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

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)