annotate histogram.r @ 8:a889861139bc draft

Uploaded
author guerler
date Thu, 17 Apr 2014 17:56:42 -0400
parents 2e2d92b2ae38
children 656efffe650e
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
a889861139bc Uploaded
guerler
parents: 7
diff changeset
27 min_value <- roundUp(min_value)
a889861139bc Uploaded
guerler
parents: 7
diff changeset
28 max_value <- roundUp(max_value)
a889861139bc Uploaded
guerler
parents: 7
diff changeset
29
a889861139bc Uploaded
guerler
parents: 7
diff changeset
30 # identify increment
a889861139bc Uploaded
guerler
parents: 7
diff changeset
31 increment <- (max_value - min_value) / 10
a889861139bc Uploaded
guerler
parents: 7
diff changeset
32
7
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
33 # fix range and bins
8
a889861139bc Uploaded
guerler
parents: 7
diff changeset
34 bin_seq = seq(min_value, max_value, by=increment)
7
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
35
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
36 # add as first column
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
37 l <- append(l, list(bin_seq[2: length(bin_seq)]))
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
38
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
39 # loop through all columns
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
40 for (key in seq(m)) {
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
41 # load column data
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
42 column_data <- m[[key]]
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
43
0
8fefbbf372be Uploaded
guerler
parents:
diff changeset
44 # create hist data
7
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
45 hist_data <- hist(column_data, breaks=bin_seq, plot=FALSE)
0
8fefbbf372be Uploaded
guerler
parents:
diff changeset
46
8fefbbf372be Uploaded
guerler
parents:
diff changeset
47 # normalize densities
5
cbdd329ab623 Uploaded
guerler
parents: 0
diff changeset
48 count_sum <- sum(hist_data$counts)
cbdd329ab623 Uploaded
guerler
parents: 0
diff changeset
49 if (count_sum > 0) {
7
2e2d92b2ae38 Uploaded
guerler
parents: 6
diff changeset
50 hist_data$counts = hist_data$counts / count_sum
5
cbdd329ab623 Uploaded
guerler
parents: 0
diff changeset
51 }
0
8fefbbf372be Uploaded
guerler
parents:
diff changeset
52
8fefbbf372be Uploaded
guerler
parents:
diff changeset
53 # collect vectors in list
8fefbbf372be Uploaded
guerler
parents:
diff changeset
54 l <- append(l, list(hist_data$counts))
8fefbbf372be Uploaded
guerler
parents:
diff changeset
55 }
8fefbbf372be Uploaded
guerler
parents:
diff changeset
56
8fefbbf372be Uploaded
guerler
parents:
diff changeset
57
8fefbbf372be Uploaded
guerler
parents:
diff changeset
58 # return
8fefbbf372be Uploaded
guerler
parents:
diff changeset
59 return (l)
8fefbbf372be Uploaded
guerler
parents:
diff changeset
60 }