annotate histogram.r @ 9:656efffe650e draft

Uploaded
author guerler
date Fri, 18 Apr 2014 13:50:05 -0400
parents a889861139bc
children 86068f6de925
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
8
a889861139bc Uploaded
guerler
parents: 7
diff changeset
1 # utilities
a889861139bc Uploaded
guerler
parents: 7
diff changeset
2 roundUp <- function(x) 10^ceiling(log10(x))
a889861139bc Uploaded
guerler
parents: 7
diff changeset
3 roundDown <- function(x) 10^floor(log10(x))
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)
656efffe650e Uploaded
guerler
parents: 8
diff changeset
33 l <- append(l, 1.0)
656efffe650e Uploaded
guerler
parents: 8
diff changeset
34 return (l)
656efffe650e Uploaded
guerler
parents: 8
diff changeset
35 }
656efffe650e Uploaded
guerler
parents: 8
diff changeset
36
8
a889861139bc Uploaded
guerler
parents: 7
diff changeset
37 # identify increment
9
656efffe650e Uploaded
guerler
parents: 8
diff changeset
38 increment <- roundUp((max_value - min_value) / 10)
8
a889861139bc Uploaded
guerler
parents: 7
diff changeset
39
7
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
40 # fix range and bins
8
a889861139bc Uploaded
guerler
parents: 7
diff changeset
41 bin_seq = seq(min_value, max_value, by=increment)
9
656efffe650e Uploaded
guerler
parents: 8
diff changeset
42
7
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
43 # add as first column
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
44 l <- append(l, list(bin_seq[2: length(bin_seq)]))
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
45
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
46 # loop through all columns
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
47 for (key in seq(m)) {
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
48 # load column data
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
49 column_data <- m[[key]]
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
50
0
8fefbbf372be Uploaded
guerler
parents:
diff changeset
51 # create hist data
7
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
52 hist_data <- hist(column_data, breaks=bin_seq, plot=FALSE)
0
8fefbbf372be Uploaded
guerler
parents:
diff changeset
53
8fefbbf372be Uploaded
guerler
parents:
diff changeset
54 # normalize densities
5
cbdd329ab623 Uploaded
guerler
parents: 0
diff changeset
55 count_sum <- sum(hist_data$counts)
cbdd329ab623 Uploaded
guerler
parents: 0
diff changeset
56 if (count_sum > 0) {
7
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
57 hist_data$counts = hist_data$counts / count_sum
5
cbdd329ab623 Uploaded
guerler
parents: 0
diff changeset
58 }
0
8fefbbf372be Uploaded
guerler
parents:
diff changeset
59
8fefbbf372be Uploaded
guerler
parents:
diff changeset
60 # collect vectors in list
8fefbbf372be Uploaded
guerler
parents:
diff changeset
61 l <- append(l, list(hist_data$counts))
8fefbbf372be Uploaded
guerler
parents:
diff changeset
62 }
8fefbbf372be Uploaded
guerler
parents:
diff changeset
63
8fefbbf372be Uploaded
guerler
parents:
diff changeset
64
8fefbbf372be Uploaded
guerler
parents:
diff changeset
65 # return
8fefbbf372be Uploaded
guerler
parents:
diff changeset
66 return (l)
8fefbbf372be Uploaded
guerler
parents:
diff changeset
67 }