annotate histogram.r @ 11:61a1d67f70d4 draft

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