R/GKappaW.R

In ujaen-statistics/ThemAAs:

#' @export
GKappaW<- function(object, MP){
  UseMethod("GKappaW",object)
}


#' @name GKappaW
#' @title Inference of the statistic Weight Kappa
#' @description General function that groups the inference of the statistic Weight Kappa. This function is made up of:
#' the statistic Weight Kappa,
#' the standard deviation is the square root of the Weight Kappa variance,
#' the coeficiente de variacion....
#' @usage GKappaW(object, MP)
#' @param object a coMa object (confusion matrix object)
#' @param MP a matrix of weights of dimensions \eqn{k \times k}
#' @details ...
#' @return \code{GKappaW} returns a list with the following elements:
# #' \item{Statistic Weight Kappa - the value of the statistic Weight Kappa.}
# #' \item{Standard deviation of Weight Kappa - the square root of the Weight Kappa variance}
# #' \item{Coeficiente de variacion - COMPLETAR}
#' @references COMPLETAR
#' @examples
#' #Let evaluate the inference of statistic Weight Kappa.
#' ## Confusion matrix included in Congalton and Green (2009), pg. 108.
#' x <- coMa(cbind(c(65,6,0,4),c(4,81,11,7),c(22,5,85,3),c(24,8,19,90)))
#' MP <- cbind(c(1,0,1,0.91),c(0,1,0,0),c(0.67,0,1,0.61),c(1,0,1,1))
#' ## Inference of statistic Weight Kappa
#' InfKappa <- GKappaW(x,MP)
#' @export

#Funcion general que aprupa la inferencia sobre el estad?stico kappa ponderado
GKappaW.coMa <- function(object, MP, normalized=TRUE){
  if (!inherits(object,"coMa"))
    stop("object must be a coMa object")
  if (sum(MP)!=1 && normalized==TRUE)
    stop("Weight matrix must sum 1")
  x<-object$data
  nc <- nrow(x)
  N <-sum(x)

  # In %
  x <- x/N

  # UnWeighted marginals (prob)
  pcol <- apply(x,2,sum)
  prow <- apply(x,1,sum)

  # Weighted matrix
  Wx<-x*MP

  # The 4 coefficients
  Ow1 <- sum(MP*x)
  Ow2 <- sum(t(MP*prow)*pcol)
  c1<- (1-Ow1)
  c2<- (1-Ow2)
  wi_ <- MP %*% pcol
  w_j <- MP %*% prow
  mintermedia1<- matrix(rep(wi_, nc), nrow =nc, ncol=nc, byrow=FALSE)
  mintermedia2<- matrix(rep(w_j, nc), nrow =nc, ncol=nc, byrow=TRUE)
  mintermedia3 <-(mintermedia1+mintermedia2)*c1
  mintermedia4 <- (MP*c2-mintermedia3)^2
  Ow4 <- sum(x*mintermedia4)

  K <- (Ow1-Ow2)/c2
  SdK <- sqrt((Ow4-(Ow1*Ow2-2*Ow2+Ow1)^2)/(N*(c2^4)))
  CV <- SdK/K

  ans<-list(Weight.Kappa=K, Sd.Weight.Kappa=SdK, CV=CV)
  class(ans)<-"GKappaW"
  return(ans)
}

#' @method print GKappaW
#' @export
print.GKappaW<-function(x, ...){
  function (x, ...){
    if (!inherits(x, "GKappa")){
      stop("x not is a coMa object")
    }else{
      cat("Object class coMa\n")
      cat("GKappa\n")
    }
  }
}