Mercurial > repos > eschen42 > w4mcorcov
comparison w4mcorcov_util.R @ 11:ddcc33ff3205 draft
planemo upload for repository https://github.com/HegemanLab/w4mcorcov_galaxy_wrapper/tree/master commit 4428e3252d54c8a8e0e5d85e8eaaeb13e9b21de7
| author | eschen42 |
|---|---|
| date | Wed, 05 Sep 2018 22:31:21 -0400 |
| parents | 50f60f94c034 |
| children |
comparison
equal
deleted
inserted
replaced
| 10:9a52306991b3 | 11:ddcc33ff3205 |
|---|---|
| 19 } | 19 } |
| 20 ) | 20 ) |
| 21 return (retval) | 21 return (retval) |
| 22 } | 22 } |
| 23 | 23 |
| 24 errorSink <- function(which_function, ...) { | |
| 25 var_args <- "..." | |
| 26 tryCatch( | |
| 27 var_args <<- (deparse(..., width.cutoff = 60)) | |
| 28 , error = function(e) {print(e$message)} | |
| 29 ) | |
| 30 if (var_args == "...") | |
| 31 return | |
| 32 # format error for logging | |
| 33 format_error <- function(e) { | |
| 34 sprintf( | |
| 35 "Error\n{ message: %s\n, arguments: %s\n}\n" | |
| 36 , e$message | |
| 37 , Reduce(f = paste, x = var_args) | |
| 38 ) | |
| 39 } | |
| 40 format_warning <- function(e) { | |
| 41 sprintf( | |
| 42 "Warning\n{ message: %s\n, arguments: %s\n}\n" | |
| 43 , e$message | |
| 44 , Reduce(f = paste, x = var_args) | |
| 45 ) | |
| 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() | |
| 59 } | |
| 60 } | |
| 61 errorPrint <- function(...) { | |
| 62 errorSink(which_function = print, ...) | |
| 63 } | |
| 64 errorCat <- function(...) { | |
| 65 errorSink(which_function = cat, ..., "\n") | |
| 66 } | |
| 67 | |
| 24 | 68 |
| 25 # # pseudo-inverse - computational inverse of non-square matrix a | 69 # # pseudo-inverse - computational inverse of non-square matrix a |
| 26 # p.i <- function(a) { | 70 # p.i <- function(a) { |
| 27 # solve(t(a) %*% a) %*% t(a) | 71 # solve(t(a) %*% a) %*% t(a) |
| 28 # } | 72 # } |
| 29 | 73 |
| 30 | 74 # vim: sw=2 ts=2 et ai : |