This function obtains the probability for the Bivariate Poisson distribution under the parameterization of Lakshminarayana et. al (1993).
dBP_Laksh(x, l1, l2, alpha, log = FALSE)
rBP_Laksh(n, l1, l2, alpha, max_val_x1 = NULL, max_val_x2 = NULL)
vector or matrix of quantiles. When x
is a matrix,
each row is taken to be a quantile and columns correspond to the number of dimensions p
.
mean for the marginal \(X_1\) variable with Poisson distribution.
mean for the marginal \(X_2\) variable with Poisson distribution.
third parameter.
logical; if TRUE
, densities d are given as log(d).
number of random observations.
maximum value for \(X_1\) that is expected, by default it is 100.
maximum value for \(X_2\) that is expected, by default it is 100.
Returns the density for a given data x
.
Lakshminarayana, J., Pandit, S. N., & Srinivasa Rao, K. (1999). On a bivariate Poisson distribution. Communications in Statistics-Theory and Methods, 28(2), 267-276.
# Example 1 ---------------------------------------------------------------
# Probability for single values of X1 and X2
dBP_Laksh(c(0, 0), l1=3, l2=4, alpha=1)
#> [1] 0.001625049
dBP_Laksh(c(1, 0), l1=3, l2=4, alpha=1)
#> [1] 0.003283848
dBP_Laksh(c(0, 1), l1=3, l2=4, alpha=1)
#> [1] 0.004540631
# Probability for a matrix the values of X1 and X2
x <- matrix(c(0, 0,
1, 0,
0, 1), ncol=2, byrow=TRUE)
x
#> [,1] [,2]
#> [1,] 0 0
#> [2,] 1 0
#> [3,] 0 1
dBP_Laksh(x=x, l1=3, l2=4, alpha=1)
#> [1] 0.001625049 0.003283848 0.004540631
# Checking if the probabilities sum 1
val_x1 <- val_x2 <- 0:50
space <- expand.grid(val_x1, val_x2)
space <- as.matrix(space)
l1 <- 3
l2 <- 4
alpha <- -1.27
probs <- dBP_Laksh(x=space, l1=l1, l2=l2, alpha=alpha)
sum(probs)
#> [1] 1
# Example 2 ---------------------------------------------------------------
# Heat map for a BP_Laksh
l1 <- 1
l2 <- 2
correct_alpha_BP_Laksh(l1=l1, l2=l2)
#> $min_alpha
#> [1] -2.97445
#>
#> $max_alpha
#> [1] 2.97445
#>
alpha <- -2.9
X1 <- 0:10
X2 <- 0:10
data <- expand.grid(X1=X1, X2=X2)
data$Prob <- dBP_Laksh(x=data, l1=l1, l2=l2, alpha=alpha)
data$X1 <- factor(data$X1)
data$X2 <- factor(data$X2)
library(ggplot2)
ggplot(data, aes(X1, X2, fill=Prob)) +
geom_tile() +
scale_fill_gradient(low="darkgreen", high="pink")
# Example 3 ---------------------------------------------------------------
# Generating random values and moment estimations
l1 <- 1
l2 <- 2
correct_alpha_BP_Laksh(l1=l1, l2=l2)
#> $min_alpha
#> [1] -2.97445
#>
#> $max_alpha
#> [1] 2.97445
#>
alpha <- -2.7
x <- rBP_Laksh(n=500, l1, l2, alpha)
moments_estim_BP_Laksh(x)
#> l1_hat l2_hat alpha_hat_cor
#> 0.9880 2.0460 -2.4809
# Example 4 ---------------------------------------------------------------
# Estimating the parameters using the loglik function
# Loglik function
llBP_Laksh <- function(param, x) {
l1 <- param[1] # param: is the parameter vector
l2 <- param[2]
alpha <- param[3]
sum(dBP_Laksh(x=x, l1=l1, l2=l2, alpha=alpha, log=TRUE))
}
# The known parameters
l1 <- 1
l2 <- 2
correct_alpha_BP_Laksh(l1=l1, l2=l2)
#> $min_alpha
#> [1] -2.97445
#>
#> $max_alpha
#> [1] 2.97445
#>
alpha <- -2.7
set.seed(12345)
x <- rBP_Laksh(n=500, l1=l1, l2=l2, alpha=alpha)
# To obtain reasonable values for alpha
theta <- as.numeric(moments_estim_BP_Laksh(x))
theta
#> [1] 1.1020 1.9640 -2.7606
# To create start parameters
min_alpha <- correct_alpha_BP_Laksh(l1=theta[1],
l2=theta[2])$min_alpha
max_alpha <- correct_alpha_BP_Laksh(l1=theta[1],
l2=theta[2])$max_alpha
start_param <- theta
names(start_param) <- c("l1_hat", "l2_hat", "alpha_hat")
start_param
#> l1_hat l2_hat alpha_hat
#> 1.1020 1.9640 -2.7606
# Estimating parameters
res1 <- optim(fn = llBP_Laksh,
par = start_param,
lower = c(0.001, 0.001, min_alpha),
upper = c( Inf, Inf, max_alpha),
method = "L-BFGS-B",
control = list(maxit=100000, fnscale=-1),
x=x)
res1
#> $par
#> l1_hat l2_hat alpha_hat
#> 1.101373 1.957413 -2.566542
#>
#> $value
#> [1] -1507.214
#>
#> $counts
#> function gradient
#> 11 11
#>
#> $convergence
#> [1] 0
#>
#> $message
#> [1] "CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH"
#>
# Analizing example of Laksh (1999) ---------------------------------------
x <- rep(0:5, each=6)
y <- rep(0:5, times=6)
freq <- c(7, 41, 54, 40, 21, 9,
36, 79, 83, 59, 30, 13,
39, 70, 69, 47, 25, 10,
24, 41, 39, 26, 14, 6,
10, 18, 18, 11, 6, 2,
3, 6, 6, 4, 2, 1)
seed_plants <- NULL
for (i in 1:36) {
temp <- matrix(c(x[i], y[i]), ncol=2, nrow=freq[i], byrow=TRUE)
seed_plants <- rbind(seed_plants, temp)
}
head(seed_plants)
#> [,1] [,2]
#> [1,] 0 0
#> [2,] 0 0
#> [3,] 0 0
#> [4,] 0 0
#> [5,] 0 0
#> [6,] 0 0
# Exploring some statistics
colMeans(seed_plants)
#> [1] 1.692466 2.013416
var(seed_plants)
#> [,1] [,2]
#> [1,] 1.5540857 -0.1539278
#> [2,] -0.1539278 1.7343240
cor(seed_plants)
#> [,1] [,2]
#> [1,] 1.00000000 -0.09375929
#> [2,] -0.09375929 1.00000000
# Moment estimators
moments_estim_BP_Laksh(seed_plants)
#> l1_hat l2_hat alpha_hat_cor
#> 1.6925 2.0134 -1.3230
# Correct interval for alpha according to l1_hat and l2_hat
correct_alpha_BP_Laksh(l1=1.6925, l2=2.0134)
#> $min_alpha
#> [1] -2.114373
#>
#> $max_alpha
#> [1] 2.114373
#>
# Finding the log-likelihood estimators using
optim(fn = llBP_Laksh,
par = c(1.6925, 2.0134, -1.3230),
lower = c(0.0001, 0.0001, -2.114373),
upper = c(Inf, Inf, 2.114373),
method = "L-BFGS-B",
control = list(maxit=100000, fnscale=-1),
x=seed_plants)
#> $par
#> [1] 1.698306 2.016876 -1.383463
#>
#> $value
#> [1] -3142.296
#>
#> $counts
#> function gradient
#> 12 12
#>
#> $convergence
#> [1] 0
#>
#> $message
#> [1] "CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH"
#>