# HG changeset patch
# User iuc
# Date 1637140019 0
# Node ID 344ac3ca7557c8e86864c9b72d3e3a3fbe2e41e9
# Parent a87a3773d8ed6b5e56cda9fca1069b5ddc8febc9
"planemo upload for repository https://github.com/galaxyproject/tools-iuc/tree/master/tools/charts/ commit 4494db13b69987fbc97d47177d2a5956e46e927b"
diff -r a87a3773d8ed -r 344ac3ca7557 boxplot.r
--- a/boxplot.r Fri Mar 09 08:23:08 2018 -0500
+++ b/boxplot.r Wed Nov 17 09:06:59 2021 +0000
@@ -8,14 +8,14 @@
# load column data
column <- as.numeric(columns[key])
column_data <- suppressWarnings(as.numeric(as.character(table[column][[1]])))
-
+
# create hist data
- data <- boxplot(column_data, plot=FALSE)
-
+ data <- boxplot(column_data, plot = FALSE)
+
# collect vectors in list
l <- append(l, list(data$stats))
}
-
+
# return
- return (l)
+ return(l)
}
diff -r a87a3773d8ed -r 344ac3ca7557 charts.r
--- a/charts.r Fri Mar 09 08:23:08 2018 -0500
+++ b/charts.r Wed Nov 17 09:06:59 2021 +0000
@@ -1,13 +1,13 @@
#!/usr/bin/Rscript
# load getopt library
-library('getopt');
+library("getopt");
# convert multi parameter string (i.e. key1: value, key2: value, ...) to object
-split <- function(argument){
+split <- function(argument) {
# process parameter string
options <- list()
- list <- gsub("\\s","", argument)
+ list <- gsub("\\s", "", argument)
list <- strsplit(list, ",")
if (length(list) > 0) {
list <- list[[1]]
@@ -25,92 +25,92 @@
}
# get options, using the spec as defined by the enclosed list.
-spec = matrix(c(
- 'workdir', 'w', 1, 'character', 'Work directory',
- 'module', 'm', 1, 'character', 'Module name',
- 'input', 'i', 1, 'character', 'Input tabular file',
- 'columns', 'c', 1, 'character', 'Columns string',
- 'settings', 's', 1, 'character', 'Settings string',
- 'output', 'o', 1, 'character', 'Output tabular file',
- 'help', 'h', 0, '', 'Help',
- 'verbose', 'v', 0, '', 'Verbose'
-), byrow=TRUE, ncol=5);
-opt = getopt(spec);
+spec <- matrix(c(
+ "workdir", "w", 1, "character", "Work directory",
+ "module", "m", 1, "character", "Module name",
+ "input", "i", 1, "character", "Input tabular file",
+ "columns", "c", 1, "character", "Columns string",
+ "settings", "s", 1, "character", "Settings string",
+ "output", "o", 1, "character", "Output tabular file",
+ "help", "h", 0, "", "Help",
+ "verbose", "v", 0, "", "Verbose"
+), byrow = TRUE, ncol = 5);
+opt <- getopt(spec);
# show help
-if ( !is.null(opt$help) ||
+if (!is.null(opt$help) ||
is.null(opt$module) ||
is.null(opt$input) ||
is.null(opt$columns) ||
is.null(opt$output)) {
- cat(getopt(spec, usage=TRUE))
- q(status=1);
+ cat(getopt(spec, usage = TRUE))
+ q(status = 1);
}
# read columns/settings
-columns = split(opt$columns)
-settings = split(opt$settings)
+columns <- split(opt$columns)
+settings <- split(opt$settings)
# read table
-table <- read.table(opt$input, comment.char='#', fill=TRUE)
+table <- read.table(opt$input, comment.char = "#", fill = TRUE)
# identify module file
-module_file = paste(opt$workdir, opt$module, '.r', sep='')
+module_file <- paste(opt$workdir, opt$module, ".r", sep = "")
# source module
source(module_file)
# run module
-l = wrapper (table, columns, settings)
+l <- wrapper(table, columns, settings)
# header
-header_title <- '# title - Chart Utilities (charts)'
-header_date <- paste('# date -', Sys.time(), sep=' ')
-header_module <- paste('# module -', opt$module, sep=' ')
-header_settings <- paste('# settings -', opt$settings, sep=' ')
-header_columns <- paste('# columns -', opt$columns, sep=' ')
+header_title <- "# title - Chart Utilities (charts)"
+header_date <- paste("# date -", Sys.time(), sep = " ")
+header_module <- paste("# module -", opt$module, sep = " ")
+header_settings <- paste("# settings -", opt$settings, sep = " ")
+header_columns <- paste("# columns -", opt$columns, sep = " ")
# check result
if (length(l) > 0) {
# print details
if (!is.null(opt$verbose)) {
- print ('Columns:')
- print (columns)
- print ('Settings:')
- print (settings)
- print ('Result:')
- print (l)
+ print("Columns:")
+ print(columns)
+ print("Settings:")
+ print(settings)
+ print("Result:")
+ print(l)
}
# create output file
- output <- file(opt$output, open='wt')
-
+ output <- file(opt$output, open = "wt")
+
# write header
- writeLines('#', output)
+ writeLines("#", output)
writeLines(header_title, output)
writeLines(header_date, output)
writeLines(header_module, output)
writeLines(header_settings, output)
writeLines(header_columns, output)
- writeLines('#', output)
-
+ writeLines("#", output)
+
# pad columns
rows <- max(unlist(lapply(l, length)))
padded <- lapply(l, function(col) {
- length(col) = rows;
+ length(col) <- rows;
col
})
-
+
# write table
- write.table(padded, file=output, row.names=FALSE, col.names = FALSE, quote=FALSE, sep='\t')
-
+ write.table(padded, file = output, row.names = FALSE, col.names = FALSE, quote = FALSE, sep = "\t")
+
# close file
close(output)
} else {
# print details
- print ('Columns:')
- print (columns)
- print ('Settings:')
- print (settings)
- print ('No output generated.')
+ print("Columns:")
+ print(columns)
+ print("Settings:")
+ print(settings)
+ print("No output generated.")
}
\ No newline at end of file
diff -r a87a3773d8ed -r 344ac3ca7557 charts.xml
--- a/charts.xml Fri Mar 09 08:23:08 2018 -0500
+++ b/charts.xml Wed Nov 17 09:06:59 2021 +0000
@@ -52,7 +52,7 @@
-
+
diff -r a87a3773d8ed -r 344ac3ca7557 heatmap.r
--- a/heatmap.r Fri Mar 09 08:23:08 2018 -0500
+++ b/heatmap.r Wed Nov 17 09:06:59 2021 +0000
@@ -1,44 +1,44 @@
# load sparse matrix package
-suppressPackageStartupMessages(library('Matrix'))
+suppressPackageStartupMessages(library("Matrix"))
# access a numeric column
get_numeric <- function(table, column_key) {
column <- as.numeric(column_key)
column_data <- suppressWarnings(as.numeric(as.character(table[column][[1]])))
- return (c(column_data))
+ return(c(column_data))
}
# access a label column
get_label <- function(table, column_key) {
column <- as.numeric(column_key)
column_data <- as.character(table[column][[1]])
- return (c(column_data))
+ return(c(column_data))
}
# inflate three columns into matrix
-matrify <- function (data) {
+matrify <- function(data) {
if (ncol(data) != 3)
- stop('Data frame must have three column format')
+ stop("Data frame must have three column format")
plt <- data[, 1]
spc <- data[, 2]
abu <- data[, 3]
- plt.codes <- levels(factor(plt))
- spc.codes <- levels(factor(spc))
- taxa <- Matrix(0, nrow=length(plt.codes), ncol=length(spc.codes), sparse=TRUE)
- row <- match(plt, plt.codes)
- col <- match(spc, spc.codes)
- for (i in 1:length(abu)) {
+ plt_codes <- levels(factor(plt))
+ spc_codes <- levels(factor(spc))
+ taxa <- Matrix(0, nrow = length(plt_codes), ncol = length(spc_codes), sparse = TRUE)
+ row <- match(plt, plt_codes)
+ col <- match(spc, spc_codes)
+ for (i in seq_len(length(abu))) {
taxa[row[i], col[i]] <- abu[i]
}
- colnames(taxa) <- spc.codes
- rownames(taxa) <- plt.codes
+ colnames(taxa) <- spc_codes
+ rownames(taxa) <- plt_codes
taxa
}
# flatten data.frame into three column format
flatten <- function(my_matrix) {
- summ <-summary(my_matrix)
- summ <- data.frame(i=rownames(my_matrix)[summ$i], j=colnames(my_matrix)[summ$j], x=summ$x)
+ summ <- summary(my_matrix)
+ summ <- data.frame(i = rownames(my_matrix)[summ$i], j = colnames(my_matrix)[summ$j], x = summ$x)
summ
}
@@ -49,49 +49,49 @@
l <- list()
# get number of columns
- n = length(columns)
-
+ n <- length(columns)
+
# consistency check
if (n %% 3 != 0) {
- print ('heatmap::wrapper() - Data not consistent (n mod 3 != 0)')
- return (l)
+ print("heatmap::wrapper() - Data not consistent (n mod 3 != 0)")
+ return(l)
}
-
+
# create index sequence
- index = seq(1, n, by=3)
-
+ index <- seq(1, n, by = 3)
+
# get keys
- keys = names(columns)
-
+ keys <- names(columns)
+
# loop through blocks
for (i in index) {
# create columns
ci <- get_label(table, columns[keys[i]])
- cj <- get_label(table, columns[keys[i+1]])
- cx <- get_numeric(table, columns[keys[i+2]])
-
+ cj <- get_label(table, columns[keys[i + 1]])
+ cx <- get_numeric(table, columns[keys[i + 2]])
+
# create a frame from columns
- my_frame <- data.frame(ci=ci, cj=cj, cx=cx)
-
+ my_frame <- data.frame(ci = ci, cj = cj, cx = cx)
+
# create matrix out of the frame
my_matrix <- matrify(my_frame)
-
+
# create/cluster matrix
row_order <- hclust(dist(my_matrix))$order
col_order <- hclust(dist(t(my_matrix)))$order
-
+
# reorder matrix
my_matrix <- my_matrix[row_order, col_order]
-
+
# transform back to three columns
- my_flatmatrix = flatten(my_matrix)
-
+ my_flatmatrix <- flatten(my_matrix)
+
# append to result list
l <- append(l, list(my_flatmatrix$i))
l <- append(l, list(my_flatmatrix$j))
l <- append(l, list(my_flatmatrix$x))
}
-
+
# return
- return (l)
+ return(l)
}
diff -r a87a3773d8ed -r 344ac3ca7557 histogram.r
--- a/histogram.r Fri Mar 09 08:23:08 2018 -0500
+++ b/histogram.r Wed Nov 17 09:06:59 2021 +0000
@@ -10,36 +10,36 @@
# load column data
column <- as.numeric(columns[key])
column_data <- suppressWarnings(as.numeric(as.character(table[column][[1]])))
-
+
# collect vectors in list
m <- append(m, list(column_data))
}
-
+
# identify optimal breaks
- hist_data <- hist(unlist(m), plot=FALSE)
+ hist_data <- hist(unlist(m), plot = FALSE)
breaks <- hist_data$breaks;
-
+
# add as first column
l <- append(l, list(breaks[2: length(breaks)]))
-
+
# loop through all columns
for (key in seq(m)) {
# load column data
column_data <- m[[key]]
-
+
# create hist data
- hist_data <- hist(column_data, breaks=breaks, plot=FALSE)
-
+ hist_data <- hist(column_data, breaks = breaks, plot = FALSE)
+
# normalize densities
count_sum <- sum(hist_data$counts)
if (count_sum > 0) {
- hist_data$counts = hist_data$counts / count_sum
+ hist_data$counts <- hist_data$counts / count_sum
}
-
+
# collect vectors in list
l <- append(l, list(hist_data$counts))
}
-
+
# return
- return (l)
+ return(l)
}
diff -r a87a3773d8ed -r 344ac3ca7557 histogramdiscrete.r
--- a/histogramdiscrete.r Fri Mar 09 08:23:08 2018 -0500
+++ b/histogramdiscrete.r Wed Nov 17 09:06:59 2021 +0000
@@ -1,3 +1,7 @@
+zero <- function(v) {
+ 0
+}
+
# wrapper
wrapper <- function(table, columns, options) {
@@ -9,46 +13,46 @@
for (key in names(columns)) {
# load column data
column <- as.numeric(columns[key])
-
+
# ensure string column
column_data <- as.character(table[column][[1]])
-
+
# collect vectors in list
m <- append(m, list(column_data))
}
-
+
# get alphabetically sorted bins
bins <- sort(unique(unlist(m)))
-
+
# add first column
l <- append(l, list(bins))
-
+
# loop through all columns
for (key in seq(m)) {
# reset bins
- bins = sapply(bins, function(v) { 0 })
-
+ bins <- sapply(bins, zero)
+
# load column data
column_data <- m[[key]]
-
+
# create hist data
table_data <- table(column_data)
-
+
# transfer counts to bins
for (id in names(table_data)) {
bins[id] <- table_data[id]
}
-
+
# normalize densities
total <- length(column_data)
if (total > 0) {
- bins = bins / total
+ bins <- bins / total
}
-
+
# collect vectors in list
l <- append(l, list(bins))
}
# return
- return (l)
+ return(l)
}