Browse code

refactored input checks

Felix Ernst authored on 24/05/2019 19:33:06
Showing21 changed files

... ...
@@ -1,7 +1,7 @@
1 1
 Package: RNAmodR
2 2
 Type: Package
3 3
 Title: Detection of post-transcriptional modifications
4
-Version: 0.99.12
4
+Version: 0.99.13
5 5
 Date: 2019-05-21
6 6
 Authors@R: c(person("Felix G.M.", 
7 7
                     "Ernst", 
... ...
@@ -66,6 +66,7 @@ Collate:
66 66
     'AllGenerics.R'
67 67
     'Gviz-ModifiedSequenceTrack-class.R'
68 68
     'Gviz-functions.R'
69
+    'settings.R'
69 70
     'Modifier-utils.R'
70 71
     'SequenceDataFrame-class.R'
71 72
     'normalization.R'
... ...
@@ -160,18 +160,16 @@ ModInosine <- function(x, annotation, sequences, seqinfo, ...){
160 160
 
161 161
 # settings ---------------------------------------------------------------------
162 162
 
163
-.norm_inosine_args <- function(input){
163
+.ModInosine_settings <- data.frame(
164
+  variable = c("minScore"),
165
+  testFUN = c(".not_numeric_between_0_100"),
166
+  errorValue = c(TRUE),
167
+  errorMessage = c("'minScore' must be numeric with a value between 0 and 100."),
168
+  stringsAsFactors = FALSE)
169
+
170
+.norm_ModInosine_settings <- function(input){
164 171
   minScore <- 0.4
165
-  if(!is.null(input[["minScore"]])){
166
-    minScore <- input[["minScore"]]
167
-    if(!is.numeric(minScore) | minScore < 0 | minScore > 100){
168
-      stop("'minScore' must be numeric with a value between 0 and 100.",
169
-           call. = FALSE)
170
-    }
171
-  }
172
-  args <- .norm_args(input)
173
-  args <- c(args,
174
-            list(minScore = minScore))
172
+  args <- .norm_settings(input, .ModInosine_settings, minScore)
175 173
   args
176 174
 }
177 175
 
... ...
@@ -181,8 +179,8 @@ setReplaceMethod(f = "settings",
181 179
                  signature = signature(x = "ModInosine"),
182 180
                  definition = function(x, value){
183 181
                    x <- callNextMethod()
184
-                   value <- .norm_inosine_args(value)
185
-                   x@arguments[names(value)] <- unname(value)
182
+                   value <- .norm_ModInosine_settings(value)
183
+                   x@settings[names(value)] <- unname(value)
186 184
                    x
187 185
                  })
188 186
 
... ...
@@ -3,6 +3,7 @@
3 3
 #' @include SequenceDataSet-class.R
4 4
 #' @include SequenceDataList-class.R
5 5
 #' @include Modifier-utils.R
6
+#' @include settings.R
6 7
 NULL
7 8
 
8 9
 invalidMessage <- paste0("Settings were changed after data aggregation or ",
... ...
@@ -120,7 +121,7 @@ invalidMessage <- paste0("Settings were changed after data aggregation or ",
120 121
 #' \code{dataType} is used.
121 122
 #' @slot aggregate the aggregated data as a \code{SplitDataFrameList}
122 123
 #' @slot modifications the found modifications as a \code{GRanges} object
123
-#' @slot arguments arguments used for the analysis as a \code{list}
124
+#' @slot settings arguments used for the analysis as a \code{list}
124 125
 #' @slot aggregateValidForCurrentArguments \code{TRUE} or \code{FALSE} whether
125 126
 #' the aggregate data was constructed with the current arguments
126 127
 #' @slot modificationsValidForCurrentArguments \code{TRUE} or \code{FALSE}
... ...
@@ -206,7 +207,7 @@ setClass("Modifier",
206 207
                    data = "SD_or_SDS_or_SDL",
207 208
                    aggregate = "CompressedSplitDataFrameList",
208 209
                    modifications = "GRanges",
209
-                   arguments = "list",
210
+                   settings = "list",
210 211
                    aggregateValidForCurrentArguments = "logical",
211 212
                    modificationsValidForCurrentArguments = "logical"),
212 213
          prototype = list(aggregateValidForCurrentArguments = FALSE,
... ...
@@ -495,40 +496,8 @@ setMethod(f = "sequences",
495 496
 #' @export
496 497
 setMethod(f = "seqinfo",
497 498
           signature = signature(x = "Modifier"),
498
-          definition = function(x){seqinfo(sequenceData(x))})
499
-
500
-.norm_args <- function(input){
501
-  minCoverage <- 10L
502
-  minReplicate <- 1L
503
-  find.mod <- TRUE
504
-  if(!is.null(input[["minCoverage"]])){
505
-    minCoverage <- input[["minCoverage"]]
506
-    if(!is.integer(minCoverage) ||
507
-       minCoverage < 0L ||
508
-       length(minCoverage) != 1){
509
-      stop("'minCoverage' must be a single positive integer value.")
510
-    }
511
-  }
512
-  if(!is.null(input[["minReplicate"]])){
513
-    minReplicate <- input[["minReplicate"]]
514
-    if(!is.integer(minReplicate) ||
515
-       minReplicate < 0L ||
516
-       length(minReplicate) != 1){
517
-      stop("'minReplicate' must be a single positive integer value.")
518
-    }
519
-  }
520
-  if(!is.null(input[["find.mod"]])){
521
-    find.mod <- input[["find.mod"]]
522
-    if(!assertive::is_a_bool(find.mod)){
523
-      stop("'find.mod' must be a single logical value.")
524
-    }
525
-  }
526
-  args <- list(minCoverage = minCoverage,
527
-               minReplicate = minReplicate,
528
-               find.mod = find.mod)
529
-  args
530
-}
531
-
499
+          definition = function(x){seqinfo(sequenceData(x))}
500
+)
532 501
 #' @rdname Modifier-functions
533 502
 #' @export
534 503
 setMethod(f = "validAggregate",
... ...
@@ -582,18 +551,42 @@ setMethod(f = "validModification",
582 551
 #' settings(mi) <- list(minCoverage = 11L)
583 552
 NULL
584 553
 
554
+.Modifier_settings <- data.frame(
555
+  variable = c("minCoverage",
556
+               "minReplicate",
557
+               "find.mod"),
558
+  testFUN = c(".not_integer_bigger_than_zero",
559
+              ".not_integer_bigger_than_zero",
560
+              ".is_a_bool"),
561
+  errorValue = c(TRUE,
562
+                 TRUE,
563
+                 FALSE),
564
+  errorMessage = c("'minCoverage' must be a single positive integer value.",
565
+                   "'minReplicate' must be a single positive integer value.",
566
+                   "'find.mod' must be a single logical value."),
567
+  stringsAsFactors = FALSE)
568
+
569
+.norm_Modifier_settings <- function(input){
570
+  minCoverage <- 10L
571
+  minReplicate <- 1L
572
+  find.mod <- TRUE
573
+  args <- .norm_settings(input, .Modifier_settings, minCoverage, minReplicate,
574
+                         find.mod)
575
+  args
576
+}
577
+
585 578
 #' @rdname settings
586 579
 #' @export
587 580
 setMethod(f = "settings",
588 581
           signature = signature(x = "Modifier"),
589 582
           definition = function(x, name){
590 583
             if(missing(name) || is.null(name)){
591
-              return(x@arguments)
584
+              return(x@settings)
592 585
             }
593 586
             if(!assertive::is_a_string(name)){
594 587
               stop("'name' must be a single character value.")
595 588
             }
596
-            x@arguments[[name]]
589
+            x@settings[[name]]
597 590
           }
598 591
 )
599 592
 
... ...
@@ -608,8 +601,8 @@ setReplaceMethod(f = "settings",
608 601
                    if(!is.list(value)){
609 602
                      value <- as.list(value)
610 603
                    }
611
-                   value <- .norm_args(value)
612
-                   x@arguments[names(value)] <- unname(value)
604
+                   value <- .norm_Modifier_settings(value)
605
+                   x@settings[names(value)] <- unname(value)
613 606
                    x@aggregateValidForCurrentArguments <- FALSE
614 607
                    x@modificationsValidForCurrentArguments <- FALSE
615 608
                    x
... ...
@@ -75,6 +75,20 @@ NULL
75 75
 }
76 76
 
77 77
 .rocr_exclusive_functions <- c("rch","auc","prbe","mxe","rmse","ecost")
78
+.rocr_performance_settings <- data.frame(
79
+  variable = c("measure",
80
+               "x.measure",
81
+               "score"),
82
+  testFUN = c(".is_a_string",
83
+              ".is_a_string",
84
+              ".is_a_string"),
85
+  errorValue = c(FALSE,
86
+                 FALSE,
87
+                 FALSE),
88
+  errorMessage = c("'measure' must a single character compatible with ?ROCR::performance.",
89
+                   "'x.measure' must a single character compatible with ?ROCR::performance.",
90
+                   "'score' must a single character and a valid column name in getAggregateData()."),
91
+  stringsAsFactors = FALSE)
78 92
 .norm_performance_args <- function(input, x){
79 93
   if(!is.list(input)){
80 94
     stop("'performance.args' must be a list.")
... ...
@@ -87,45 +101,48 @@ NULL
87 101
   measure <- "tpr"
88 102
   x.measure <- "fpr"
89 103
   score <- mainScore(x)
90
-  if(!is.null(input[["measure"]])){
91
-    measure <- input[["measure"]]
92
-    if(!assertive::is_a_string(measure)){
93
-      stop("'measure' must a single character compatible with ",
94
-           "?ROCR::performance.",
95
-           call. = FALSE)
96
-    }
104
+  args <- .norm_settings(input, .rocr_performance_settings, measure, x.measure,
105
+                         score)
106
+  if(args[["measure"]] %in% .rocr_exclusive_functions){
107
+    args[["x.measure"]] <- "cutoff"
97 108
   }
98
-  if(!is.null(input[["x.measure"]])){
99
-    if(length(input[["x.measure"]]) == 0L || is.na(input[["x.measure"]]) || 
100
-       input[["x.measure"]] == ""){
101
-      x.measure <- "cutoff"
102
-    } else {
103
-      x.measure <- input[["x.measure"]]
104
-      if(!assertive::is_a_string(x.measure)){
105
-        stop("'x.measure' must a single character compatible with ",
106
-             "?ROCR::performance.",
107
-             call. = FALSE)
108
-      }
109
-    }
110
-  } else if(measure %in% .rocr_exclusive_functions){
111
-    x.measure <- "cutoff"
109
+  if(is(x,"Modifier")){
110
+    cn <- colnames(getAggregateData(x)[[1]])
111
+  } else if(is(x,"ModifierSet")) {
112
+    cn <- colnames(getAggregateData(x[[1]])[[1]])
113
+  } else {
114
+    stop("")
112 115
   }
113
-  if(!is.null(input[["score"]])){
114
-    score <- input[["score"]]
115
-    if(!assertive::is_a_string(score) ||
116
-       !(score %in% colnames(getAggregateData(x)[[1]]))){
117
-      stop("'score' must a single character and a valid column name in ",
118
-           "getAggregateData().",
119
-           call. = FALSE)
120
-    }
116
+  if(!(args[["score"]] %in% cn)){
117
+    stop(.rocr_performance_settings[.rocr_performance_settings$variable == "score","errorMessage"],
118
+         call. = FALSE)
121 119
   }
122
-  args <- list(measure = measure,
123
-               x.measure = x.measure,
124
-               score = score)
125 120
   args <- c(args, input[!(names(input) %in% names(args))])
126 121
   args
127 122
 }
128 123
 
124
+.rocr_plot_settings <- data.frame(
125
+  variable = c("colorize",
126
+               "lwd",
127
+               "colorize.palette",
128
+               "abline",
129
+               "AUC"),
130
+  testFUN = c(".is_a_bool",
131
+              ".is_numeric_string",
132
+              ".is_a_string",
133
+              ".is_a_bool",
134
+              ".is_a_bool"),
135
+  errorValue = c(FALSE,
136
+                 FALSE,
137
+                 FALSE,
138
+                 FALSE,
139
+                 FALSE),
140
+  errorMessage = c("'colorize' must a single logical value.",
141
+                   "'lwd' must be a single numeric value.",
142
+                   "'colorize.palette' must a single character compatible with ?ROCR::plot.performance.",
143
+                   "'abline' must a single logical value.",
144
+                   "'AUC' must a single logical value."),
145
+  stringsAsFactors = FALSE)
129 146
 .norm_plot_args <- function(input){
130 147
   if(!is.list(input)){
131 148
     stop("'plot.args' must be a list.")
... ...
@@ -140,47 +157,8 @@ NULL
140 157
   colorize.palette <- NULL
141 158
   abline <- FALSE
142 159
   AUC <- FALSE
143
-  if(!is.null(input[["colorize.palette"]])){
144
-    colorize.palette <- input[["colorize.palette"]]
145
-    if(!assertive::is_a_string(colorize.palette)){
146
-      stop("'colorize.palette' must a single character compatible with ",
147
-           "?ROCR::plot.performance.",
148
-           call. = FALSE)
149
-    }
150
-  }
151
-  if(!is.null(input[["abline"]])){
152
-    abline <- input[["abline"]]
153
-    if(!assertive::is_a_bool(abline)){
154
-      stop("'abline' must a single logical value.",
155
-           call. = FALSE)
156
-    }
157
-  }
158
-  if(!is.null(input[["AUC"]])){
159
-    AUC <- input[["AUC"]]
160
-    if(!assertive::is_a_bool(AUC)){
161
-      stop("'AUC' must a single logical value.",
162
-           call. = FALSE)
163
-    }
164
-  }
165
-  if(!is.null(input[["colorize"]])){
166
-    colorize <- input[["colorize"]]
167
-    if(!assertive::is_a_bool(colorize)){
168
-      stop("'colorize' must a single logical value.",
169
-           call. = FALSE)
170
-    }
171
-  }
172
-  if(!is.null(input[["lwd"]])){
173
-    lwd <- input[["lwd"]]
174
-    if(!assertive::is_numeric_string(lwd)){
175
-      stop("'lwd' must be a single numeric value.",
176
-           call. = FALSE)
177
-    }
178
-  }
179
-  args <- list(colorize = colorize,
180
-               lwd = lwd,
181
-               colorize.palette = colorize.palette,
182
-               abline = abline,
183
-               AUC = AUC)
160
+  args <- .norm_settings(input, .rocr_plot_settings, colorize, lwd,
161
+                         colorize.palette, abline, AUC)
184 162
   args <- c(args, input[!(names(input) %in% names(args))])
185 163
   args
186 164
 }
... ...
@@ -1,5 +1,6 @@
1 1
 #' @include RNAmodR.R
2 2
 #' @include Modifier-class.R
3
+#' @include settings.R
3 4
 NULL
4 5
 
5 6
 #' @name subsetByCoord
... ...
@@ -67,7 +67,7 @@ NULL
67 67
 NULL
68 68
 
69 69
 .norm_show_argument <- function(show_arg, default = FALSE){
70
-  if(!assertive::is_a_bool(show_arg)){
70
+  if(missing(show_arg) || !assertive::is_a_bool(show_arg)){
71 71
     show_arg <- default
72 72
   }
73 73
   show_arg
... ...
@@ -94,27 +94,23 @@ NULL
94 94
   type
95 95
 }
96 96
 
97
+.viz_Modifier_settings <- data.frame(
98
+  variable = c("modified.seq",
99
+               "additional.mod"),
100
+  testFUN = c(".is_a_bool",
101
+              ".is_not_GRanges_or_GRangesList"),
102
+  errorValue = c(FALSE,
103
+                 TRUE),
104
+  errorMessage = c("'modified.seq' must be a single logical value.",
105
+                   "'additional.mod' must be a GRanges or GRangesList object, which is compatible with combineIntoModstrings()."),
106
+  stringsAsFactors = FALSE)
97 107
 .norm_viz_args_Modifier <- function(input, x){
98 108
   modified.seq <- FALSE
99 109
   additional.mod <- GRanges()
100
-  if(!is.null(input[["modified.seq"]])){
101
-    modified.seq <- input[["modified.seq"]]
102
-    if(!assertive::is_a_bool(modified.seq)){
103
-      stop("'modified.seq' must be a single logical value.",
104
-           call. = FALSE)
105
-    }
106
-  }
107
-  if(!is.null(input[["additional.mod"]])){
108
-    additional.mod <- input[["additional.mod"]]
109
-    if(!is(additional.mod,"GRanges") && !is(additional.mod,"GRangesList")){
110
-      stop("'additional.mod' must be a GRanges or GRangesList object, which is",
111
-           " compatible with combineIntoModstrings().",
112
-           call. = FALSE)
113
-    }
114
-  }
110
+  args <- .norm_settings(input, .viz_Modifier_settings, modified.seq,
111
+                         additional.mod)
115 112
   args <- c(.norm_viz_args_SequenceData(input, x),
116
-            list(modified.seq = modified.seq,
117
-                 additional.mod = additional.mod))
113
+            args)
118 114
   args
119 115
 }
120 116
 
... ...
@@ -131,16 +131,16 @@ setMethod(f = "relistToClass",
131 131
        listData = x)
132 132
 }
133 133
 
134
+
135
+.ModifierSet_settings <- data.frame(
136
+  variable = c("internalBP"),
137
+  testFUN = c("assertive::is_a_bool"),
138
+  errorValue = c(FALSE),
139
+  errorMessage = c("'internalBP' must be TRUE or FALSE."),
140
+  stringsAsFactors = FALSE)
134 141
 .norm_ModifierSet_args <- function(input){
135 142
   internalBP <- FALSE
136
-  if(!is.null(input[["internalBP"]])){
137
-    internalBP <- input[["internalBP"]]
138
-    if(!assertive::is_a_bool(internalBP)){
139
-      stop("'internalBP' must be TRUE or FALSE.",
140
-           call. = FALSE)
141
-    }
142
-  }
143
-  args <- list(internalBP = internalBP)
143
+  args <- .norm_settings(input, .ModifierSet_settings, internalBP)
144 144
   args
145 145
 }
146 146
 
... ...
@@ -99,6 +99,7 @@ NULL
99 99
   } else {
100 100
     compareType <- NA
101 101
   }
102
+  # browser()
102 103
   allTypes <- FALSE
103 104
   perTranscript <- FALSE
104 105
   sequenceData <- FALSE
... ...
@@ -2,18 +2,17 @@
2 2
 #' @include Modifier-viz.R
3 3
 NULL
4 4
 
5
+.viz_ModifierSet_settings <- data.frame(
6
+  variable = c("colours"),
7
+  testFUN = c(".not_colours"),
8
+  errorValue = c(TRUE),
9
+  errorMessage = c("'colours' must be valid colour representation, which can be interpreted by col2rgb()."),
10
+  stringsAsFactors = FALSE)
5 11
 .norm_viz_args_ModifierSet <- function(input, x){
6 12
   colours <- NA
7
-  if(!is.null(input[["colours"]])){
8
-    colours <- input[["colours"]]
9
-    if(!is.character(colours) || any(!.are_colours(colours))){
10
-      stop("'colours' must be valid colour representation, which can be ",
11
-           "interpreted by col2rgb().",
12
-           call. = FALSE)
13
-    }
14
-  }
13
+  args <- .norm_settings(input, .viz_ModifierSet_settings, colours)
15 14
   args <- c(.norm_viz_args_Modifier(input, x),
16
-            list(colours = colours))
15
+            args)
17 16
   args
18 17
 }
19 18
 
... ...
@@ -1,6 +1,7 @@
1 1
 #' @include RNAmodR.R
2 2
 #' @include normalization.R
3 3
 #' @include SequenceDataFrame-class.R
4
+#' @include settings.R
4 5
 NULL
5 6
 
6 7
 #' @name SequenceData-class
... ...
@@ -105,9 +106,9 @@ setClass("SequenceData",
105 106
                    unlistType = "character",
106 107
                    dataDescription = "character"),
107 108
          prototype = list(ranges = GRangesList(),
108
-                 sequencesType = "RNAStringSet",
109
-                 sequences = RNAStringSet(),
110
-                 unlistType = "SequenceDataFrame"))
109
+                          sequencesType = "RNAStringSet",
110
+                          sequences = RNAStringSet(),
111
+                          unlistType = "SequenceDataFrame"))
111 112
 
112 113
 setMethod(
113 114
   f = "initialize",
... ...
@@ -397,17 +398,15 @@ setMethod("rownames", "SequenceData",
397 398
 
398 399
 # constructor ------------------------------------------------------------------
399 400
 
401
+.quality_settings <- data.frame(
402
+  variable = c("minQuality"),
403
+  testFUN = c(".not_integer_bigger_equal_than_one"),
404
+  errorValue = c(TRUE),
405
+  errorMessage = c("'minQuality' must be integer with a value higher than 1L."),
406
+  stringsAsFactors = FALSE)
407
+
400 408
 .norm_min_quality <- function(input, minQuality){
401
-  if(!is.null(input[["minQuality"]])){
402
-    minQuality <- input[["minQuality"]]
403
-    if(!is.integer(minQuality) | minQuality <= 1L){
404
-      if(!is.na(minQuality)){
405
-        stop("'minQuality' must be integer with a value higher than 1L.",
406
-             call. = FALSE)
407
-      }
408
-    }
409
-  }
410
-  minQuality
409
+  .norm_settings(input, .quality_settings, minQuality)[["minQuality"]]
411 410
 }
412 411
 
413 412
 .get_replicate_number <- function(bamfiles, conditions){
... ...
@@ -2,10 +2,42 @@
2 2
 #' @include SequenceData-class.R
3 3
 #' @include SequenceDataSet-class.R
4 4
 #' @include Modifier-subset.R
5
+#' @include settings.R
5 6
 NULL
6 7
 
7 8
 # common utility function for subsetting ---------------------------------------
8 9
 
10
+.subset_settings <- data.frame(
11
+  variable = c("name",
12
+               "type",
13
+               "merge",
14
+               "flanking",
15
+               "rawData",
16
+               "perTranscript",
17
+               "sequenceData"),
18
+  testFUN = c(".empty_character",
19
+              ".empty_character",
20
+              ".is_a_bool",
21
+              ".not_integer_bigger_equal_than_zero",
22
+              ".is_a_bool",
23
+              ".is_a_bool",
24
+              ".is_a_bool"),
25
+  errorValue = c(TRUE,
26
+                 TRUE,
27
+                 FALSE,
28
+                 TRUE,
29
+                 FALSE,
30
+                 FALSE,
31
+                 FALSE),
32
+  errorMessage = c("'name' must be a character with a width > 0L.",
33
+                   "'type' must be a character with a width > 0L.",
34
+                   "'merge' must be a single logical value.",
35
+                   "'flanking' must be a single integer value equal or higher than 0L.",
36
+                   "'rawData' must be a single logical value.",
37
+                   "'perTranscript' must be a single logical value.",
38
+                   "'sequenceData' must be a single logical value."),
39
+  stringsAsFactors = FALSE)
40
+
9 41
 .norm_subset_args <- function(input,x){
10 42
   name <- NA_character_
11 43
   if(is(x,"Modifier") || is(x,"ModifierSet")){
... ...
@@ -18,62 +50,14 @@ NULL
18 50
   perTranscript <- FALSE
19 51
   sequenceData <- FALSE
20 52
   rawData <- FALSE # only used for subsetting SequenceData
21
-  if(!is.null(input[["name"]])){
22
-    name <- input[["name"]]
23
-    if(!is.character(name) || width(name) == 0L){
24
-      stop("'name' must be a character with a width > 0L.",
25
-           call. = FALSE)
26
-    }
27
-  }
28
-  if(!is.null(input[["type"]])){
29
-    type <- input[["type"]]
30
-    if(!is.na(type)){
31
-      if(!is.character(type) || width(type) == 0L){
32
-        stop("'type' must be a character with a width > 0L.",
33
-             call. = FALSE)
34
-      }
35
-      if(!(type %in% Modstrings::shortName(Modstrings::ModRNAString()))){
36
-        stop("'type' must be one or more elements of shortName(ModRNAString()).",
37
-             call. = FALSE)
38
-      }
39
-    }
40
-  }
41
-  if(!is.null(input[["merge"]])){
42
-    merge <- input[["merge"]]
43
-    if(!assertive::is_a_bool(merge)){
44
-      stop("'merge' must be a single logical value.", call. = FALSE)
45
-    }
46
-  }
47
-  if(!is.null(input[["flanking"]])){
48
-    flanking <- input[["flanking"]]
49
-    if(!is.integer(flanking) || flanking < 0L){
50
-      stop("'flanking' must be a single integer value equal or higher than 0L.",
51
-           call. = FALSE)
52
-    }
53
-  }
54
-  if(!is.null(input[["rawData"]])){ # only used for subsetting SequenceData
55
-    rawData <- input[["rawData"]]
56
-    if(!assertive::is_a_bool(rawData)){
57
-      stop("'rawData' must be a single logical value.",
53
+  args <- .norm_settings(input, .subset_settings, name, type, merge, flanking,
54
+                         perTranscript, sequenceData, rawData)
55
+  if(!is.na(args[["type"]])){
56
+    if(!(args[["type"]] %in% Modstrings::shortName(Modstrings::ModRNAString()))){
57
+      stop("'type' must be one or more elements of shortName(ModRNAString()).",
58 58
            call. = FALSE)
59 59
     }
60 60
   }
61
-  if(!is.null(input[["perTranscript"]])){
62
-    perTranscript <- input[["perTranscript"]]
63
-    if(!assertive::is_a_bool(perTranscript)){
64
-      stop("'perTranscript' must be a single logical value.",
65
-           call. = FALSE)
66
-    }
67
-  }
68
-  if(!is.null(input[["sequenceData"]])){
69
-    sequenceData <- input[["sequenceData"]]
70
-    if(!assertive::is_a_bool(sequenceData)){
71
-      stop("'sequenceData' must be a single logical value.")
72
-    }
73
-  }
74
-  args <- list(name = name, type = type, merge = merge, flanking = flanking,
75
-               rawData = rawData, perTranscript = perTranscript,
76
-               sequenceData = sequenceData)
77 61
   args
78 62
 }
79 63
 
... ...
@@ -65,17 +65,6 @@ NULL
65 65
        to = end)
66 66
 }
67 67
 
68
-
69
-#' @importFrom grDevices col2rgb
70
-.are_colours <- function(x) {
71
-  vapply(x,
72
-         function(z) {
73
-           tryCatch(is.matrix(grDevices::col2rgb(z)),
74
-                    error = function(e) FALSE)
75
-         },
76
-         logical(1))
77
-}
78
-
79 68
 .norm_viz_colour <- function(colour, type = NA){
80 69
   if(!is.character(colour) || any(!.are_colours(colour))){
81 70
     stop("'colour' must be a character vector and contain valid colours, which",
82 71
new file mode 100644
... ...
@@ -0,0 +1,118 @@
1
+#' @include RNAmodR.R
2
+NULL
3
+
4
+# testthat
5
+
6
+.test_test_TRUE <- function(x){TRUE}
7
+.test_test_FALSE <- function(x){FALSE}
8
+
9
+# tests ------------------------------------------------------------------------
10
+
11
+.not_logical_operator <- function(x){
12
+  .empty_character(x) | !(x %in% c("|","&"))
13
+}
14
+
15
+.not_single_numeric <- function(x){
16
+  !is.numeric(x) | length(x) != 1 | is.na(x)
17
+}
18
+.not_numeric_between_0_100 <- function(x){
19
+  .not_single_numeric(x) | x < 0 | x > 100
20
+}
21
+.not_numeric_between_0_1 <- function(x){
22
+  .not_single_numeric(x) | x < 0 | x > 1
23
+}
24
+.not_numeric_bigger_zero <- function(x){
25
+  .not_single_numeric(x) | x < 0
26
+}
27
+
28
+.not_single_integer <- function(x){
29
+  !is.integer(x) | length(x) != 1 | is.na(x)
30
+}
31
+.not_integer_bigger_than_10 <- function(x){
32
+  .not_single_integer(x) | x <= 10L
33
+}
34
+.not_integer_bigger_than_zero <- function(x){
35
+  .not_single_integer(x) | x <= 0L
36
+}
37
+.not_integer_bigger_equal_than_zero <- function(x){
38
+  .not_single_integer(x) | x < 0L
39
+}
40
+.not_integer_bigger_equal_than_one <- function(x){
41
+  .not_single_integer(x) | x <= 1L
42
+}
43
+
44
+.is_not_GRanges_or_GRangesList <- function(x){
45
+  !is(x,"GRanges") && !is(x,"GRangesList")
46
+}
47
+
48
+#' @importFrom grDevices col2rgb
49
+.are_colours <- function(x) {
50
+  vapply(x,
51
+         function(z) {
52
+           tryCatch(is.matrix(grDevices::col2rgb(z)),
53
+                    error = function(e) FALSE)
54
+         },
55
+         logical(1))
56
+}
57
+.not_colours <- function(x){
58
+  !is.character(x) | any(!.are_colours(x))
59
+}
60
+
61
+.empty_character <- function(x){
62
+  if(!is.character(x) | is.na(x)){
63
+    return(TRUE)
64
+  }
65
+  width(x) == 0L
66
+}
67
+
68
+# test import from assertive ---------------------------------------------------
69
+
70
+.is_a_bool <- assertive::is_a_bool
71
+.is_numeric_string <- assertive::is_numeric_string
72
+.is_a_string <- assertive::is_a_string
73
+
74
+# testing settings -------------------------------------------------------------
75
+
76
+.get_name_in_parent_list <- function(...){
77
+  xnames <- assertive::get_name_in_parent(list(...))
78
+  xnames <- gsub("list\\(","",gsub("\\)","",xnames))
79
+  xnames <- strsplit(xnames,", ")[[1]]
80
+  xnames
81
+}
82
+
83
+.test_setting <- function(xname, settings, defaults, input){
84
+  test <- settings$variable == xname
85
+  FUN <- as.character(settings[test,"testFUN"])
86
+  default <- defaults[[xname]]
87
+  input <- input[[xname]]
88
+  if(is.null(input)){
89
+    return(default)
90
+  }
91
+  FUN <- get(FUN)
92
+  if(FUN(input) == settings[test,"errorValue"]){
93
+    stop(as.character(settings[test,"errorMessage"]), call. = FALSE)
94
+  }
95
+  input
96
+}
97
+
98
+.norm_settings <- function(input, settings, ...){
99
+  if(!all(c("variable","testFUN","errorValue","errorMessage") %in% colnames(settings))){
100
+    stop("Invalid columns in settings test definition.", call. = FALSE)
101
+  }
102
+  if(any(duplicated(settings$variable))){
103
+    stop("Duplicated variable names in settings test definition.",
104
+         call. = FALSE)
105
+  }
106
+  xnames <- .get_name_in_parent_list(...)
107
+  defaults <- list(...)
108
+  names(defaults) <- xnames
109
+  f <- xnames %in% settings$variable
110
+  if(!all(f)){
111
+    stop("Test for variables '",
112
+         paste(xnames[!f],collapse = "', '"),
113
+         "' not found.", call. = FALSE)
114
+  }
115
+  args <- lapply(xnames, .test_setting, settings, defaults, input)
116
+  names(args) <- xnames
117
+  args
118
+}
0 119
Binary files a/data/msi.rda and b/data/msi.rda differ
... ...
@@ -123,7 +123,7 @@ condition types.}
123 123
 
124 124
 \item{\code{modifications}}{the found modifications as a \code{GRanges} object}
125 125
 
126
-\item{\code{arguments}}{arguments used for the analysis as a \code{list}}
126
+\item{\code{settings}}{arguments used for the analysis as a \code{list}}
127 127
 
128 128
 \item{\code{aggregateValidForCurrentArguments}}{\code{TRUE} or \code{FALSE} whether
129 129
 the aggregate data was constructed with the current arguments}
130 130
new file mode 100644
... ...
@@ -0,0 +1,65 @@
1
+
2
+context("Settings")
3
+test_that("Settings:",{
4
+  variable1 <- 1
5
+  variable2 <- 2
6
+  variable3 <- 3
7
+  expect_equal(RNAmodR:::.get_name_in_parent_list(),character(0))
8
+  expect_equal(RNAmodR:::.get_name_in_parent_list(variable1),c("variable1"))
9
+  expect_equal(RNAmodR:::.get_name_in_parent_list(variable1,variable2),
10
+               c("variable1","variable2"))
11
+  .test_settings_df <- data.frame(
12
+    variable = c("variable1","variable2"),
13
+    stringsAsFactors = FALSE)
14
+  expect_error(RNAmodR:::.test_setting("variable1",.test_settings_df,list(variable1 = 2),
15
+                                        list(variable1 = 3)),
16
+               "invalid first argument")
17
+  expect_error(RNAmodR:::.norm_settings(list(variable2 = 4),.test_settings_df,
18
+                                        variable1),
19
+               "Invalid columns in settings test definition")
20
+  .test_settings_df <- data.frame(
21
+    variable = c("variable1","variable1"),
22
+    testFUN = c(".test_test_TRUE",".test_test_FALSE"),
23
+    errorValue = c(FALSE,TRUE),
24
+    errorMessage = c("1","2"),
25
+    stringsAsFactors = FALSE)
26
+  expect_error(RNAmodR:::.norm_settings(list(variable2 = 4),.test_settings_df,
27
+                                        variable1),
28
+               "Duplicated variable names in settings test definition")
29
+  .test_settings_df <- data.frame(
30
+    variable = c("variable1","variable2"),
31
+    testFUN = c(".test_test_TRUE",".test_test_FALSE"),
32
+    errorValue = c(FALSE,TRUE),
33
+    errorMessage = c("1","2"),
34
+    stringsAsFactors = FALSE)
35
+  expect_equal(RNAmodR:::.test_setting("variable1",.test_settings_df,list(variable1 = 2),
36
+                                       list(variable1 = 3)),
37
+               3)
38
+  expect_equal(RNAmodR:::.test_setting("variable1",.test_settings_df,list(variable1 = 2),
39
+                                       list()),
40
+               2)
41
+  .test_settings_df <- data.frame(
42
+    variable = c("variable1","variable2"),
43
+    testFUN = c(".test_test_TRUE",".test_test_FALSE"),
44
+    errorValue = c(TRUE,TRUE),
45
+    errorMessage = c("1","2"),
46
+    stringsAsFactors = FALSE)
47
+  expect_error(RNAmodR:::.test_setting("variable1",.test_settings_df,list(variable1 = 2),
48
+                                       list(variable1 = 3)),
49
+               "1")
50
+  expect_equal(RNAmodR:::.test_setting("variable2",.test_settings_df,list(variable2 = 2),
51
+                                       list(variable2 = 3)),
52
+               3)
53
+  expect_equal(RNAmodR:::.norm_settings(list(variable2 = 4),.test_settings_df,
54
+                                        variable1),
55
+               list(variable1 = 1))
56
+  expect_equal(RNAmodR:::.norm_settings(list(variable2 = 4),.test_settings_df,
57
+                                        variable2),
58
+               list(variable2 = 4))
59
+  expect_error(RNAmodR:::.norm_settings(list(variable1 = 4),.test_settings_df,
60
+                                        variable1),
61
+               "1")
62
+  expect_error(RNAmodR:::.norm_settings(list(variable3 = 4),.test_settings_df,
63
+                                        variable3),
64
+               "Test for variables 'variable3' not found.")
65
+})
... ...
@@ -70,22 +70,22 @@ test_that("SequenceDataList:",{
70 70
   expect_equal(ranges(sdl),ranges(sdl[[1]]))
71 71
   expect_equal(sequences(sdl),sequences(sdl[[1]]))
72 72
   ##############################################################################
73
-  # actual <- aggregate(sdl)
74
-  # expect_s4_class(actual,"SimpleList")
75
-  # expect_equal(actual,
76
-  #              SimpleList(End5SequenceData_PileupSequenceData = aggregate(sdl[[1]]),
77
-  #                         End5SequenceData = aggregate(sdl[[2]]),
78
-  #                         PileupSequenceData = aggregate(sdl[[3]])))
79
-  # actual <- as.list(sdl)
80
-  # expect_type(actual,"list")
81
-  # expect_named(actual,names)
82
-  # expect_equal(actual[[2]],e5sd)
83
-  # expect_equal(actual[[3]],psd)
84
-  # actual <- as.list(sdl, use.names = FALSE)
85
-  # expect_null(names(actual))
86
-  # expect_true(validObject(actual))
87
-  # # error
88
-  # expect_error(SequenceDataSet(e5sd,c(1,2,3)),
89
-  #              "All elements in 'x' must be SequenceData objects")
90
-  # expect_error(as.list(sdl, use.names = 1))
73
+  actual <- aggregate(sdl)
74
+  expect_s4_class(actual,"SimpleList")
75
+  expect_equal(actual,
76
+               SimpleList(End5SequenceData_PileupSequenceData = aggregate(sdl[[1]]),
77
+                          End5SequenceData = aggregate(sdl[[2]]),
78
+                          PileupSequenceData = aggregate(sdl[[3]])))
79
+  actual <- as.list(sdl)
80
+  expect_type(actual,"list")
81
+  expect_named(actual,names)
82
+  expect_equal(actual[[2]],e5sd)
83
+  expect_equal(actual[[3]],psd)
84
+  actual <- as.list(sdl, use.names = FALSE)
85
+  expect_null(names(actual))
86
+  expect_true(validObject(actual))
87
+  # error
88
+  expect_error(SequenceDataSet(e5sd,c(1,2,3)),
89
+               "All elements in 'x' must be SequenceData objects")
90
+  expect_error(as.list(sdl, use.names = 1))
91 91
 })
... ...
@@ -5,18 +5,18 @@ test_that("Modifier/ModifierSet:",{
5 5
   data(psd,package = "RNAmodR")
6 6
   data(e5sd,package = "RNAmodR")
7 7
   # arguments
8
-  expect_error(RNAmodR:::.norm_args(),
8
+  expect_error(RNAmodR:::.norm_Modifier_settings(),
9 9
                'argument "input" is missing, with no default')
10
-  actual <- RNAmodR:::.norm_args(list())
10
+  actual <- RNAmodR:::.norm_Modifier_settings(list())
11 11
   expect_type(actual,"list")
12 12
   expect_named(actual,c("minCoverage","minReplicate","find.mod"))
13
-  expect_error(RNAmodR:::.norm_args(list(minCoverage = 1)),
13
+  expect_error(RNAmodR:::.norm_Modifier_settings(list(minCoverage = 1)),
14 14
                "'minCoverage' must be a single positive integer value")
15
-  expect_error(RNAmodR:::.norm_args(list(minReplicate = 1)),
15
+  expect_error(RNAmodR:::.norm_Modifier_settings(list(minReplicate = 1)),
16 16
                "'minReplicate' must be a single positive integer value")
17
-  expect_error(RNAmodR:::.norm_args(list(minReplicate = -1L)),
17
+  expect_error(RNAmodR:::.norm_Modifier_settings(list(minReplicate = -1L)),
18 18
                "'minReplicate' must be a single positive integer value")
19
-  expect_error(RNAmodR:::.norm_args(list(find.mod = 1)),
19
+  expect_error(RNAmodR:::.norm_Modifier_settings(list(find.mod = 1)),
20 20
                "'find.mod' must be a single logical value")
21 21
   # .norm_SequenceData_elements
22 22
   expect_error(RNAmodR:::.check_SequenceData_elements(),
... ...
@@ -23,12 +23,12 @@ test_that("Subsetting SequenceData:",{
23 23
   expect_error(RNAmodR:::.norm_subset_args(list(sequenceData = 1),msi),
24 24
                "'sequenceData' must be a single logical value")
25 25
   expect_type(actual,"list")
26
-  expect_named(actual,c("name","type","merge","flanking","rawData",
27
-                        "perTranscript","sequenceData"))
26
+  expect_named(actual,c("name","type","merge","flanking","perTranscript",
27
+                        "sequenceData","rawData"))
28 28
   actual <- RNAmodR:::.norm_subset_args(list(),psd)
29 29
   expect_type(actual,"list")
30
-  expect_named(actual,c("name","type","merge","flanking","rawData",
31
-                        "perTranscript","sequenceData"))
30
+  expect_named(actual,c("name","type","merge","flanking","perTranscript",
31
+                        "sequenceData","rawData"))
32 32
   expect_equal(RNAmodR:::.norm_subset_args(list(name = "abc"),msi)$name,"abc")
33 33
   expect_equal(RNAmodR:::.norm_subset_args(list(type = "I"),msi)$type,"I")
34 34
   expect_equal(RNAmodR:::.norm_subset_args(list(flanking = 1L),msi)$flanking,1L)
... ...
@@ -133,8 +133,7 @@ test_that("Visualization:",{
133 133
   expect_equal(width(actual),103L)
134 134
   expect_equal(names(actual),chr)
135 135
   # internal functions Modifier
136
-  expect_error(RNAmodR:::.norm_show_argument(),
137
-               'argument "show_arg" is missing, with no default')
136
+  expect_false(RNAmodR:::.norm_show_argument())
138 137
   expect_false(RNAmodR:::.norm_show_argument(1))
139 138
   expect_true(RNAmodR:::.norm_show_argument(1,default = TRUE))
140 139
   expect_error(RNAmodR:::.norm_score_type(),"'type' is missing")
... ...
@@ -136,7 +136,7 @@ setReplaceMethod(f = "settings",
136 136
                  definition = function(x, value){
137 137
                    x <- callNextMethod()
138 138
                    # validate special setting here
139
-                   x@arguments[names(value)] <- unname(.norm_example_args(value))
139
+                   x@settings[names(value)] <- unname(.norm_example_args(value))
140 140
                    x
141 141
                  })
142 142
 ```