3d гистограмма бросков монеты приводит к R

Question

Моя цель состоит в том, чтобы сгенерировать гистограмму 3d вероятности получения определенного количества голов в первой и второй последовательности из четырех подбрасываний монет.

Моя идея проста:

• используйте expand.grid, чтобы взять декартово произведение вероятностей определенного числа головок в первой и второй последовательности

• примените операцию продукта к каждому элементу в декартовом произведении, чтобы получить вероятность того, что столько головок в первом И столько головок во втором. Я думаю, что проблема в этом шаге.

• показать их в 3D гистограмме.

Но я получаю очень запутанный вывод, который не могу понять:

Я ожидаю и получу с барами ниже в крайних значениях (трудно получить 0 голов в первом И во втором) и высоко в середине (легче получить 2 головы в первом И во втором).

require("plot3D")

x <- c(1, 4, 6, 4, 1)/8
y <- c(1, 4, 6, 4, 1)/8

prod <- function( arr ) { return (arr[1]*arr[1])}

z <- as.matrix(apply(expand.grid(x,y), c(1,2), prod))

print(z)
##  Plot as a 3D histogram:
hist3D(z=z, border="black")

Кроме того, вывод expand.grid выглядит слишком линейным, вместо таблицы, поскольку декартово произведение должно:

    Var1  Var2
1  0.125 0.125
2  0.375 0.125
3  0.375 0.125
4  0.125 0.125
5  0.125 0.375
6  0.375 0.375
7  0.375 0.375
8  0.125 0.375
9  0.125 0.375
10 0.375 0.375
11 0.375 0.375
12 0.125 0.375
13 0.125 0.125
14 0.375 0.125
15 0.375 0.125
16 0.125 0.125

Answer 1

Учитывая x и y - количество голов в 1-й и 2-й последовательности подбрасываний монет соответственно из независимых биномиальных распределений .

Вам необходимо оценить z как совместное распределение вероятностей по сетке x и y, где x, y € {0,1,2 , 3,4}

require("plot3D")

x_val <- 0:4                    # No of heads in 1st sequence of flips
y_val <- 0:4                    # No of heads in 2nd sequence of flips

px <- c(1, 4, 6, 4, 1)/16       # probability vector for no of flips 
py <- c(1, 4, 6, 4, 1)/16       # in 1st and 2nd sequence of flips

grid_prob <- mesh(px, py)
z  <- with(grid_prob, x*y)      # sum(z) should equal 1 to be a pdf

# Plot as a 3D histogram:
hist3D(z=z, border="black", x = x_val , y = y_val)