Mercurial > repos > eschen42 > w4mcorcov

comparison w4mcorcov_util.R @ 6:0b49916c5c52 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload for repository https://github.com/HegemanLab/w4mcorcov_galaxy_wrapper/tree/master commit 4428e3252d54c8a8e0e5d85e8eaaeb13e9b21de7
author eschen42
date Wed, 05 Sep 2018 19:24:47 -0400
parents 50a07adddfbd
children
comparison
equal deleted inserted replaced
5:1d046f648b47 6:0b49916c5c52
19 } 19 }
20 ) 20 )
21 return (retval) 21 return (retval)
22 } 22 }
23 23
24 # turn off all plotting devices 24 errorSink <- function(which_function, ...) {
25 dev.off.all <- function() { 25 var_args <- "..."
26 while (!is.null(dev.list())) { dev.off() } 26 tryCatch(
27 } 27 var_args <<- (deparse(..., width.cutoff = 60))
28 28 , error = function(e) {print(e$message)}
29 # capture plot and write to PDF; then close any devices opened in the process 29 )
30 plot2pdf <- function( 30 if (var_args == "...")
31 file.name 31 return
32 , plot.function 32 # format error for logging
33 , width = 12 33 format_error <- function(e) {
34 , height = 12 34 sprintf(
35 ) { 35 "Error\n{ message: %s\n, arguments: %s\n}\n"
36 # capture plot and write to PDF 36 , e$message
37 cur.dev <- dev.list() 37 , Reduce(f = paste, x = var_args)
38 filename <- file.name 38 )
39 pdf(file = filename, width = width, height = height) 39 }
40 plot.function() 40 format_warning <- function(e) {
41 # close any devices opened in the process 41 sprintf(
42 dev.off() 42 "Warning\n{ message: %s\n, arguments: %s\n}\n"
43 if (is.null(cur.dev)) { 43 , e$message
44 dev.off.all() 44 , Reduce(f = paste, x = var_args)
45 } else { 45 )
46 while ( length(dev.list()) > length(cur.dev) ) { dev.off() } 46 }
47 sink_number <- sink.number()
48 sink(stderr())
49 tryCatch(
50 var_args <- (deparse(..., width.cutoff = 60))
51 , expr = {
52 retval <- which_function(...)
53 }
54 , error = function(e) cat(format_error(e), file = stderr())
55 , warning = function(w) cat(format_warning(w), file = stderr())
56 )
57 while (sink.number() > sink_number) {
58 sink()
47 } 59 }
48 } 60 }
49 61 errorPrint <- function(...) {
50 # print and capture plot and write to PDF; then close any devices opened in the process 62 errorSink(which_function = print, ...)
51 # This is needed for ggplot which does not print the plot when invoked within a function. 63 }
52 print2pdf <- function( 64 errorCat <- function(...) {
53 file.name 65 errorSink(which_function = cat, ..., "\n")
54 , plot.function
55 , width = 12
56 , height = 12
57 ) {
58 plot2pdf(
59 file.name = file.name
60 , width = width
61 , height = height
62 , plot.function = function() {
63 print(plot.function())
64 }
65 )
66 } 66 }
67 67
68 iso8601.znow <- function()
69 {
70 strftime(as.POSIXlt(Sys.time(), "UTC"), "%Y-%m-%dT%H:%M:%SZ")
71 }
72 68
73 # pdf.name <- function(name) 69 # # pseudo-inverse - computational inverse of non-square matrix a
74 # {
75 # paste0(name, "_", iso8601.filename.fragment(), ".pdf")
76 # }
77 #
78 # tsv.name <- function(name)
79 # {
80 # paste0(name, "_", iso8601.filename.fragment(), ".tsv")
81 # }
82 #
83 # # pseudo-inverse - computational inverse non-square matrix a
84 # p.i <- function(a) { 70 # p.i <- function(a) {
85 # solve(t(a) %*% a) %*% t(a) 71 # solve(t(a) %*% a) %*% t(a)
86 # } 72 # }
87 73
88 74 # vim: sw=2 ts=2 et ai :