R/test222.R

In pzwiernik/LatentClass: Estimation of the latent class model for discrete data

#' Internal function to check if a 2x2x2 distribution lies in LC(2) model
#'
#' This function check if a 2x2x2 distribution lies in LC(2) model. 
#' @param counts   A (2,2,2) array with counts. 
#' @keywords exact MLE
#' @export
#' @examples
#' r <- c(2,2,2,2)
#' k <- 3
#' sample.Theta(r,k)

test222 <- function(p,tol=1e-8){
  test <- (p[1,1,1]*p[1,2,2]-p[1,2,1]*p[1,1,2]>-tol)*(p[2,1,1]*p[2,2,2]-p[2,2,1]*p[2,1,2]>-tol)*
    (p[1,1,1]*p[2,1,2]-p[2,1,1]*p[1,1,2]>-tol)*(p[1,2,1]*p[2,2,2]-p[2,2,1]*p[1,2,2]>-tol)*
    (p[1,1,1]*p[2,2,1]-p[2,1,1]*p[1,2,1]>-tol)*(p[1,1,2]*p[2,2,2]-p[2,1,2]*p[1,2,2]>-tol)
  test <- test + (p[2,1,1]*p[2,2,2]-p[2,2,1]*p[2,1,2]>-tol)*(p[1,1,1]*p[1,2,2]-p[1,2,1]*p[1,1,2]>-tol)*
    (p[2,1,1]*p[1,1,2]-p[1,1,1]*p[2,1,2]>-tol)*(p[2,2,1]*p[1,2,2]-p[1,2,1]*p[2,2,2]>-tol)*
    (p[2,1,1]*p[1,2,1]-p[1,1,1]*p[2,2,1]>-tol)*(p[2,1,2]*p[1,2,2]-p[1,1,2]*p[2,2,2]>-tol)
  test <- test + (p[1,2,1]*p[1,1,2]-p[1,1,1]*p[1,2,2]>-tol)*(p[2,2,1]*p[2,1,2]-p[2,1,1]*p[2,2,2]>-tol)*
    (p[1,2,1]*p[2,2,2]-p[2,2,1]*p[1,2,2]>-tol)*(p[1,1,1]*p[2,1,2]-p[2,1,1]*p[1,1,2]>-tol)*
    (p[1,2,1]*p[2,1,1]-p[2,2,1]*p[1,1,1]>-tol)*(p[1,2,2]*p[2,1,2]-p[2,2,2]*p[1,1,2]>-tol)
  test <- test + (p[1,1,2]*p[1,2,1]-p[1,2,2]*p[1,1,1]>-tol)*(p[2,1,2]*p[2,2,1]-p[2,2,2]*p[2,1,1]>-tol)*
    (p[1,1,2]*p[2,1,1]-p[2,1,2]*p[1,1,1]>-tol)*(p[1,2,2]*p[2,2,1]-p[2,2,2]*p[1,2,1]>-tol)*
    (p[1,1,2]*p[2,2,2]-p[2,1,2]*p[1,2,2]>-tol)*(p[1,1,1]*p[2,2,1]-p[2,1,1]*p[1,2,1]>-tol)
  return(test)
}