R/imrr.R

In sdap: Statistical Data Preparation Indicators

#'  Imputation Rate for responded items IMRR
#'
#' Version of (\code{\link[sdap]{imr}}) for responded items. Imputation rate due to changes in items which were initially responded. Indirect measure of the overall impact of the controls, i.e. of the error detection and localization followed by imputation.
#' @author Beat Hulliger - Juan Berdugo
#' @param r1ij (mandatory): A matrix containing the response indicators for a given dataframe. r1ij can be calculated using the function \code{\link[sdap]{rind}}.
#' @param bij (optional): A matrix containing the structurally missingness indicators. bij can be calculated using the function \code{\link[sdap]{smind}}. If the argument bij is missing, the indicator irr is calculated without considering a misingness indicators matrix.
#' @param gij (mandatory): A matrix containing the imputation indicators for a given dataframe. gij can be calculated using the function \code{\link[sdap]{impind}}.
#' @param obsi (optional): A vector with the observations in r1ij to to be processed. If the argument obs is missing, all observations are processed.
#' @param varj (optional): A vector with the variables (column numbers) to be considered for the calculation. If the argument varj is missing, all variables are considered for the indicator.
#' @param weight (optional): A vector of weights to be considered when calculating the indicator. If no weight vector is given as an argument, the indicator is calculated without considering different weights.
#' @return A list with the following elements: variables (variables), observations (observations), Indicator IMRR (imrr).
#' @export


imrr <- function(r1ij,bij,gij,obsi=1:nrow(gij),varj=1:ncol(gij),weight)

{

  #obsi<-1:nrow(gij)
  #varj=var.sie
  #r1ij<- r14ij
  n <- length(obsi)
  p <- length(varj)

  if (missing(weight)) weight <- rep(1,n)

  #Check existence of r1ij

  if (missing(r1ij)) {
    cat("Missing r1ij!\n")
    break
  }


  #Check existence of gij

  if (missing(gij)) {
    cat("Missing gij!\n")
    break
  }

  #Check existence of bij

  if (missing(bij)) {
    cat("Missing bij!\n")
    break
  }

  #store the size of r1ij, bij and gij

  sizer1ij <- dim(r1ij)
  sizebij <- dim(bij)
  sizegij <- dim(gij)


  #check if the sizes of r1ij, bij and gij match


  if (identical(sizebij,sizegij)==FALSE)
  {
    print("The sizes of r1ij, bij, and gij do not match. Please recalculate.")
    break
  }

  if (identical(sizer1ij,sizegij)==FALSE)
  {
    print("The sizes of r1ij, bij and gij do not match. Please recalculate.")
    break
  }

  # Calculate denominator of the function. If it is zero, return zero and break.

  if (length(varj)==1)
  {
    denominator <- weighted.mean((1-bij[obsi,varj]),w=weight)
  }else
  {
    denominator <- weighted.mean(apply((1-bij[obsi,varj]),1,mean),w=weight)
  }


  if(denominator==0)
  {
    imrr.value <- 0
    return(imrr.value)
    break
  }

  # Calculate IMRR.

  if (length(varj)==1)
    {
    imrr.value = weighted.mean((r1ij[obsi,varj]*(1-bij[obsi,varj])*gij[obsi,varj]),w=weight)
    }else
    {
    imrr.value = weighted.mean(apply((r1ij[obsi,varj]*(1-bij[obsi,varj])*gij[obsi,varj]),1,mean),w=weight)
    }

  imrr.value = imrr.value / denominator
  imrr.value<- list(variables = varj, observations = obsi, imrr=imrr.value )
  return(imrr.value)
}