# The following function estimates the estimated size & total number of false positives
# of each multivariate outlier procedure for randomly generated multivariate normal with no contamination

library(rstudioapi)

# Setup the working directory
current_path <- getActiveDocumentContext()$path 
setwd(dirname(current_path ))
print( getwd() )

# Clear Environment
remove(list = ls())

# The following packages are required for ATLAfuncObsNum.R #
library(robustbase) # Required for covMcd()
library(Hmisc)
library(DetMCD)

# The following package is require for mvrnorm #
library(MASS) 

# Get functions #
source('ATLAfuncSubets.R') # This function is ATLA by Clarke & Schubert (2006) however it outputs the observation numbers
source('Hadi1994funcNew.R') # This is the method developed by Hadi (1994) 
library(robustX) # Required for mvBACON 
library(fsdaR) # Required for fsmult,mmmult,smult . Note: Requires MATLAB Runtime


library(CVTuningCov) # Required for AR1() function

# Parrallel Computing
library(foreach)
library(doParallel)

numCores <- detectCores()
registerDoParallel(numCores)

# Data Parameters #
pvec = c(2,5,10)  # Variables
nvec = c(25,50,100,200,500,1000) # Sample Sizes Note (n=25 & p=10 not possible for BACON with c*p)
N = 1000 # Number of Simulations

# Algorithm Parameters #
c = 4; # For BACON initial subset size
alphaval = 0.01; # Significance level used for BACON and Hadi1994 (Note FSM uses a fixed 0.01)

# Initialize Matrices that count total number of false positives for N simulations of each (n x p) 
colnam <- paste("n=", nvec, sep="")
rownam <- paste("p=", pvec, sep="")
fpfsm = matrix(NA ,nrow = length(pvec), ncol = length(nvec), dimnames = list(rownam,colnam))
fpatlav1 = matrix(NA, nrow = length(pvec), ncol = length(nvec), dimnames = list(rownam,colnam))
fpatlav2 = matrix(NA, nrow = length(pvec), ncol = length(nvec), dimnames = list(rownam,colnam))
fpbaconv1 = matrix(NA, nrow = length(pvec), ncol = length(nvec), dimnames = list(rownam,colnam))
fpbaconv2 = matrix(NA, nrow = length(pvec), ncol = length(nvec), dimnames = list(rownam,colnam))
fphadi = matrix(NA, nrow = length(pvec), ncol = length(nvec), dimnames = list(rownam,colnam))

# Initialize Matrices that count the frequency of false positives  
fpindfsm = matrix(NA ,nrow = length(pvec), ncol = length(nvec), dimnames = list(rownam,colnam))
fpindatlav1 = matrix(NA, nrow = length(pvec), ncol = length(nvec), dimnames = list(rownam,colnam))
fpindatlav2 = matrix(NA, nrow = length(pvec), ncol = length(nvec), dimnames = list(rownam,colnam))
fpindbaconv1 = matrix(NA, nrow = length(pvec), ncol = length(nvec), dimnames = list(rownam,colnam))
fpindbaconv2 = matrix(NA, nrow = length(pvec), ncol = length(nvec), dimnames = list(rownam,colnam))
fpindhadi = matrix(NA, nrow = length(pvec), ncol = length(nvec), dimnames = list(rownam,colnam))

# The following function is used to output number of observations found by ATLA, BACON & Hadi1994
outfunc <- function(x1) {
  outnum <- x1
  if (length(outnum) == 0) {
    fpnum <- 0
    fpind <- 0
  } else {
    fpnum <- length(outnum)
    fpind <- 1
  }
  list(totalfp=fpnum,fpindicator=fpind)
}

# The following function is used to output number of observations found by FSM
outfuncFSM <- function(x2) {
  outnum2 <- x2
  if (any(is.na(outnum2))) {
    fpnum2 <- 0
    fpind2 <- 0
  } else {
    fpnum2 <- length(outnum2)
    fpind2 <- 1
  }
  list(totalfp=fpnum2,fpindicator=fpind2)
}

rho=0 # Independent
for (i in 1:length(pvec)) {
  p = pvec[i]
  
  for (j in 1:length(nvec)) {
    n = nvec[j]
    
    fsmcount = rep(NA,N)
    atlacountv1 = rep(NA,N)
    atlacountv2 = rep(NA,N)
    baconcountv1 = rep(NA,N)
    baconcountv2 = rep(NA,N)
    hadicount = rep(NA,N)
    
    fsmind = rep(NA,N)
    atlaindv1 = rep(NA,N)
    atlaindv2 = rep(NA,N)
    baconindv1 = rep(NA,N)
    baconindv2 = rep(NA,N)
    hadiind = rep(NA,N)
    
    foreach (k= 1:N) %do% {
      
      samp <- mvrnorm(n,rep(0,p),AR1(p,rho))
      
      fsmout <- fsmult(samp, msg=FALSE)
      atlaoutv1 <- ATLAfuncSubsets(samp,determinMCDind = 0)$flaggedoutliers
      atlaoutv2 <- ATLAfuncSubsets(samp,determinMCDind = 1)$flaggedoutliers
      if (n>=c*p | n>(3*p+1)) {
        baconoutv1 <- mvBACON(samp, m=(c*p),init.sel="Mahalanobis", alpha=1-alphaval, verbose=FALSE)
        baconoutv2 <- mvBACON(samp, m=(c*p),init.sel="dUniMedian", alpha=1-alphaval, verbose=FALSE)
      }
      hadiout <- Hadi1994funcNew(samp, z=alphaval)
      
      fsmcount[k] <- outfuncFSM(fsmout$outliers)$totalfp
      fsmind[k] <- outfuncFSM(fsmout$outliers)$fpindicator
      
      atlacountv1[k] <- outfunc(atlaoutv1)$totalfp
      atlaindv1[k] <- outfunc(atlaoutv1)$fpindicator
      
      atlacountv2[k] <- outfunc(atlaoutv2)$totalfp
      atlaindv2[k] <- outfunc(atlaoutv2)$fpindicator
      
      if (n>=c*p | n>(3*p+1)) {
        baconcountv1[k] <- outfunc(which(!baconoutv1$subset))$totalfp
        baconindv1[k] <- outfunc(which(!baconoutv1$subset))$fpindicator
        
        baconcountv2[k] <- outfunc(which(!baconoutv2$subset))$totalfp
        baconindv2[k] <- outfunc(which(!baconoutv2$subset))$fpindicator
        
        hadicount[k] <- outfunc(as.numeric(rownames(hadiout)))$totalfp
        hadiind[k] <- outfunc(as.numeric(rownames(hadiout)))$fpindicator
      }
      
      
      
    }
    
    fpfsm[i,j] <- sum(fsmcount)
    fpindfsm[i,j] <- sum(fsmind)
    
    fpatlav1[i,j] <- sum(atlacountv1)
    fpindatlav1[i,j] <- sum(atlaindv1)
    
    
    fpatlav2[i,j] <- sum(atlacountv2)
    fpindatlav2[i,j] <- sum(atlaindv2)
    
    if (n>=c*p | n>(3*p+1)) {
      fpbaconv1[i,j] <- sum(baconcountv1)
      fpindbaconv1[i,j] <- sum(baconindv1)
      
      fpbaconv2[i,j] <- sum(baconcountv2)
      fpindbaconv2[i,j] <- sum(baconindv2)
      
      fphadi[i,j] <- sum(hadicount)
      fpindhadi[i,j] <- sum(hadiind)
    }
    
    
  }
  
}


# Total Number of false positives
fpfsm
fpatlav1
fpatlav2
fpbaconv1
fpbaconv2
fphadi

# Total Frequency of false positives
fpindfsm
fpindatlav1
fpindatlav2
fpindbaconv1
fpindbaconv2
fpindhadi

# Proportion of samples with false positve(s)
propfpfsm <- format(round(fpindfsm/N,4),nsmall = 4)
propfpatlav1 <- format(round(fpindatlav1/N,4), nsmall = 4)
propfpatlav2 <- format(round(fpindatlav2/N,4), nsmall = 4)
propfpbaconv1 <- format(round(fpindbaconv1/N,4), nsmall = 4)
propfpbaconv2 <- format(round(fpindbaconv2/N,4), nsmall = 4)
propfphadi <- format(round(fpindhadi/N,4), nsmall = 4)