Как преобразовать распределение частот в распределение вероятности в R

Question

У меня есть матрица с n рядами наблюдений. Наблюдения представляют собой частотные распределения функций. Я хотел бы преобразовать частотные распределения в распределения вероятностей, где сумма каждой строки равна 1. Поэтому каждый элемент в матрице должен быть разделен на сумму строки элемента.

я написал следующую функцию R, что делает работу, но это очень медленно, с большими матрицами:

prob_dist <- function(x) { 

    row_prob_dist <- function(row) { 
     return (t(lapply(row, function(x,y=sum(row)) x/y))) 
     } 

    for (i in 1:nrow(x)) { 
     if (i==1) p_dist <- row_prob_dist(x[i,]) 
     else p_dist <- rbind(p_dist, row_prob_dist(x[i,])) 
     } 
    return(p_dist) 
} 

B = matrix(c(2, 4, 3, 1, 5, 7), nrow=3, ncol=2) 
B 
    [,1] [,2] 
[1,] 2 1 
[2,] 4 5 
[3,] 3 7 

prob_dist(B) 
    [,1]  [,2]  
[1,] 0.6666667 0.3333333 
[2,] 0.4444444 0.5555556 
[3,] 0.3  0.7  

Не могли бы вы предложить функцию R, что делает работу и/или сказать мне, как я могу оптимизировать мои функции выполнять быстрее?

Answer 1

Вот попытка, но на dataframe вместо матрицы:

df <- data.frame(replicate(100,sample(1:10, 10e4, rep=TRUE))) 

Я попробовал dplyr подход:

library(dplyr) 
df %>% mutate(rs = rowSums(.)) %>% mutate_each(funs(./rs), -rs) %>% select(-rs) 

Вот результаты:

library(microbenchmark) 
mbm = microbenchmark(
dplyr = df %>% mutate(rs = rowSums(.)) %>% mutate_each(funs(./rs), -rs) %>% select(-rs), 
t = t(t(df)/rep(rowSums(df), each=ncol(df))), 
apply = t(apply(df, 1, prop.table)), 
times = 100 
) 

#> mbm 
#Unit: milliseconds 
# expr  min  lq  mean median  uq  max neval 
# dplyr 123.1894 124.1664 137.7076 127.3376 131.1523 445.8857 100 
#  t 384.6002 390.2353 415.6141 394.8121 408.6669 787.2694 100 
# apply 1425.0576 1520.7925 1646.0082 1599.1109 1734.3689 2196.5003 100 

Edit: @David тест является более в соответствии с ФП, так что я предлагаю вам рассмотреть свой подход, если вы хотите работать с матрицами.

Answer 2

Без применять, Векторизованное решение в одной строке:

t(t(B)/rep(rowSums(B), each=ncol(B))) 
      [,1]  [,2] 
[1,] 0.6666667 0.3333333 
[2,] 0.4444444 0.5555556 
[3,] 0.3000000 0.7000000 

Или:

diag(1/rowSums(B)) %*% B 

Answer 3

Я не уверен, что ваша функция имеет никакого значения, так как вы могли бы просто использовать hist или density функции для достижения того же результата. Кроме того, использование apply будет работать, как упомянуто. Но это служит разумным примером программирования.

В вашем коде есть несколько недостатков.

• Вы используете цикл for вместо векторизации кода. Это очень дорого. Вы должны использовать заявку, как указано в комментариях выше.

• Вы используете rbind вместо предварительного выделения пространства для вашего вывода. Это тоже очень дорого.

  out <- matrix(NA, nrow= n, ncol= ncol(B)) 
  for (i in 1:nrow(B)) { 
      out[i,] <- row_prob_dist(B[i,]) 
  } 
  

Answer 4

На самом деле я дал ему быструю мысль и лучший vecotization бы просто

B/rowSums(B) 
#   [,1]  [,2] 
# [1,] 0.6666667 0.3333333 
# [2,] 0.4444444 0.5555556 
# [3,] 0.3000000 0.7000000 

На самом деле @Stevens тест вводит в заблуждение, потому что OP имеет матрицу, в то время как Стивен тест на кадр данных.

Вот эталон с матрицей.Таким образом, для матриц, как Векторизованное решение будет лучше, чем dplyr, который не работает с матрицами

set.seed(123) 
m <- matrix(sample(1e6), ncol = 100) 

library(dplyr) 
library(microbenchmark) 

Res <- microbenchmark(
    dplyr = as.data.frame(m) %>% mutate(rs = rowSums(.)) %>% mutate_each(funs(./rs), -rs) %>% select(-rs), 
    t = t(t(m)/rep(rowSums(m), each=ncol(m))), 
    apply = t(apply(m, 1, prop.table)), 
    DA = m/rowSums(m), 
    times = 100 
)