Question

a是一个矩阵，

a<- matrix(c("A","B","0","1","A","C","D","B","A","C","0","D","B","1","C","D"),4)

> a
     [,1] [,2] [,3] [,4]
[1,] "A"  "A"  "A"  "B" 
[2,] "B"  "C"  "C"  "1" 
[3,] "0"  "D"  "0"  "C" 
[4,] "1"  "B"  "D"  "D"

我们发现矩阵a中有四种类型的字符，分别是“A”，“B”，“C”和“D”。现在我们假设每个角色有40％的可能性变成三个角色的其余部分之一。例如，“A”有40％的可能性变成“B”，“C”或“D”; “B”有40％的可能性变成“A”，“C”或“D”; ......

我使用以下代码和种子集，答案是正确的。

set.seed(2016)
pob <- 0.4 
a[a=="A"] <- ifelse(runif(sum(a=="A")) <= pob, sample(c(1:4)[-1],sum(a=="A"),replace = T), 1)
a[a=="B"] <- ifelse(runif(sum(a=="B")) <= pob, sample(c(1:4)[-2],sum(a=="B"),replace = T), 2)
a[a=="C"] <- ifelse(runif(sum(a=="C")) <= pob, sample(c(1:4)[-3],sum(a=="C"),replace = T), 3)
a[a=="D"] <- ifelse(runif(sum(a=="D")) <= pob, sample(c(1:4)[-4],sum(a=="D"),replace = T), 4)

a[a==1] <- "A"
a[a==2] <- "B"
a[a==3] <- "C"
a[a==4] <- "D"

> a
     [,1] [,2] [,3] [,4]
[1,] "B"  "A"  "B"  "C" 
[2,] "D"  "C"  "A"  "A" 
[3,] "0"  "B"  "0"  "C" 
[4,] "C"  "A"  "D"  "D"

但我想知道是否有更容易解决这个问题的方法，提前谢谢。

Modified

由于矩阵a中没有字符“0”和“1”，我需要更改原始代码，如下所示：

set.seed(2016)
pob <- 0.4 
a[a=="A"] <- ifelse(runif(sum(a=="A")) <= pob, sample(c(1:4)[-1],sum(a=="A"),replace = T), "one")
a[a=="B"] <- ifelse(runif(sum(a=="B")) <= pob, sample(c(1:4)[-2],sum(a=="B"),replace = T), "two")
a[a=="C"] <- ifelse(runif(sum(a=="C")) <= pob, sample(c(1:4)[-3],sum(a=="C"),replace = T), "three")
a[a=="D"] <- ifelse(runif(sum(a=="D")) <= pob, sample(c(1:4)[-4],sum(a=="D"),replace = T), "four")

a[a=="one"] <- "A"
a[a=="two"] <- "B"
a[a=="three"] <- "C"
a[a=="four"] <- "D"

> a
     [,1] [,2] [,3] [,4]
[1,] "2"  "3"  "A"  "1" 
[2,] "B"  "2"  "C"  "1" 
[3,] "0"  "D"  "0"  "1" 
[4,] "1"  "B"  "2"  "2"

Answer 1

如果我理解正确，下面的代码可以做你想要的，除了奇异的0和1。

a <- matrix(c("A","B","0","1","A","C","D","B","A","C","0","D","B","1","C","D"),4)

# states that are subjected to mutation
s <- c('A', 'B', 'C', 'D')
# matrix of transition prob
b <- matrix(1, nrow = 4, ncol = 4, dimnames = list(s, NULL))
diag(b) <- 0

# mutation prob
prob <- 0.4

# sites that can be changed
indx <- a %in% s
a[indx] <- ifelse(
    runif(sum(indx)) > prob,
    a[indx],
    sapply(a[indx], function(i) sample(s, 1, prob = b[i, ]))
)

根据特定规则更改矩阵中的字符

1 个答案: