annotate chartskit.r @ 32:e915224afc1d draft

Uploaded
author guerler
date Mon, 07 Apr 2014 19:24:08 -0400
parents 7774e0097ff4
children 0197da753d1e
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
1
b4722f9d496f Uploaded
guerler
parents:
diff changeset
1 #!/usr/bin/Rscript
b4722f9d496f Uploaded
guerler
parents:
diff changeset
2
27
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
3 #' Returns file name of calling Rscript
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
4 #'
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
5 #' \code{get_Rscript_filename} returns the file name of calling Rscript
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
6 #' @return A string with the filename of the calling script.
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
7 #' If not found (i.e. you are in a interactive session) returns NA.
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
8 #'
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
9 #' @export
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
10 get_Rscript_filename <- function() {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
11 prog <- sub("--file=", "", grep("--file=", commandArgs(), value=TRUE)[1])
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
12 if( .Platform$OS.type == "windows") {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
13 prog <- gsub("\\\\", "\\\\\\\\", prog)
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
14 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
15 prog
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
16 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
17
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
18 #' Recursively sorts a list
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
19 #'
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
20 #' \code{sort_list} returns a sorted list
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
21 #' @param unsorted_list A list.
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
22 #' @return A sorted list.
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
23 #' @export
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
24 sort_list <- function(unsorted_list) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
25 for(ii in seq(along=unsorted_list)) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
26 if(is.list(unsorted_list[[ii]])) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
27 unsorted_list[[ii]] <- sort_list(unsorted_list[[ii]])
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
28 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
29 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
30 unsorted_list[sort(names(unsorted_list))]
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
31 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
32
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
33 #' #!/path/to/Rscript
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
34 #' library('getopt');
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
35 #' #get options, using the spec as defined by the enclosed list.
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
36 #' #we read the options from the default: commandArgs(TRUE).
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
37 #' spec = matrix(c(
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
38 #' 'verbose', 'v', 2, "integer",
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
39 #' 'help' , 'h', 0, "logical",
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
40 #' 'count' , 'c', 1, "integer",
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
41 #' 'mean' , 'm', 1, "double",
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
42 #' 'sd' , 's', 1, "double"
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
43 #' ), byrow=TRUE, ncol=4);
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
44 #' opt = getopt(spec);
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
45 #'
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
46 #' # if help was asked for print a friendly message
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
47 #' # and exit with a non-zero error code
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
48 #' if ( !is.null(opt$help) ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
49 #' cat(getopt(spec, usage=TRUE));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
50 #' q(status=1);
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
51 #' }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
52 #'
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
53 #' #set some reasonable defaults for the options that are needed,
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
54 #' #but were not specified.
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
55 #' if ( is.null(opt$mean ) ) { opt$mean = 0 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
56 #' if ( is.null(opt$sd ) ) { opt$sd = 1 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
57 #' if ( is.null(opt$count ) ) { opt$count = 10 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
58 #' if ( is.null(opt$verbose ) ) { opt$verbose = FALSE }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
59 #'
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
60 #' #print some progress messages to stderr, if requested.
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
61 #' if ( opt$verbose ) { write("writing...",stderr()); }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
62 #'
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
63 #' #do some operation based on user input.
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
64 #' cat(paste(rnorm(opt$count,mean=opt$mean,sd=opt$sd),collapse="\n"));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
65 #' cat("\n");
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
66 #'
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
67 #' #signal success and exit.
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
68 #' #q(status=0);
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
69 getopt = function (spec=NULL,opt=commandArgs(TRUE),command=get_Rscript_filename(),usage=FALSE,debug=FALSE) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
70
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
71 # littler compatibility - map argv vector to opt
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
72 if (exists("argv", where = .GlobalEnv, inherits = FALSE)) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
73 opt = get("argv", envir = .GlobalEnv);
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
74 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
75
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
76 ncol=4;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
77 maxcol=6;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
78 col.long.name = 1;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
79 col.short.name = 2;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
80 col.has.argument = 3;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
81 col.mode = 4;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
82 col.description = 5;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
83
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
84 flag.no.argument = 0;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
85 flag.required.argument = 1;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
86 flag.optional.argument = 2;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
87
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
88 result = list();
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
89 result$ARGS = vector(mode="character");
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
90
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
91 #no spec. fail.
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
92 if ( is.null(spec) ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
93 stop('argument "spec" must be non-null.');
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
94
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
95 #spec is not a matrix. attempt to coerce, if possible. issue a warning.
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
96 } else if ( !is.matrix(spec) ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
97 if ( length(spec)/4 == as.integer(length(spec)/4) ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
98 warning('argument "spec" was coerced to a 4-column (row-major) matrix. use a matrix to prevent the coercion');
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
99 spec = matrix( spec, ncol=ncol, byrow=TRUE );
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
100 } else {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
101 stop('argument "spec" must be a matrix, or a character vector with length divisible by 4, rtfm.');
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
102 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
103
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
104 #spec is a matrix, but it has too few columns.
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
105 } else if ( dim(spec)[2] < ncol ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
106 stop(paste('"spec" should have at least ",ncol," columns.',sep=''));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
107
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
108 #spec is a matrix, but it has too many columns.
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
109 } else if ( dim(spec)[2] > maxcol ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
110 stop(paste('"spec" should have no more than ",maxcol," columns.',sep=''));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
111
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
112 #spec is a matrix, and it has some optional columns.
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
113 } else if ( dim(spec)[2] != ncol ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
114 ncol = dim(spec)[2];
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
115 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
116
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
117 #sanity check. make sure long names are unique, and short names are unique.
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
118 if ( length(unique(spec[,col.long.name])) != length(spec[,col.long.name]) ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
119 stop(paste('redundant long names for flags (column ',col.long.name,').',sep=''));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
120 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
121 if ( length(na.omit(unique(spec[,col.short.name]))) != length(na.omit(spec[,col.short.name])) ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
122 stop(paste('redundant short names for flags (column ',col.short.name,').',sep=''));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
123 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
124 # convert numeric type to double type
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
125 spec[,4] <- gsub("numeric", "double", spec[,4])
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
126
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
127 # if usage=TRUE, don't process opt, but generate a usage string from the data in spec
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
128 if ( usage ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
129 ret = '';
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
130 ret = paste(ret,"Usage: ",command,sep='');
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
131 for ( j in 1:(dim(spec))[1] ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
132 ret = paste(ret,' [-[-',spec[j,col.long.name],'|',spec[j,col.short.name],']',sep='');
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
133 if (spec[j,col.has.argument] == flag.no.argument) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
134 ret = paste(ret,']',sep='');
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
135 } else if (spec[j,col.has.argument] == flag.required.argument) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
136 ret = paste(ret,' <',spec[j,col.mode],'>]',sep='');
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
137 } else if (spec[j,col.has.argument] == flag.optional.argument) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
138 ret = paste(ret,' [<',spec[j,col.mode],'>]]',sep='');
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
139 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
140 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
141 # include usage strings
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
142 if ( ncol >= 5 ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
143 max.long = max(apply(cbind(spec[,col.long.name]),1,function(x)length(strsplit(x,'')[[1]])));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
144 ret = paste(ret,"\n",sep='');
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
145 for (j in 1:(dim(spec))[1] ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
146 ret = paste(ret,sprintf(paste(" -%s|--%-",max.long,"s %s\n",sep=''),
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
147 spec[j,col.short.name],spec[j,col.long.name],spec[j,col.description]
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
148 ),sep='');
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
149 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
150 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
151 else {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
152 ret = paste(ret,"\n",sep='');
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
153 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
154 return(ret);
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
155 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
156
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
157 #XXX check spec validity here. e.g. column three should be convertible to integer
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
158
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
159 i = 1;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
160
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
161 while ( i <= length(opt) ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
162 if ( debug ) print(paste("processing",opt[i]));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
163
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
164 current.flag = 0; #XXX use NA
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
165 optstring = opt[i];
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
166
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
167
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
168 #long flag
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
169 if ( substr(optstring, 1, 2) == '--' ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
170 if ( debug ) print(paste(" long option:",opt[i]));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
171
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
172 optstring = substring(optstring,3);
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
173
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
174 this.flag = NA;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
175 this.argument = NA;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
176 kv = strsplit(optstring, '=')[[1]];
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
177 if ( !is.na(kv[2]) ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
178 this.flag = kv[1];
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
179 this.argument = paste(kv[-1], collapse="=");
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
180 } else {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
181 this.flag = optstring;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
182 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
183
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
184 rowmatch = grep( this.flag, spec[,col.long.name],fixed=TRUE );
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
185
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
186 #long flag is invalid, matches no options
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
187 if ( length(rowmatch) == 0 ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
188 stop(paste('long flag "', this.flag, '" is invalid', sep=''));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
189
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
190 #long flag is ambiguous, matches too many options
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
191 } else if ( length(rowmatch) > 1 ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
192 # check if there is an exact match and use that
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
193 rowmatch = which(this.flag == spec[,col.long.name])
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
194 if(length(rowmatch) == 0) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
195 stop(paste('long flag "', this.flag, '" is ambiguous', sep=''));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
196 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
197 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
198
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
199 #if we have an argument
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
200 if ( !is.na(this.argument) ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
201 #if we can't accept the argument, bail out
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
202 if ( spec[rowmatch, col.has.argument] == flag.no.argument ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
203 stop(paste('long flag "', this.flag, '" accepts no arguments', sep=''));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
204
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
205 #otherwise assign the argument to the flag
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
206 } else {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
207 storage.mode(this.argument) = spec[rowmatch, col.mode];
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
208 result[spec[rowmatch, col.long.name]] = this.argument;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
209 i = i + 1;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
210 next;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
211 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
212
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
213 #otherwise, we don't have an argument
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
214 } else {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
215 #if we require an argument, bail out
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
216 ###if ( spec[rowmatch, col.has.argument] == flag.required.argument ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
217 ### stop(paste('long flag "', this.flag, '" requires an argument', sep=''));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
218
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
219 #long flag has no attached argument. set flag as present. set current.flag so we can peek ahead later and consume the argument if it's there
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
220 ###} else {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
221 result[spec[rowmatch, col.long.name]] = TRUE;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
222 current.flag = rowmatch;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
223 ###}
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
224 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
225
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
226 #short flag(s)
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
227 } else if ( substr(optstring, 1, 1) == '-' ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
228 if ( debug ) print(paste(" short option:",opt[i]));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
229
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
230 these.flags = strsplit(optstring,'')[[1]];
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
231
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
232 done = FALSE;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
233 for ( j in 2:length(these.flags) ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
234 this.flag = these.flags[j];
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
235 rowmatch = grep( this.flag, spec[,col.short.name],fixed=TRUE );
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
236
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
237 #short flag is invalid, matches no options
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
238 if ( length(rowmatch) == 0 ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
239 stop(paste('short flag "', this.flag, '" is invalid', sep=''));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
240
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
241 #short flag is ambiguous, matches too many options
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
242 } else if ( length(rowmatch) > 1 ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
243 stop(paste('short flag "', this.flag, '" is ambiguous', sep=''));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
244
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
245 #short flag has an argument, but is not the last in a compound flag string
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
246 } else if ( j < length(these.flags) & spec[rowmatch,col.has.argument] == flag.required.argument ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
247 stop(paste('short flag "', this.flag, '" requires an argument, but has none', sep=''));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
248
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
249 #short flag has no argument, flag it as present
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
250 } else if ( spec[rowmatch,col.has.argument] == flag.no.argument ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
251 result[spec[rowmatch, col.long.name]] = TRUE;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
252 done = TRUE;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
253
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
254 #can't definitively process this flag yet, need to see if next option is an argument or not
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
255 } else {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
256 result[spec[rowmatch, col.long.name]] = TRUE;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
257 current.flag = rowmatch;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
258 done = FALSE;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
259 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
260 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
261 if ( done ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
262 i = i + 1;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
263 next;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
264 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
265 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
266
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
267 #invalid opt
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
268 if ( current.flag == 0 ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
269 stop(paste('"', optstring, '" is not a valid option, or does not support an argument', sep=''));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
270 #TBD support for positional args
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
271 #if ( debug ) print(paste('"', optstring, '" not a valid option. It is appended to getopt(...)$ARGS', sep=''));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
272 #result$ARGS = append(result$ARGS, optstring);
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
273
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
274 # some dangling flag, handle it
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
275 } else if ( current.flag > 0 ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
276 if ( debug ) print(' dangling flag');
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
277 if ( length(opt) > i ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
278 peek.optstring = opt[i + 1];
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
279 if ( debug ) print(paste(' peeking ahead at: "',peek.optstring,'"',sep=''));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
280
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
281 #got an argument. attach it, increment the index, and move on to the next option. we don't allow arguments beginning with '-' UNLESS
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
282 #specfile indicates the value is an "integer" or "double", in which case we allow a leading dash (and verify trailing digits/decimals).
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
283 if ( substr(peek.optstring, 1, 1) != '-' |
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
284 #match negative double
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
285 ( substr(peek.optstring, 1, 1) == '-'
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
286 & regexpr('^-[0123456789]*\\.?[0123456789]+$',peek.optstring) > 0
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
287 & spec[current.flag, col.mode]== 'double'
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
288 ) |
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
289 #match negative integer
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
290 ( substr(peek.optstring, 1, 1) == '-'
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
291 & regexpr('^-[0123456789]+$',peek.optstring) > 0
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
292 & spec[current.flag, col.mode]== 'integer'
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
293 )
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
294 ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
295 if ( debug ) print(paste(' consuming argument *',peek.optstring,'*',sep=''));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
296
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
297 storage.mode(peek.optstring) = spec[current.flag, col.mode];
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
298 result[spec[current.flag, col.long.name]] = peek.optstring;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
299 i = i + 1;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
300
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
301 #a lone dash
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
302 } else if ( substr(peek.optstring, 1, 1) == '-' & length(strsplit(peek.optstring,'')[[1]]) == 1 ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
303 if ( debug ) print(' consuming "lone dash" argument');
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
304 storage.mode(peek.optstring) = spec[current.flag, col.mode];
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
305 result[spec[current.flag, col.long.name]] = peek.optstring;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
306 i = i + 1;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
307
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
308 #no argument
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
309 } else {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
310 if ( debug ) print(' no argument!');
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
311
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
312 #if we require an argument, bail out
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
313 if ( spec[current.flag, col.has.argument] == flag.required.argument ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
314 stop(paste('flag "', this.flag, '" requires an argument', sep=''));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
315
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
316 #otherwise set flag as present.
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
317 } else if (
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
318 spec[current.flag, col.has.argument] == flag.optional.argument |
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
319 spec[current.flag, col.has.argument] == flag.no.argument
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
320 ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
321 x = TRUE;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
322 storage.mode(x) = spec[current.flag, col.mode];
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
323 result[spec[current.flag, col.long.name]] = x;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
324 } else {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
325 stop(paste("This should never happen.",
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
326 "Is your spec argument correct? Maybe you forgot to set",
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
327 "ncol=4, byrow=TRUE in your matrix call?"));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
328 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
329 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
330 #trailing flag without required argument
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
331 } else if ( spec[current.flag, col.has.argument] == flag.required.argument ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
332 stop(paste('flag "', this.flag, '" requires an argument', sep=''));
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
333
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
334 #trailing flag without optional argument
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
335 } else if ( spec[current.flag, col.has.argument] == flag.optional.argument ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
336 x = TRUE;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
337 storage.mode(x) = spec[current.flag, col.mode];
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
338 result[spec[current.flag, col.long.name]] = x;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
339
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
340 #trailing flag without argument
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
341 } else if ( spec[current.flag, col.has.argument] == flag.no.argument ) {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
342 x = TRUE;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
343 storage.mode(x) = spec[current.flag, col.mode];
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
344 result[spec[current.flag, col.long.name]] = x;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
345 } else {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
346 stop("this should never happen (2). please inform the author.");
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
347 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
348 #no dangling flag, nothing to do.
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
349 } else {
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
350 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
351
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
352 i = i+1;
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
353 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
354 return(result);
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
355 }
4aeb334de0e3 Uploaded
guerler
parents: 1
diff changeset
356
1
b4722f9d496f Uploaded
guerler
parents:
diff changeset
357 # convert multi parameter string (i.e. key1: value, key2: value, ...) to object
b4722f9d496f Uploaded
guerler
parents:
diff changeset
358 split <- function(argument){
b4722f9d496f Uploaded
guerler
parents:
diff changeset
359 # process parameter string
b4722f9d496f Uploaded
guerler
parents:
diff changeset
360 options <- list()
b4722f9d496f Uploaded
guerler
parents:
diff changeset
361 list <- gsub("\\s","", argument)
b4722f9d496f Uploaded
guerler
parents:
diff changeset
362 list <- strsplit(list, ",")
b4722f9d496f Uploaded
guerler
parents:
diff changeset
363 if (length(list) > 0) {
b4722f9d496f Uploaded
guerler
parents:
diff changeset
364 list <- list[[1]]
b4722f9d496f Uploaded
guerler
parents:
diff changeset
365 for (entry in list) {
b4722f9d496f Uploaded
guerler
parents:
diff changeset
366 pair <- strsplit(entry, ":")
b4722f9d496f Uploaded
guerler
parents:
diff changeset
367 if (length(pair) > 0) {
b4722f9d496f Uploaded
guerler
parents:
diff changeset
368 pair <- pair[[1]]
b4722f9d496f Uploaded
guerler
parents:
diff changeset
369 if (length(pair) == 2) {
b4722f9d496f Uploaded
guerler
parents:
diff changeset
370 options[[pair[1]]] <- pair[2]
b4722f9d496f Uploaded
guerler
parents:
diff changeset
371 }
b4722f9d496f Uploaded
guerler
parents:
diff changeset
372 }
b4722f9d496f Uploaded
guerler
parents:
diff changeset
373 }
b4722f9d496f Uploaded
guerler
parents:
diff changeset
374 }
b4722f9d496f Uploaded
guerler
parents:
diff changeset
375 return(options)
b4722f9d496f Uploaded
guerler
parents:
diff changeset
376 }
b4722f9d496f Uploaded
guerler
parents:
diff changeset
377
b4722f9d496f Uploaded
guerler
parents:
diff changeset
378 # get options, using the spec as defined by the enclosed list.
b4722f9d496f Uploaded
guerler
parents:
diff changeset
379 spec = matrix(c(
31
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
380 'workdir', 'w', 1, 'character', 'Work directory',
1
b4722f9d496f Uploaded
guerler
parents:
diff changeset
381 'module', 'm', 1, 'character', 'Module name',
b4722f9d496f Uploaded
guerler
parents:
diff changeset
382 'input', 'i', 1, 'character', 'Input tabular file',
b4722f9d496f Uploaded
guerler
parents:
diff changeset
383 'columns', 'c', 1, 'character', 'Columns string',
b4722f9d496f Uploaded
guerler
parents:
diff changeset
384 'settings', 's', 1, 'character', 'Settings string',
b4722f9d496f Uploaded
guerler
parents:
diff changeset
385 'output', 'o', 1, 'character', 'Output tabular file',
b4722f9d496f Uploaded
guerler
parents:
diff changeset
386 'help', 'h', 0, '', 'Help',
b4722f9d496f Uploaded
guerler
parents:
diff changeset
387 'verbose', 'v', 0, '', 'Verbose'
b4722f9d496f Uploaded
guerler
parents:
diff changeset
388 ), byrow=TRUE, ncol=5);
b4722f9d496f Uploaded
guerler
parents:
diff changeset
389 opt = getopt(spec);
b4722f9d496f Uploaded
guerler
parents:
diff changeset
390
b4722f9d496f Uploaded
guerler
parents:
diff changeset
391 # show help
31
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
392 if ( !is.null(opt$help) ||
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
393 is.null(opt$module) ||
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
394 is.null(opt$input) ||
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
395 is.null(opt$columns) ||
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
396 is.null(opt$output)) {
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
397 cat(getopt(spec, usage=TRUE))
1
b4722f9d496f Uploaded
guerler
parents:
diff changeset
398 q(status=1);
b4722f9d496f Uploaded
guerler
parents:
diff changeset
399 }
b4722f9d496f Uploaded
guerler
parents:
diff changeset
400
b4722f9d496f Uploaded
guerler
parents:
diff changeset
401 # read columns/settings
b4722f9d496f Uploaded
guerler
parents:
diff changeset
402 columns = split(opt$columns)
b4722f9d496f Uploaded
guerler
parents:
diff changeset
403 settings = split(opt$settings)
b4722f9d496f Uploaded
guerler
parents:
diff changeset
404
b4722f9d496f Uploaded
guerler
parents:
diff changeset
405 # read table
b4722f9d496f Uploaded
guerler
parents:
diff changeset
406 table <- read.table(opt$input)
b4722f9d496f Uploaded
guerler
parents:
diff changeset
407
31
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
408 # identify module file
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
409 module_file = paste(opt$workdir, opt$module, '.r', sep='')
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
410
1
b4722f9d496f Uploaded
guerler
parents:
diff changeset
411 # source module
31
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
412 source(module_file)
1
b4722f9d496f Uploaded
guerler
parents:
diff changeset
413
b4722f9d496f Uploaded
guerler
parents:
diff changeset
414 # run module
b4722f9d496f Uploaded
guerler
parents:
diff changeset
415 l = wrapper (table, columns, settings)
b4722f9d496f Uploaded
guerler
parents:
diff changeset
416
31
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
417 # header
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
418 header_title <- '# title\t\tCharts Toolkit (chartskit)'
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
419 header_date <- paste('# date\t\t', Sys.time(), sep='')
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
420 header_module <- paste('# module\t', opt$module, sep='')
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
421 header_settings <- paste('# settings\t', opt$settings, sep='')
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
422 header_columns <- paste('# columns\t', opt$columns, sep='')
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
423
1
b4722f9d496f Uploaded
guerler
parents:
diff changeset
424 # fill gaps
b4722f9d496f Uploaded
guerler
parents:
diff changeset
425 if (length(l) > 0) {
b4722f9d496f Uploaded
guerler
parents:
diff changeset
426 # print details
b4722f9d496f Uploaded
guerler
parents:
diff changeset
427 if (!is.null(opt$verbose)) {
b4722f9d496f Uploaded
guerler
parents:
diff changeset
428 print ('Columns:')
b4722f9d496f Uploaded
guerler
parents:
diff changeset
429 print (columns)
b4722f9d496f Uploaded
guerler
parents:
diff changeset
430 print ('Settings:')
b4722f9d496f Uploaded
guerler
parents:
diff changeset
431 print (settings)
b4722f9d496f Uploaded
guerler
parents:
diff changeset
432 print ('Result:')
31
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
433 print (l)
1
b4722f9d496f Uploaded
guerler
parents:
diff changeset
434 }
b4722f9d496f Uploaded
guerler
parents:
diff changeset
435
31
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
436 # create output file
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
437 output <- file(opt$output, open='wt')
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
438
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
439 # write header
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
440 writeLines('#', output)
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
441 writeLines(header_title, output)
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
442 writeLines(header_date, output)
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
443 writeLines(header_module, output)
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
444 writeLines(header_settings, output)
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
445 writeLines(header_columns, output)
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
446 writeLines('#', output)
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
447
1
b4722f9d496f Uploaded
guerler
parents:
diff changeset
448 # write table
31
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
449 write.table(l, file=output, row.names=FALSE, col.names = FALSE, quote=FALSE, sep='\t')
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
450
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
451 # close file
7774e0097ff4 Uploaded
guerler
parents: 27
diff changeset
452 close(output)
1
b4722f9d496f Uploaded
guerler
parents:
diff changeset
453 } else {
b4722f9d496f Uploaded
guerler
parents:
diff changeset
454 print ('Columns:')
b4722f9d496f Uploaded
guerler
parents:
diff changeset
455 print (columns)
b4722f9d496f Uploaded
guerler
parents:
diff changeset
456 print ('Settings:')
b4722f9d496f Uploaded
guerler
parents:
diff changeset
457 print (settings)
b4722f9d496f Uploaded
guerler
parents:
diff changeset
458 print ('No output generated.')
b4722f9d496f Uploaded
guerler
parents:
diff changeset
459 }