File: Rhist.R

package info (click to toggle)
simgrid 4.1-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 39,192 kB
  • sloc: cpp: 124,913; ansic: 66,744; python: 8,560; java: 6,773; fortran: 6,079; f90: 5,123; xml: 4,587; sh: 2,194; perl: 1,436; makefile: 111; lisp: 49; javascript: 7; sed: 6
file content (91 lines) | stat: -rw-r--r-- 2,822 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
# R script that produces histograms from benchmarked values
# Can be called from the bash script with the following code:
# export R_INPUT=$inputfile
# export R_OUTPUT=$outputfile
# export R_TYPE=$hist_type

# R CMD BATCH $this_script.R or  Rscript $this_script.R

# Use functions from bench.h to benchmark execution time of the desired block, then Rhist.R script to read all timings
# and produce histograms and finally inject.h to inject values instead of executing block

# This is a small function to help merging empty nbins for dhist histograms
merge_empty_bins <- function (h){
  i<-1
  j<-1
  counts2<--1
  breaks2<-h$breaks[1]

  if (length(h$counts)>1)
    for(i in 1:(length(h$counts)-1)){
      if(h$counts[i]!=0 || h$counts[i+1]!=0){
        counts2[j]<-h$counts[i]
        breaks2[j+1]<-h$breaks[i+1]
        j<-j+1
      }
    }

  counts2[j]<-h$counts[length(h$counts)]
  breaks2[j+1]<-h$breaks[length(h$breaks)]

  h$counts<-counts2
  h$breaks<-breaks2

  return (h)
}

# Main
source("analysis/hist_script/Rdhist.R")

inputfile<-Sys.getenv("R_INPUT")
outputfile<-Sys.getenv("R_OUTPUT")
type<-Sys.getenv("R_TYPE")

if (!(type %in% c("mean","default","sturges","scott"))){stop("Wrong histogram type")}

df<-read.table(inputfile,header=F)
df<-df[,c(1,4)]
names(df)<-c("NAME","TIME")
attach(df)

for(i in unique(NAME)){
  vector1<-df[NAME==i,2]
  if (length(vector1)==1){
    #If there is only one element
    h<-hist(vector1) # Just for R compatibility reasons
    h$breaks<-c(vector1,vector1)
    h$counts<-1
  } else {
    if (type=="mean"){
      #Mean value only
      h<-hist(vector1) # Just for R compatibility reasons
      h$breaks<-c(mean(vector1),mean(vector1))
      h$counts<-length(vector1)
    } else
       if (type=="default")
         #Standard HISTOGRAM:
         h<-hist(vector1)
       else {
         #Dhist:
         h<-dhist(vector1,nbins=type, plot = FALSE, lab.spikes = FALSE, a=5*iqr(vector1), eps=0.15)
         h$breaks<-h$xbr
         h$count<-as.vector(h$counts)
         h$counts<-h$count
         h<-merge_empty_bins(h)
       }
  }

  cat(i, file = outputfile, sep = "\t", append = TRUE)
  cat("\t", file = outputfile,  append = TRUE)
  cat(sum(h$counts), file =outputfile, sep = "\t", append = TRUE)
  cat("\t", file = outputfile,  append = TRUE)
  cat(sprintf("%.8f", mean(vector1)), file =outputfile, sep = "\t", append = TRUE)
  cat("\t", file = outputfile,  append = TRUE)
  cat(length(h$breaks), file = outputfile, append = TRUE)
  cat("\t", file = outputfile,  append = TRUE)
  cat(sprintf("%.8f", h$breaks), file = outputfile, sep = "\t", append = TRUE)
  cat("\t", file = outputfile,  append = TRUE)
  h$density = h$counts/sum(h$counts)
  cat(sprintf("%.8f", h$density), file = outputfile, sep = "\t", append = TRUE)
  cat("\n", file = outputfile,  append = TRUE)
}