analyze_uci_with_rope.R

analyze_uci_with_rope <- function(tbl) {
  #load from file "uci_data.RData" the cross-validation results of different classifiers on different data sets.
  #the relevant information is all included in the self-explaining list called uci_classification.
  #It contains accuracy results referring to 10 runs of 10-folds cross-validation for each classifier on 54 data sets.
  #The considered classifiers are ('naive Bayes','aode','hnb','j48','j48_grafted'), coded as 1,2,3,4,5.
  #It performs all the pairwise comparisons among such classifiers, on this collection of data sets.
  #As a result it returns the p-value of the signed rank, and the posterior probabilities computed by
  #the hierarchical test (posterior probability of the next delta being positive/negative; of the next delta
  #lying within rope, at the left and at the right of the rope)
  library(MASS)
  library(matrixStats)
  library(rstan)
  rstan_options(auto_write = TRUE)
  
  options(mc.cores = parallel::detectCores())
  setwd('C:/matlab/morework')
  source('C:/matlab/morework/hierarchical_test.R')

  std_upper_bound <- 1000
  standardization <- 1 #we run on standardized data
  
  #utiliy function which gets the average score of the given classifier on each data set
  getAvgScore <- function (currentClassifier,score) {
    avg_score <- vector(length = how_many_dsets, mode = "double");
    for ( ii in 1:how_many_dsets ){
      avg_score[ii] <- mean ( score [classifierId==currentClassifier & dsetId==dsetsList[ii]] )
    }
    return (avg_score)
  }
  
  #load("uci_data.RData")
  chains = 4
  
  
  #check arguments
  if (std_upper_bound<=1){
    stop("std_std_upper_bound should be larger than 1")
  }
  
  samplingType="student" #default choice
  if (!  ( (samplingType=="normal") | (samplingType=="student") )){
    stop("wrong samplingType")
  }
  
dsetId = tbl$DatasetID
classifierId = tbl$ClassifierID

score = tbl$Percent.correct

foldID = tbl$Key.Fold

runID = tbl$Key.Run

  #for each couple of classifiers: p_value_sign_rank,prob_classANextDelta,prob_ropeNextDelta,prob_classBNextDelta
  
  #dsetId<- uci_classification$DatasetID
  #classifierId <- uci_classification$ClassifierID
  #we run on accuracy
  #score <- uci_classification$Percent.correct
  
  #foldID <- uci_classification$Key.Fold
  nFolds <- max (foldID)
  rho=1/nFolds
    
  filename <- paste("uciResults_StdUpper",as.character(std_upper_bound),"samplingType",samplingType, sep="-")
  if (rho==0)  {
    filename <- paste(filename,"noCorrel",sep="-")
  }
  
  Rdata_filename <- paste (filename,"Rdata",sep=".")
  
  
  #runID <- uci_classification$Key.Run
  #the fold ID discriminates between different folds and different runs
  foldID <- runID*nFolds +foldID-nFolds 
  
  rope_min  <- -0.01
  rope_max  <- 0.01
  
  how_many_classifiers <- max(unique(classifierId))
  
  #classifier_names <- c('naive Bayes','aode','hnb','j48','j48_grafted')  #hard-coded
  how_many_comparisons <- how_many_classifiers*(how_many_classifiers-1)/2 #number of pairwise comparisons
  
  #fields to be filled during the multiple comparisons
  p_value_sign_rank <- vector(length = how_many_comparisons, mode = "double")
  p_value_t_test <- vector(length = how_many_comparisons, mode = "double")
  median_difference <- vector(length = how_many_comparisons, mode = "double")
  prob_classANextDelta <- vector(length = how_many_comparisons, mode = "double")
  prob_ropeNextDelta <- vector(length = how_many_comparisons, mode = "double")
  prob_classBNextDelta <- vector(length = how_many_comparisons, mode = "double")
  prob_positiveNextDelta<- vector(length = how_many_comparisons, mode = "double")
  prob_negativeNextDelta<- vector(length = how_many_comparisons, mode = "double")
  classifierI <- vector(length = how_many_comparisons, mode = "integer")
  classifierJ <- vector(length = how_many_comparisons, mode = "integer")
  
  
  dsetsList <- unique(dsetId);
  
  how_many_dsets <- length(dsetsList)
  
  hierarchicalResults <- list()
  counter <- 1
  for (i in 1: (how_many_classifiers-1) ) {
    for (j in (i+1) : how_many_classifiers){
      chains <-4
      show(c(i,j))
      
      classifierI[counter] <- i
      classifierJ[counter] <- j
      
      #run the signed rank
      avgScoreI <- getAvgScore (i,score)         
      avgScoreJ <- getAvgScore (j,score)
      median_difference[counter] <- median(avgScoreI-avgScoreJ)
      wilcoxonStat <-  wilcox.test (avgScoreI-avgScoreJ,alternative = "two.sided");
      p_value_sign_rank[counter] <- wilcoxonStat$p.value
      tTestStat <-  t.test (avgScoreI-avgScoreJ,alternative = "two.sided");
      p_value_t_test[counter] <- tTestStat$p.value
      
      #prepare the data for  the hierarchical test
      results <- cbind (classifierId, dsetId, score, foldID)
      resultsI  <- results[classifierId==i,] 
      resultsJ  <- results[classifierId==j,]
      
      #sort by dataset and then by fold
      #resultsI<-mat.sort(resultsI, c(2,4))
      #resultsJ<-mat.sort(resultsJ, c(2,4))
      
      #check results are consistently paired as for dataset and foldID
      #data are already properly sorted, so this control pases
      #otherwise we should sort the matrixes
      stopifnot( mean (resultsI[,c(2,4)]==resultsJ[,c(2,4)]) == 1)
      diffIJ <- cbind (resultsI[,2] , resultsI[,3]-resultsJ[,3])
      
      
      #build matrix of results to be parsed by hierarchical test
      x<-matrix(ncol  = max(foldID), nrow = how_many_dsets )
      for (dsetIdx in 1:how_many_dsets) {
        tmp <- diffIJ [diffIJ[,1] == dsetIdx,] 
        x[dsetIdx,]  <- t (tmp [,2])
      }
      
      
      #run the hierarchical test
      #we do not provide a simulation ID as this is run locally
      startTime<-Sys.time()
      simulationID <- paste(as.character(i*10 + j),as.character(std_upper_bound),samplingType,".dat",sep = "-")
      
      #hierarchicalResults[[counter]] <- hierarchical.test (x=x, rope_min=rope_min, rope_max=rope_max, sample_file=simulationID,
      #                                                     chains = chains,
      #                                                     samplingType = 'student')

	hierarchicalResults[[counter]] <- hierarchical.test.new (x=x, rope_min=rope_min, rope_max=rope_max, sample_file=simulationID,
                                                           chains = chains,
										samplingType = 'student')
      rope_vis(hierarchicalResults[[counter]]$cumulative,as.character(counter))             
      stopTime<-Sys.time()
      show(startTime-stopTime)
      
      #classA is the first classifier, classB the second classifier
      #delta = acc(classA) - acc(classB)
      #thus in the posterior the right tail of delta is the tail in favor
      #of classA
      
      prob_classANextDelta[counter]  <- hierarchicalResults[[counter]]$nextDelta$right
      prob_ropeNextDelta[counter]  <- hierarchicalResults[[counter]]$nextDelta$rope
      prob_classBNextDelta[counter] <- hierarchicalResults[[counter]]$nextDelta$left
      
      prob_positiveNextDelta[counter]  <- hierarchicalResults[[counter]]$nextDelta$positive
      prob_negativeNextDelta[counter]  <- hierarchicalResults[[counter]]$nextDelta$negative
      
      counter <- counter + 1
    }
  }
  
  classifierIString <-vector(length = how_many_comparisons, mode = "character")
  classifierJString <-vector(length = how_many_comparisons, mode = "character")
  
  classifier_names <- c('naive Bayes','aode','hnb','j48','j48_grafted');
  
  results_matrix<-data.frame(
    classifierI=classifierI,
    classifierJ=classifierJ,
    median_difference=median_difference,
    p_value_sign_rank=p_value_sign_rank,
    p_value_t_test=p_value_t_test,
    prob_classANextDelta=prob_classANextDelta,
    prob_ropeNextDelta=prob_ropeNextDelta,
    prob_classBNextDelta=prob_classBNextDelta,
    prob_positiveNextDelta=prob_positiveNextDelta,
    prob_negativeNextDelta=prob_negativeNextDelta,
    rope_min=rope_min,
    rope_max=rope_max
  )
  
  #csv_filename <- paste (filename,"csv",sep=".")
  
  #write.matrix(results_matrix, file = csv_filename, sep = ",")
  
  #results <- list() 
  #results[[1]] <- list('classifierI'=classifierI,
  #                     'classifierJ'=classifierJ,
  #                     'p_value_sign_rank'=p_value_sign_rank,
  #                     'median_difference'=median_difference,
  #                     'prob_classANextDelta'=prob_classANextDelta,
  #                    'prob_ropeNextDelta'=prob_ropeNextDelta,
  #                     'prob_classBNextDelta'=prob_classBNextDelta
  #)
  
  
  #save(hierarchicalResults, file = Rdata_filename)
  #prob_classANextDelta is the prob that A > B
  #prob_ropeNextDelta is the prob for rope <=> +- 0.01
  return (results_matrix)
  
}