Mercurial > repos > artbio > ez_histograms
comparison ez_histograms.R @ 1:fbedb212982d draft default tip
planemo upload for repository https://github.com/artbio/tools-artbio/tree/main/tools/ez_histograms commit 5e25392164eca5585239b62c82b7f6ba326cda6e
author | artbio |
---|---|
date | Thu, 08 Feb 2024 02:15:11 +0000 |
parents | bdf40b0924cb |
children |
comparison
equal
deleted
inserted
replaced
0:bdf40b0924cb | 1:fbedb212982d |
---|---|
1 library(ggplot2) | 1 library(ggplot2) |
2 library(reshape2) | 2 library(reshape2) |
3 library(dplyr) | 3 library(dplyr) |
4 library(scales) | 4 library(scales) |
5 library(vtable) | 5 library(psych) |
6 library(optparse) | 6 library(optparse) |
7 | 7 |
8 options(show.error.messages = FALSE, | 8 options(show.error.messages = FALSE, |
9 error = function() { | 9 error = function() { |
10 cat(geterrmessage(), file = stderr()) | 10 cat(geterrmessage(), file = stderr()) |
114 } else { | 114 } else { |
115 return(FALSE) | 115 return(FALSE) |
116 } | 116 } |
117 } | 117 } |
118 | 118 |
119 test_rownames <- function(file) { | 119 ##### prepare input data |
120 data <- read.delim(file = file, header = FALSE, row.names = NULL, nrows = 2) | |
121 if (is.na(as.numeric(data[2, 1]))) { | |
122 return(1) | |
123 } else { | |
124 return(NULL) | |
125 } | |
126 } | |
127 | 120 |
128 ##### prepare input data | 121 data <- read.delim(file = opt$file, header = test_header(opt$file)) |
129 data <- read.delim(file = opt$file, header = test_header(opt$file), row.names = test_rownames(opt$file)) | |
130 data <- data %>% select(where(is.numeric)) # remove non numeric columns | 122 data <- data %>% select(where(is.numeric)) # remove non numeric columns |
131 mdata <- melt(data) | 123 mdata <- melt(data) |
132 | 124 |
133 ##### main | 125 ##### main |
134 | 126 |
160 ) | 152 ) |
161 pdf(opt$pdf, width = width, height = height) | 153 pdf(opt$pdf, width = width, height = height) |
162 print(p + facet_wrap(~variable, ncol = ncol, scales = "free")) | 154 print(p + facet_wrap(~variable, ncol = ncol, scales = "free")) |
163 dev.off() | 155 dev.off() |
164 | 156 |
165 # Summary statistics with vtable package | 157 # Summary statistics with psych package |
166 summary_df <- sumtable(data, digits = 8, out = "return", add.median = TRUE, | 158 summary_df <- describe(x = data, skew = FALSE, ranges = FALSE, quant = c(.25, .50, .75)) |
167 summ.names = c("N", "Mean", "Std. Dev.", "Min", "Pctl. 25", | 159 summary_df <- cbind(var_names = rownames(summary_df), summary_df) |
168 "Median", "Pctl. 75", "Max")) | 160 colnames(summary_df)[2] <- "var_num" |
161 summary_df <- summary_df[, -6] | |
162 summary_df[, 4:8] <- format(summary_df[, 4:8], scientific = TRUE) | |
169 write.table(summary_df, file = opt$summary, sep = "\t", quote = FALSE, row.names = FALSE) | 163 write.table(summary_df, file = opt$summary, sep = "\t", quote = FALSE, row.names = FALSE) |