# install.packages("devtools",repos = "http://cran.us.r-project.org")
library(devtools)

# install_git("https://www.gitlab.ci.inf.usi.ch/SQUIC/SQUIC_R.git")
library(SQUIC)

# install.packages("Matrix",repos = "http://cran.us.r-project.org")
library(Matrix)

# install.packages("MLmetrics",repos = "http://cran.us.r-project.org")
library(MLmetrics)

# install.packages("glasso",repos = "http://cran.us.r-project.org")
library(glasso)

# install.packages("BigQuic",repos = "http://cran.us.r-project.org")
library(BigQuic)

# devtools::install_github("cescwang85/EQUAL")
library(EQUAL)

source("load_data.R")
source("compare.R")
# ================================================================== #
#  Evaluate the accuracy in the estimation of precision matrices     #
#  when using a matrix tuning parameter                              #
# ================================================================== #
# c         = noise level (additional nonzeros)
# lambda    = scalar tuning parameter
# eta_set   = \eta parameter in the estimation of the matrix M
# p         = the dimensions of the dataset in question
# n         = number of samples
# tol       = termination tolerance of the algorithms
# max_iter  = maximum number of iterations for all algorithms
test_accuracy_M <- function(X_star,data,c,rho,lambda,eta_set){

  p<-dim(data)[1]
  n<-dim(data)[2]

  # Set the structure of M to be that of X_star 
  # !! Assuming the true preicsion matrix is very large and sparse
  # Than FP and FN will not interact. 

  # Get structure of matrix and remove all zeros
  X_star_u  <- triu(X_star,1)
  M_struc   <- X_star_u
  s         <- nnzero(X_star_u)

  # FN: Incorrectly set nonzeros to zero
  FN             <- round(rho*s)
  inx            <- sample(x=c(1:s),size=FN,replace = FALSE)
  M_struc@x[inx] <- 0 
  M_struc        <-  drop0(M_struc) # remove zero values

  # FP: Incorrectly set zeros to nonzero
  FP       <- round(c*s);

  # Note that 'nnz=FP' for 'symmetric=TRUE' represents the number of non-zero entries in the matrix 
  # in the upper triangular part, including the diagonal. As the matrix is large, we do not expect
  # too many random entries on the diagonal.
  M_struc  <- M_struc + triu(rsparsematrix(nrow=p,ncol=p,nnz=FP,symmetric=TRUE),1)

  #Make sure diag is included 
  M_struc   <- forceSymmetric(M_struc)
  M_struc   <- M_struc + Diagonal(p)
  M_struc@x <- M_struc@x*0+1

  metric_f1  <- c()
  for (i in 1:length(eta_set)) {
    print(paste("Benchmark for eta=",eta_set[i]," started"))

    M             <-  M_struc*eta_set[i]
    out           <-  compare(alg="squic", data=data, lambda=lambda, X_star=X_star, M=M)
    metric_f1[i]  <-  out$f1
  }
  
  output <- list(
    "f1"	= metric_f1
  )
  
  return(output);
}

# ============================================================  #
# Run the accuracy experiments with a matrix tuning parameter   #
# ============================================================  #
library(parallel)
Sys.setenv(OMP_NUM_THREADS =detectCores()/2)

p <- 2000
n <- 500

# scalar sparsity parameter
lambda  <- .95

# \eta parameter for the matrix M
eta_set  <- c(.0001,0.05,0.10,.15,0.20,0.25,0.30,.35,0.45,0.55,0.95)

# testing the tridiagonal dataset
# Generate data
type   <- "trid"
out    <-  load_data(type=type, p=p, n=n, normalize=TRUE)
X_star <-  out$X_star
data   <-  out$data

out1 <- test_accuracy_M(X_star=X_star, data=data, c=0, rho=0.0, lambda=lambda, eta_set=eta_set)$f1
out2 <- test_accuracy_M(X_star=X_star, data=data, c=0, rho=0.2, lambda=lambda, eta_set=eta_set)$f1
out3 <- test_accuracy_M(X_star=X_star, data=data, c=0, rho=0.9, lambda=lambda, eta_set=eta_set)$f1

out4 <- test_accuracy_M(X_star=X_star, data=data, c=1, rho=0.0, lambda=lambda, eta_set=eta_set)$f1
out5 <- test_accuracy_M(X_star=X_star, data=data, c=1, rho=0.2, lambda=lambda, eta_set=eta_set)$f1
out6 <- test_accuracy_M(X_star=X_star, data=data, c=1, rho=0.9, lambda=lambda, eta_set=eta_set)$f1

out7 <- test_accuracy_M(X_star=X_star, data=data, c=2, rho=0.0, lambda=lambda, eta_set=eta_set)$f1
out8 <- test_accuracy_M(X_star=X_star, data=data, c=2, rho=0.2, lambda=lambda, eta_set=eta_set)$f1
out9 <- test_accuracy_M(X_star=X_star, data=data, c=2, rho=0.9, lambda=lambda, eta_set=eta_set)$f1

print("-----trid------")
print(data.frame(eta_set, out1, out2, out3, out4, out5, out6, out7, out8, out9), digits = 3)

# testing the cluster dataset
# Generate data
type   <- "clus"
out    <- load_data(type=type, p=p, n=n, normalize=TRUE)
X_star <- out$X_star
data   <- out$data

out1 <- test_accuracy_M(X_star=X_star, data=data, c=0, rho=0.0, lambda=lambda, eta_set=eta_set)$f1
out2 <- test_accuracy_M(X_star=X_star, data=data, c=0, rho=0.2, lambda=lambda, eta_set=eta_set)$f1
out3 <- test_accuracy_M(X_star=X_star, data=data, c=0, rho=0.9, lambda=lambda, eta_set=eta_set)$f1

out4 <- test_accuracy_M(X_star=X_star, data=data, c=1, rho=0.0, lambda=lambda, eta_set=eta_set)$f1
out5 <- test_accuracy_M(X_star=X_star, data=data, c=1, rho=0.2, lambda=lambda, eta_set=eta_set)$f1
out6 <- test_accuracy_M(X_star=X_star, data=data, c=1, rho=0.9, lambda=lambda, eta_set=eta_set)$f1

out7 <- test_accuracy_M(X_star=X_star, data=data, c=2, rho=0.0, lambda=lambda, eta_set=eta_set)$f1
out8 <- test_accuracy_M(X_star=X_star, data=data, c=2, rho=0.2, lambda=lambda, eta_set=eta_set)$f1
out9 <- test_accuracy_M(X_star=X_star, data=data, c=2, rho=0.9, lambda=lambda, eta_set=eta_set)$f1

print("-----clus------")
print(data.frame(eta_set, out1, out2, out3, out4, out5, out6, out7, out8, out9), digits = 3)
