Заполните диагональ и диагональ + 1 в матрице - PullRequest
Новая
       4

Заполните диагональ и диагональ + 1 в матрице

0 голосов
/ 21 сентября 2019

Я хочу матрицу с 0 везде, а диагональ и диагональ +1 имеют 0,5 значения.

Я создаю матрицу со следующим кодом: 

n = 10
transProbs = matrix(0, nrow = n, ncol = n)

Затем заполняя диагональс: 

diag(transProbs) = 0.5

Матрица теперь выглядит следующим образом: 

      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]  0.5  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.0
 [2,]  0.0  0.5  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.0
 [3,]  0.0  0.0  0.5  0.0  0.0  0.0  0.0  0.0  0.0   0.0
 [4,]  0.0  0.0  0.0  0.5  0.0  0.0  0.0  0.0  0.0   0.0
 [5,]  0.0  0.0  0.0  0.0  0.5  0.0  0.0  0.0  0.0   0.0
 [6,]  0.0  0.0  0.0  0.0  0.0  0.5  0.0  0.0  0.0   0.0
 [7,]  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.0  0.0   0.0
 [8,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.0   0.0
 [9,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5   0.0
[10,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.5

Однако я хочу, чтобы это было: 

      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.0
 [2,]  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0   0.0
 [3,]  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0   0.0
 [4,]  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0   0.0
 [5,]  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0   0.0
 [6,]  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0   0.0
 [7,]  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0   0.0
 [8,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5   0.0
 [9,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5   0.5
[10,]  0.5  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.5

Редактировать:

Эта матрица будет использоваться в library(HMM), initHMM в качестве матрицы transProbs.

Мой желаемый вывод для emissionProbs: 

      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]  0.2  0.2  0.2  0.0  0.0  0.0  0.0  0.0  0.2   0.2
 [2,]  0.2  0.2  0.2  0.2  0.0  0.0  0.0  0.0  0.0   0.2
 [3,]  0.2  0.2  0.2  0.2  0.2  0.0  0.0  0.0  0.0   0.0
 [4,]  0.0  0.2  0.2  0.2  0.2  0.2  0.0  0.0  0.0   0.0
 [5,]  0.0  0.0  0.2  0.2  0.2  0.2  0.2  0.0  0.0   0.0
 [6,]  0.0  0.0  0.0  0.2  0.2  0.2  0.2  0.2  0.0   0.0
 [7,]  0.0  0.0  0.0  0.0  0.2  0.2  0.2  0.2  0.2   0.0
 [8,]  0.0  0.0  0.0  0.0  0.0  0.2  0.2  0.2  0.2   0.2
 [9,]  0.2  0.0  0.0  0.0  0.0  0.0  0.2  0.2  0.2   0.2
[10,]  0.2  0.2  0.0  0.0  0.0  0.0  0.0  0.2  0.2   0.2

Обратите внимание, что это diag +/- 2, который заполнен 0,2.В первой матрице это diag +1, который заполнен 0,5.Это означает, что в итоге вероятности могут «перекрываться» и попадать в левый нижний угол.

Ответы [ 5 ]

4 голосов
/ 21 сентября 2019

diag(transProbs[,-1]) = 0.5 сделает это

В моем терминале вывод: 

transProbs
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.0
 [2,]  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0   0.0
 [3,]  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0   0.0
 [4,]  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0   0.0
 [5,]  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0   0.0
 [6,]  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0   0.0
 [7,]  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0   0.0
 [8,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5   0.0
 [9,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5   0.5
[10,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.5

После этого вы можете добавить последний "из ниоткуда" 0.5 с помощью: transProbs[10, 1] = 0.5

1 голос
/ 21 сентября 2019

Другое решение, использующее тот факт, что матрицы - это векторы с атрибутом dim.

n <- 10
m <- 10
transProbs = matrix(0.0, nrow = n, ncol = m)

diag(transProbs) <- 0.5
transProbs[(1:(m - 1)) * (n + 1)] <- 0.5
transProbs
#>       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#>  [1,]  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.0
#>  [2,]  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0   0.0
#>  [3,]  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0   0.0
#>  [4,]  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0   0.0
#>  [5,]  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0   0.0
#>  [6,]  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0   0.0
#>  [7,]  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0   0.0
#>  [8,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5   0.0
#>  [9,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5   0.5
#> [10,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.5

Создано в 2019-09-21 пакетом представ. (v0.3.0)

Последовательность (1:(m - 1)) * (n + 1) выбирает всематричные элементы один от диагонали.

Редактировать

Вы можете добиться того, чтобы вы спрашивали при редактировании, беря остаток модуля той же последовательности (плюс смещение) по отношению к общему количеству элементов всумма, т.е. 

n <- 10
m <- 10
transProbs = matrix(0.0, nrow = n, ncol = m)

diag(transProbs) <- 0.2
transProbs[((1:m) * (n + 1)) %% (n * m)] <- 0.2
transProbs[((1:m) * (n + 1) + m) %% (n * m)] <- 0.2
transProbs[((1:m) * (n + 1) + 7 * m) %% (n * m)] <- 0.2
transProbs[((1:m) * (n + 1) + 8 * m) %% (n * m)] <- 0.2

transProbs
#>       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#>  [1,]  0.2  0.2  0.2  0.0  0.0  0.0  0.0  0.0  0.2   0.2
#>  [2,]  0.2  0.2  0.2  0.2  0.0  0.0  0.0  0.0  0.0   0.2
#>  [3,]  0.2  0.2  0.2  0.2  0.2  0.0  0.0  0.0  0.0   0.0
#>  [4,]  0.0  0.2  0.2  0.2  0.2  0.2  0.0  0.0  0.0   0.0
#>  [5,]  0.0  0.0  0.2  0.2  0.2  0.2  0.2  0.0  0.0   0.0
#>  [6,]  0.0  0.0  0.0  0.2  0.2  0.2  0.2  0.2  0.0   0.0
#>  [7,]  0.0  0.0  0.0  0.0  0.2  0.2  0.2  0.2  0.2   0.0
#>  [8,]  0.0  0.0  0.0  0.0  0.0  0.2  0.2  0.2  0.2   0.2
#>  [9,]  0.2  0.0  0.0  0.0  0.0  0.0  0.2  0.2  0.2   0.2
#> [10,]  0.2  0.2  0.0  0.0  0.0  0.0  0.0  0.2  0.2   0.2

Создано в 2019-09-21 с помощью представительного пакета (v0.3.0)

Вы можете определитьзначение сдвига (т. е. +m, +7m и +8m) для столбца, в котором начинается последовательность, и вычитания 2. Например, чтобы сгенерировать последовательность, которая начинается в третьем столбце, необходимо сложить (3 - 2)*mчто просто m.

Надеюсь, все ясно.

0 голосов
/ 21 сентября 2019

Я бы использовал матричную индексацию (позволяет заменять строки в соответствии с «координатами»);если вы посмотрите на исходный код diag<- (print(`diag<-`)), вы увидите, что он делает это для более простого случая только по диагонали. 

NN = nrow(transProbs)
idx = seq_len(NN)
transProbs[cbind(idx, idx)] = .5 # replace diagonal
transProbs[cbind(idx[-NN], idx[-NN] + 1L)] = .5 # replace off-diagonal

transProbs
#       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#  [1,]  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.0
#  [2,]  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0   0.0
#  [3,]  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0   0.0
#  [4,]  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0   0.0
#  [5,]  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0   0.0
#  [6,]  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0   0.0
#  [7,]  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0   0.0
#  [8,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5   0.0
#  [9,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5   0.5
# [10,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.5

Вы также можете сделать это за один [<- вызов, но это немного уродливее / сложнее для чтения: 

transProbs[cbind(c(idx, idx[-NN]), c(idx, idx[-NN] + 1L))] = .5

Это может быть немного более эффективным, но потому что только первый [<- вызов копирует transProbs (см. ?tracemem и .Internal(inspect(transProbs))), я думаю, что разница должна быть небольшой.

0 голосов
/ 21 сентября 2019

Сначала создайте функцию для смещения вектора влево и вправо (обратите внимание - почти наверняка есть библиотека или функция, которая уже делает это, но я не смог ее найти!) 

shiftSeq <- function(n, shift){
    #return vector 1:n, but start shifted
    # e.g. shiftSeq(5,shift=1) returns c(2,3,4,5,1)
    # e.g. shiftSeq(5,shift=-1) returns c(5,1,2,3,4)

    if(shift>=1){
        res <- c((shift+1):n, 1:(shift))
    } else if(shift==0){
        res <- 1:n
    } else{
        res <- c((n+1+shift):n, 1:(n+shift))
    }

    return(res)
}

> shiftSeq(5,shift=1)
[1] 2 3 4 5 1

МыЯ буду использовать эту функцию shiftSeq внутри другой функции (ниже).Идея состоит в том, чтобы использовать apply с shiftSeq для смещения каждого из столбцов в диагональной матрице «строительного блока» вверх и вниз, что мы делаем несколько раз, каждый раз накапливая эту смещенную матрицу в матрице результатов.

Ключ для правильной установки rowShift и colShift аргументов ... 

createTranProb <- function(n, prob, rowShift, colShift){
    # create transition probability matrix of size nxn
    #  - prob is non-zero prob
    #  - rowShift is number of rows to move prob down
    #  - colShift is number of cols to move prob to right

    shifts = setdiff(c(-rowShift:colShift), 0)
    matDiag <- diag(n)*prob
    matRes <- matDiag

    for(i in shifts){
        matRes <- matRes +
            apply(matDiag, 2, 
                  function(x) x[shiftSeq(n,i)])
    }
    return(matRes)
}

Работает для случая prob = 0.5: 

> createTranProb(10, 0.5, rowShift=0, colShift=1)
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.0
 [2,]  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0   0.0
 [3,]  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0   0.0
 [4,]  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0   0.0
 [5,]  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0   0.0
 [6,]  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0   0.0
 [7,]  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0   0.0
 [8,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5   0.0
 [9,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5   0.5
[10,]  0.5  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.5

Как это происходитдля prob = 0.2, если мы установим rowShift=2 и colShift=2: 

> createTranProb(10, 0.2, 2, 2)
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]  0.2  0.2  0.2  0.0  0.0  0.0  0.0  0.0  0.2   0.2
 [2,]  0.2  0.2  0.2  0.2  0.0  0.0  0.0  0.0  0.0   0.2
 [3,]  0.2  0.2  0.2  0.2  0.2  0.0  0.0  0.0  0.0   0.0
 [4,]  0.0  0.2  0.2  0.2  0.2  0.2  0.0  0.0  0.0   0.0
 [5,]  0.0  0.0  0.2  0.2  0.2  0.2  0.2  0.0  0.0   0.0
 [6,]  0.0  0.0  0.0  0.2  0.2  0.2  0.2  0.2  0.0   0.0
 [7,]  0.0  0.0  0.0  0.0  0.2  0.2  0.2  0.2  0.2   0.0
 [8,]  0.0  0.0  0.0  0.0  0.0  0.2  0.2  0.2  0.2   0.2
 [9,]  0.2  0.0  0.0  0.0  0.0  0.0  0.2  0.2  0.2   0.2
[10,]  0.2  0.2  0.0  0.0  0.0  0.0  0.0  0.2  0.2   0.2

Ради интереса, я добавил один с prob = 0.33333: 

> createTranProb(10, 0.33333, 1, 1)
         [,1]    [,2]    [,3]    [,4]    [,5]    [,6]    [,7]    [,8]    [,9]   [,10]
 [1,] 0.33333 0.33333 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.33333
 [2,] 0.33333 0.33333 0.33333 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000
 [3,] 0.00000 0.33333 0.33333 0.33333 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000
 [4,] 0.00000 0.00000 0.33333 0.33333 0.33333 0.00000 0.00000 0.00000 0.00000 0.00000
 [5,] 0.00000 0.00000 0.00000 0.33333 0.33333 0.33333 0.00000 0.00000 0.00000 0.00000
 [6,] 0.00000 0.00000 0.00000 0.00000 0.33333 0.33333 0.33333 0.00000 0.00000 0.00000
 [7,] 0.00000 0.00000 0.00000 0.00000 0.00000 0.33333 0.33333 0.33333 0.00000 0.00000
 [8,] 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.33333 0.33333 0.33333 0.00000
 [9,] 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.33333 0.33333 0.33333
[10,] 0.33333 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.33333 0.33333
0 голосов
/ 21 сентября 2019

Мне не нравится это решение, но оно выполняет свою работу: 

element_on_diagonal <- 0.5
element_above_and_below_diaginal <- 0.2

a <- diag(x = element_on_diagonal,
          nrow = 10)

for(i in seq_len(length.out = ncol(x = a)))
{
  temp <- sapply(X = setdiff(x = seq(from = (i - 2),
                                     to = (i + 2)),
                             y = i),
                 FUN = function(j) if (j %in% 1:10) j else if (j != 0) j %% 10 else 10)
  a[temp, i] <- element_above_and_below_diaginal
}

a
#>       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#>  [1,]  0.5  0.2  0.2  0.0  0.0  0.0  0.0  0.0  0.2   0.2
#>  [2,]  0.2  0.5  0.2  0.2  0.0  0.0  0.0  0.0  0.0   0.2
#>  [3,]  0.2  0.2  0.5  0.2  0.2  0.0  0.0  0.0  0.0   0.0
#>  [4,]  0.0  0.2  0.2  0.5  0.2  0.2  0.0  0.0  0.0   0.0
#>  [5,]  0.0  0.0  0.2  0.2  0.5  0.2  0.2  0.0  0.0   0.0
#>  [6,]  0.0  0.0  0.0  0.2  0.2  0.5  0.2  0.2  0.0   0.0
#>  [7,]  0.0  0.0  0.0  0.0  0.2  0.2  0.5  0.2  0.2   0.0
#>  [8,]  0.0  0.0  0.0  0.0  0.0  0.2  0.2  0.5  0.2   0.2
#>  [9,]  0.2  0.0  0.0  0.0  0.0  0.0  0.2  0.2  0.5   0.2
#> [10,]  0.2  0.2  0.0  0.0  0.0  0.0  0.0  0.2  0.2   0.5
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...