R/GTau.R

In ujaen-statistics/ThemAAs:

#' @export
GTau<- function(object,VProportions, alpha){
  UseMethod("GTau",object)
}


#' @name GTau
#' @title Inference of the statistic Tau
#' @description General function that groups the inference of the statistic Tau. This function is made up of:
#' the statistic Tau is ...
#' the standard deviation is the square root of the Tau variance,
#' the confidence interval for Tau statistic to confidence level 95 \% by default.
#' @usage GTau(object, VProportions, alpha)
#' @param object a coMa object (confusion matrix object)
#' @param VProportions a vector of proportions of dimensions \eqn{1 \times k}
#' @param alpha Significance level

#' @details ...
#' @return \code{GTau} returns a list with the following elements:
# #' \item{Statistic Tau - the value of the statistic Tau.}
# #' \item{Standard deviation of Tau - the square root of the Tau variance.}
# #' \item{Confidence intervals - the confidence interval for Tau statistic to confidence level 95% by default.}
#' @references ...
#' @examples
#' #Let evaluate the inference of statistic Tau.
#' ## 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)))
#' v <- cbind(c(0.2,0.2,0.2,0.2))
#' ## Inference of statistic Tau
#' InfTau <- GTau(x, v, 0.02) # By default alpha = 0.05
#' @export

GTau.coMa <- function(object, VProportions = NULL, alpha = 0.05){
  if (!inherits(object,"coMa"))
    stop("object must be a coMa object")
  x<-object$data
  nc <- nrow(x)
  N <-sum(x)
  if(is.null(VProportions) == TRUE) VProportions <- rep(1/nc, nc)

  # UnWeighted marginals (quantities)
  Margcol <- colSums(x)
  Margrow <- rowSums(x)

  # In %
  x <- x/N

  # UnWeighted marginals (prob)
  pcol <- colSums(x)
  prow<- rowSums(x)


  O1 <- sum(diag(x))
  O2 <- sum(VProportions*pcol)
  O3 <- sum(diag(x)*(VProportions+pcol))
  mintermedia1<- matrix(rep(pcol, nc), nrow =nc, ncol=nc, byrow=FALSE)
  mintermedia2<- matrix(rep(VProportions, nc), nrow =nc, ncol=nc, byrow=TRUE)
  mintermedia3 <-(mintermedia1+mintermedia2)^2
  O4 <- sum(x*mintermedia3)

  t1<- (1-O1)
  t2<- (1-O2)
  t3<- O1*t1/(t2^2)
  t4<- 2*t1*(2*O1*O2-O3)/(t2^3)
  t5<- (t1^2)*(O4-4*O2^2)/(t2^4)

  Tau <- (O1-O2)/t2
  VarTau <- (t3+t4+t5)/N
  SdTau <- sqrt(VarTau)
  IC <- c(Tau-SdTau*qnorm(1 - alpha/2), Tau+SdTau*qnorm(1 - alpha/2))

  ans = list(
    Tau = Tau,
    StandarDeviation.Tau = SdTau,
    Confidence.Interval = IC
  )
  class(ans)<-"GTau"
  return(ans)
}

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