contrib/benchmarking_code_block/Rhist.R

   1 # R script that produces histograms from benchmarked values
   2 # Can be called from the bash script with the following code:
   3 # export R_INPUT=$inputfile
   4 # export R_OUTPUT=$outputfile
   5 # export R_TYPE=$hist_type
   6
   7 # R CMD BATCH $this_script.R or  Rscript $this_script.R
   8
   9 # Use functions from bench.h to benchmark execution time of the desired block, then Rhist.R script to read all timings
  10 # and produce histograms and finally inject.h to inject values instead of executing block
  11
  12 # This is a small function to help merging empty nbins for dhist histograms
  13 merge_empty_bins <- function (h){
  14   i<-1
  15   j<-1
  16   counts2<--1
  17   breaks2<-h$breaks[1]
  18
  19   if (length(h$counts)>1)
  20     for(i in 1:(length(h$counts)-1)){
  21       if(h$counts[i]!=0 || h$counts[i+1]!=0){
  22         counts2[j]<-h$counts[i]
  23         breaks2[j+1]<-h$breaks[i+1];
  24         j<-j+1
  25       }
  26     }
  27
  28   counts2[j]<-h$counts[length(h$counts)]
  29   breaks2[j+1]<-h$breaks[length(h$breaks)]
  30
  31   h$counts<-counts2
  32   h$breaks<-breaks2
  33
  34   return (h)
  35 }
  36
  37 # Main
  38 source("analysis/hist_script/Rdhist.R")
  39
  40 inputfile<-Sys.getenv("R_INPUT")
  41 outputfile<-Sys.getenv("R_OUTPUT")
  42 type<-Sys.getenv("R_TYPE")
  43
  44 if (!(type %in% c("mean","default","sturges","scott"))){stop("Wrong histogram type")}
  45
  46 df<-read.table(inputfile,header=F)
  47 df<-df[,c(1,4)]
  48 names(df)<-c("NAME","TIME")
  49 attach(df)
  50
  51 for(i in unique(NAME)){
  52   vector1<-df[NAME==i,2]
  53   if (length(vector1)==1){
  54     #If there is only one element
  55     h<-hist(vector1) # Just for R compatibility reasons
  56     h$breaks<-c(vector1,vector1)
  57     h$counts<-1
  58   } else {
  59     if (type=="mean"){
  60       #Mean value only
  61       h<-hist(vector1) # Just for R compatibility reasons
  62       h$breaks<-c(mean(vector1),mean(vector1))
  63       h$counts<-length(vector1)
  64     } else
  65        if (type=="default")
  66          #Standard HISTOGRAM:
  67          h<-hist(vector1)
  68        else {
  69          #Dhist:
  70          h<-dhist(vector1,nbins=type, plot = FALSE, lab.spikes = FALSE, a=5*iqr(vector1), eps=0.15)
  71          h$breaks<-h$xbr
  72          h$count<-as.vector(h$counts)
  73          h$counts<-h$count
  74          h<-merge_empty_bins(h)
  75        }
  76   }
  77
  78   cat(i, file = outputfile, sep = "\t", append = TRUE)
  79   cat("\t", file = outputfile,  append = TRUE)
  80   cat(sum(h$counts), file =outputfile, sep = "\t", append = TRUE)
  81   cat("\t", file = outputfile,  append = TRUE)
  82   cat(sprintf("%.8f", mean(vector1)), file =outputfile, sep = "\t", append = TRUE)
  83   cat("\t", file = outputfile,  append = TRUE)
  84   cat(length(h$breaks), file = outputfile, append = TRUE)
  85   cat("\t", file = outputfile,  append = TRUE)
  86   cat(sprintf("%.8f", h$breaks), file = outputfile, sep = "\t", append = TRUE)
  87   cat("\t", file = outputfile,  append = TRUE)
  88   h$density = h$counts/sum(h$counts)
  89   cat(sprintf("%.8f", h$density), file = outputfile, sep = "\t", append = TRUE)
  90   cat("\n", file = outputfile,  append = TRUE)
  91 }