Mercurial > repos > iuc > charts
comparison histogramdiscrete.r @ 1:344ac3ca7557 draft default tip
"planemo upload for repository https://github.com/galaxyproject/tools-iuc/tree/master/tools/charts/ commit 4494db13b69987fbc97d47177d2a5956e46e927b"
author | iuc |
---|---|
date | Wed, 17 Nov 2021 09:06:59 +0000 |
parents | a87a3773d8ed |
children |
comparison
equal
deleted
inserted
replaced
0:a87a3773d8ed | 1:344ac3ca7557 |
---|---|
1 zero <- function(v) { | |
2 0 | |
3 } | |
4 | |
1 # wrapper | 5 # wrapper |
2 wrapper <- function(table, columns, options) { | 6 wrapper <- function(table, columns, options) { |
3 | 7 |
4 # initialize output list | 8 # initialize output list |
5 l <- list() | 9 l <- list() |
7 # loop through all columns | 11 # loop through all columns |
8 m <- list() | 12 m <- list() |
9 for (key in names(columns)) { | 13 for (key in names(columns)) { |
10 # load column data | 14 # load column data |
11 column <- as.numeric(columns[key]) | 15 column <- as.numeric(columns[key]) |
12 | 16 |
13 # ensure string column | 17 # ensure string column |
14 column_data <- as.character(table[column][[1]]) | 18 column_data <- as.character(table[column][[1]]) |
15 | 19 |
16 # collect vectors in list | 20 # collect vectors in list |
17 m <- append(m, list(column_data)) | 21 m <- append(m, list(column_data)) |
18 } | 22 } |
19 | 23 |
20 # get alphabetically sorted bins | 24 # get alphabetically sorted bins |
21 bins <- sort(unique(unlist(m))) | 25 bins <- sort(unique(unlist(m))) |
22 | 26 |
23 # add first column | 27 # add first column |
24 l <- append(l, list(bins)) | 28 l <- append(l, list(bins)) |
25 | 29 |
26 # loop through all columns | 30 # loop through all columns |
27 for (key in seq(m)) { | 31 for (key in seq(m)) { |
28 # reset bins | 32 # reset bins |
29 bins = sapply(bins, function(v) { 0 }) | 33 bins <- sapply(bins, zero) |
30 | 34 |
31 # load column data | 35 # load column data |
32 column_data <- m[[key]] | 36 column_data <- m[[key]] |
33 | 37 |
34 # create hist data | 38 # create hist data |
35 table_data <- table(column_data) | 39 table_data <- table(column_data) |
36 | 40 |
37 # transfer counts to bins | 41 # transfer counts to bins |
38 for (id in names(table_data)) { | 42 for (id in names(table_data)) { |
39 bins[id] <- table_data[id] | 43 bins[id] <- table_data[id] |
40 } | 44 } |
41 | 45 |
42 # normalize densities | 46 # normalize densities |
43 total <- length(column_data) | 47 total <- length(column_data) |
44 if (total > 0) { | 48 if (total > 0) { |
45 bins = bins / total | 49 bins <- bins / total |
46 } | 50 } |
47 | 51 |
48 # collect vectors in list | 52 # collect vectors in list |
49 l <- append(l, list(bins)) | 53 l <- append(l, list(bins)) |
50 } | 54 } |
51 | 55 |
52 # return | 56 # return |
53 return (l) | 57 return(l) |
54 } | 58 } |