contrib/benchmarking_code_block/Rhist.R

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