annotate histogram.r @ 2:a3b34c760a79 draft

Uploaded
author guerler
date Thu, 17 Apr 2014 11:19:06 -0400
parents 8fefbbf372be
children cbdd329ab623
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
8fefbbf372be Uploaded
guerler
parents:
diff changeset
1 wrapper <- function(table, columns, options) {
8fefbbf372be Uploaded
guerler
parents:
diff changeset
2
8fefbbf372be Uploaded
guerler
parents:
diff changeset
3 # initialize output list
8fefbbf372be Uploaded
guerler
parents:
diff changeset
4 l <- list()
8fefbbf372be Uploaded
guerler
parents:
diff changeset
5
8fefbbf372be Uploaded
guerler
parents:
diff changeset
6 # loop through all columns
8fefbbf372be Uploaded
guerler
parents:
diff changeset
7 for (key in names(columns)) {
8fefbbf372be Uploaded
guerler
parents:
diff changeset
8 # load column data
8fefbbf372be Uploaded
guerler
parents:
diff changeset
9 column <- as.numeric(columns[key])
8fefbbf372be Uploaded
guerler
parents:
diff changeset
10 column_data <- sapply( table[column], as.numeric )
8fefbbf372be Uploaded
guerler
parents:
diff changeset
11
8fefbbf372be Uploaded
guerler
parents:
diff changeset
12 # create hist data
8fefbbf372be Uploaded
guerler
parents:
diff changeset
13 hist_data <- hist(column_data, plot=FALSE)
8fefbbf372be Uploaded
guerler
parents:
diff changeset
14
8fefbbf372be Uploaded
guerler
parents:
diff changeset
15 # normalize densities
8fefbbf372be Uploaded
guerler
parents:
diff changeset
16 hist_data$counts=hist_data$counts/sum(hist_data$counts)
8fefbbf372be Uploaded
guerler
parents:
diff changeset
17
8fefbbf372be Uploaded
guerler
parents:
diff changeset
18 # collect vectors in list
8fefbbf372be Uploaded
guerler
parents:
diff changeset
19 l <- append(l, list(hist_data$breaks[2: length(hist_data$breaks)]))
8fefbbf372be Uploaded
guerler
parents:
diff changeset
20 l <- append(l, list(hist_data$counts))
8fefbbf372be Uploaded
guerler
parents:
diff changeset
21 }
8fefbbf372be Uploaded
guerler
parents:
diff changeset
22
8fefbbf372be Uploaded
guerler
parents:
diff changeset
23 # make sure length is fine
8fefbbf372be Uploaded
guerler
parents:
diff changeset
24 n <- max(sapply(l, length))
8fefbbf372be Uploaded
guerler
parents:
diff changeset
25 ll <- lapply(l, function(X) {
8fefbbf372be Uploaded
guerler
parents:
diff changeset
26 c(as.character(X), rep("", times = n - length(X)))
8fefbbf372be Uploaded
guerler
parents:
diff changeset
27 })
8fefbbf372be Uploaded
guerler
parents:
diff changeset
28 l <- do.call(cbind, ll)
8fefbbf372be Uploaded
guerler
parents:
diff changeset
29
8fefbbf372be Uploaded
guerler
parents:
diff changeset
30 # return
8fefbbf372be Uploaded
guerler
parents:
diff changeset
31 return (l)
8fefbbf372be Uploaded
guerler
parents:
diff changeset
32 }