annotate histogram.r @ 13:e676c441d388 draft

Uploaded
author guerler
date Fri, 18 Apr 2014 21:41:34 -0400
parents 9479e62342fa
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
13
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
1 # utilities
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
2 boundary <- function(x, increment) {
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
3 return (floor(x / increment) * increment)
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
4 }
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
5
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
6 roundup <- function(x) {
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
7 return (sign(x) * 10^ceiling(log10(abs(x))))
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
8 }
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
9
8
a889861139bc Uploaded
guerler
parents: 7
diff changeset
10 # wrapper
0
8fefbbf372be Uploaded
guerler
parents:
diff changeset
11 wrapper <- function(table, columns, options) {
8fefbbf372be Uploaded
guerler
parents:
diff changeset
12
8fefbbf372be Uploaded
guerler
parents:
diff changeset
13 # initialize output list
8fefbbf372be Uploaded
guerler
parents:
diff changeset
14 l <- list()
8fefbbf372be Uploaded
guerler
parents:
diff changeset
15
8fefbbf372be Uploaded
guerler
parents:
diff changeset
16 # loop through all columns
7
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
17 m <- list()
0
8fefbbf372be Uploaded
guerler
parents:
diff changeset
18 for (key in names(columns)) {
8fefbbf372be Uploaded
guerler
parents:
diff changeset
19 # load column data
8fefbbf372be Uploaded
guerler
parents:
diff changeset
20 column <- as.numeric(columns[key])
8fefbbf372be Uploaded
guerler
parents:
diff changeset
21 column_data <- sapply( table[column], as.numeric )
8fefbbf372be Uploaded
guerler
parents:
diff changeset
22
7
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
23 # collect vectors in list
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
24 m <- append(m, list(column_data))
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
25 }
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
26
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
27 # get min/max boundaries
12
9479e62342fa Uploaded
guerler
parents: 11
diff changeset
28 min_value <- min(unlist(m))
7
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
29 max_value <- max(unlist(m))
8
a889861139bc Uploaded
guerler
parents: 7
diff changeset
30
13
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
31 # identify increment
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
32 increment <- roundup((max_value - min_value) / 10)
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
33
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
34 # fix min value
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
35 min_value <- boundary(min_value, increment)
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
36
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
37 # fix max value
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
38 max_value <- min_value + increment * 10
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
39
9
656efffe650e Uploaded
guerler
parents: 8
diff changeset
40 # check if single bin is enough
656efffe650e Uploaded
guerler
parents: 8
diff changeset
41 if (min_value == max_value) {
656efffe650e Uploaded
guerler
parents: 8
diff changeset
42 l <- append(l, max_value)
10
86068f6de925 Uploaded
guerler
parents: 9
diff changeset
43 for (key in seq(m)) {
86068f6de925 Uploaded
guerler
parents: 9
diff changeset
44 l <- append(l, 1.0)
86068f6de925 Uploaded
guerler
parents: 9
diff changeset
45 }
9
656efffe650e Uploaded
guerler
parents: 8
diff changeset
46 return (l)
656efffe650e Uploaded
guerler
parents: 8
diff changeset
47 }
656efffe650e Uploaded
guerler
parents: 8
diff changeset
48
7
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
49 # fix range and bins
8
a889861139bc Uploaded
guerler
parents: 7
diff changeset
50 bin_seq = seq(min_value, max_value, by=increment)
13
e676c441d388 Uploaded
guerler
parents: 12
diff changeset
51
7
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
52 # add as first column
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
53 l <- append(l, list(bin_seq[2: length(bin_seq)]))
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
54
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
55 # loop through all columns
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
56 for (key in seq(m)) {
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
57 # load column data
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
58 column_data <- m[[key]]
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
59
0
8fefbbf372be Uploaded
guerler
parents:
diff changeset
60 # create hist data
7
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
61 hist_data <- hist(column_data, breaks=bin_seq, plot=FALSE)
0
8fefbbf372be Uploaded
guerler
parents:
diff changeset
62
8fefbbf372be Uploaded
guerler
parents:
diff changeset
63 # normalize densities
5
cbdd329ab623 Uploaded
guerler
parents: 0
diff changeset
64 count_sum <- sum(hist_data$counts)
cbdd329ab623 Uploaded
guerler
parents: 0
diff changeset
65 if (count_sum > 0) {
7
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
66 hist_data$counts = hist_data$counts / count_sum
5
cbdd329ab623 Uploaded
guerler
parents: 0
diff changeset
67 }
0
8fefbbf372be Uploaded
guerler
parents:
diff changeset
68
8fefbbf372be Uploaded
guerler
parents:
diff changeset
69 # collect vectors in list
8fefbbf372be Uploaded
guerler
parents:
diff changeset
70 l <- append(l, list(hist_data$counts))
8fefbbf372be Uploaded
guerler
parents:
diff changeset
71 }
8fefbbf372be Uploaded
guerler
parents:
diff changeset
72
8fefbbf372be Uploaded
guerler
parents:
diff changeset
73
8fefbbf372be Uploaded
guerler
parents:
diff changeset
74 # return
8fefbbf372be Uploaded
guerler
parents:
diff changeset
75 return (l)
8fefbbf372be Uploaded
guerler
parents:
diff changeset
76 }