Browse code

reworked dependent on assertive package

FelixErnst authored on 18/07/2020 08:13:55
Showing14 changed files

... ...
@@ -1,8 +1,8 @@
1 1
 Package: RNAmodR
2 2
 Type: Package
3 3
 Title: Detection of post-transcriptional modifications in high throughput sequencing data
4
-Version: 1.3.3
5
-Date: 2020-06-08
4
+Version: 1.3.4
5
+Date: 2020-07-18
6 6
 Authors@R: c(person("Felix G.M.", 
7 7
                     "Ernst", 
8 8
                     email = "felix.gm.ernst@outlook.com", 
... ...
@@ -28,14 +28,12 @@ Depends:
28 28
     S4Vectors (>= 0.27.12),
29 29
     IRanges (>= 2.23.9),
30 30
     GenomicRanges,
31
-    Modstrings,
32
-    GenomeInfoDbData
31
+    Modstrings
33 32
 Imports:
34 33
     methods,
35 34
     stats,
36 35
     grDevices, 
37 36
     matrixStats,
38
-    assertive,
39 37
     BiocGenerics,
40 38
     Biostrings (>= 2.57.2),
41 39
     BiocParallel,
... ...
@@ -137,7 +137,6 @@ import(BiocGenerics)
137 137
 import(GenomicRanges)
138 138
 import(Gviz)
139 139
 import(S4Vectors)
140
-import(assertive)
141 140
 import(methods)
142 141
 importClassesFrom(IRanges,CharacterList)
143 142
 importClassesFrom(IRanges,IRanges)
... ...
@@ -302,10 +302,10 @@ setClass("Modifier",
302 302
   if(is(seqdata,"SequenceData")){
303 303
     seqdata <- list(seqdata)
304 304
   }
305
-  if(!assertive::is_a_bool(x@aggregateValidForCurrentArguments)){
305
+  if(!.is_a_bool(x@aggregateValidForCurrentArguments)){
306 306
     return("Invalid slot: 'aggregateValidForCurrentArguments'")
307 307
   }
308
-  if(!assertive::is_a_bool(x@aggregateValidForCurrentArguments)){
308
+  if(!.is_a_bool(x@aggregateValidForCurrentArguments)){
309 309
     return("Invalid slot: 'modificationsValidForCurrentArguments'")
310 310
   }
311 311
   if(hasAggregateData(x)){
... ...
@@ -448,8 +448,9 @@ setMethod(f = "modifications",
448 448
           signature = signature(x = "Modifier"),
449 449
           definition =
450 450
             function(x, perTranscript = FALSE){
451
-              if(!assertive::is_a_bool(perTranscript)){
452
-                stop("'perTranscript' has to be a single logical value.")
451
+              if(!.is_a_bool(perTranscript)){
452
+                stop("'perTranscript' has to be a single logical value.",
453
+                     call. = FALSE)
453 454
               }
454 455
               valid <- c(validAggregate(x), validModification(x))
455 456
               if(!all(valid)){
... ...
@@ -554,7 +555,7 @@ setMethod(f = "sequences",
554 555
           signature = signature(x = "Modifier"),
555 556
           definition =
556 557
             function(x, modified = FALSE){
557
-              if(!assertive::is_a_bool(modified)){
558
+              if(!.is_a_bool(modified)){
558 559
                 stop("'modified' has to be a single logical value.",
559 560
                      call. = FALSE)
560 561
               }
... ...
@@ -648,8 +649,9 @@ setMethod(f = "settings",
648 649
             if(missing(name) || is.null(name)){
649 650
               return(x@settings)
650 651
             }
651
-            if(!assertive::is_a_string(name)){
652
-              stop("'name' must be a single character value.")
652
+            if(!.is_a_string(name)){
653
+              stop("'name' must be a single character value.",
654
+                   call. = FALSE)
653 655
             }
654 656
             x@settings[[name]]
655 657
           }
... ...
@@ -975,7 +977,10 @@ setMethod(f = "aggregate",
975 977
           signature = signature(x = "Modifier"),
976 978
           definition =
977 979
             function(x, force = FALSE){
978
-              assertive::assert_is_a_bool(force)
980
+              if(!.is_a_bool(force)){
981
+                stop("'force' has to be TRUE or FALSE.",
982
+                     call. = FALSE)
983
+              }
979 984
               if(!hasAggregateData(x) || force){
980 985
                 x@aggregate <- .check_aggregate_modifier(aggregateData(x), x)
981 986
                 x@aggregateValidForCurrentArguments <- TRUE
... ...
@@ -1065,7 +1070,10 @@ setMethod(f = "modify",
1065 1070
           signature = signature(x = "Modifier"),
1066 1071
           definition =
1067 1072
             function(x, force = FALSE){
1068
-              assertive::assert_is_a_bool(force)
1073
+              if(!.is_a_bool(force)){
1074
+                stop("'force' has to be TRUE or FALSE.",
1075
+                     call. = FALSE)
1076
+              }
1069 1077
               if(!validAggregate(x) | force){
1070 1078
                 x <- aggregate(x, force = TRUE)
1071 1079
               }
... ...
@@ -10,10 +10,21 @@ setMethod(f = "constructModRanges",
10 10
             if(nrow(data) == 0L) {
11 11
               return(GenomicRanges::GRanges()) 
12 12
             }
13
-            assertive::assert_is_a_non_empty_string(modType)
14
-            assertive::assert_is_closure_function(scoreFun)
15
-            assertive::assert_is_a_non_empty_string(source)
16
-            assertive::assert_is_a_non_empty_string(type)
13
+            if(!.is_non_empty_string(modType)){
14
+              stop("'modType' must be single non empty character value.",
15
+                   call. = FALSE)
16
+            }
17
+            if(!.is_function(scoreFun)){
18
+              stop("'scoreFun' must be a function.", call. = FALSE)
19
+            }
20
+            if(!.is_non_empty_string(source)){
21
+              stop("'source' must be single non empty character value.",
22
+                   call. = FALSE)
23
+            }
24
+            if(!.is_non_empty_string(type)){
25
+              stop("'type' must be single non empty character value.",
26
+                   call. = FALSE)
27
+            }
17 28
             if(!.is_valid_modType(modType)){
18 29
               stop("Modification '",modType,"' not found in the short name ",
19 30
                    "alphabet from the Modstrings package. ",
... ...
@@ -67,7 +67,7 @@ NULL
67 67
 NULL
68 68
 
69 69
 .norm_show_argument <- function(show_arg, default = FALSE){
70
-  if(missing(show_arg) || !assertive::is_a_bool(show_arg)){
70
+  if(missing(show_arg) || !.is_a_bool(show_arg)){
71 71
     show_arg <- default
72 72
   }
73 73
   show_arg
... ...
@@ -133,7 +133,7 @@ setMethod(f = "relistToClass",
133 133
 
134 134
 .ModifierSet_settings <- data.frame(
135 135
   variable = c("internalBP"),
136
-  testFUN = c("assertive::is_a_bool"),
136
+  testFUN = c(".is_a_bool"),
137 137
   errorValue = c(FALSE),
138 138
   errorMessage = c("'internalBP' must be TRUE or FALSE."),
139 139
   stringsAsFactors = FALSE)
... ...
@@ -480,7 +480,7 @@ setMethod(f = "sequences",
480 480
           signature = signature(x = "ModifierSet"),
481 481
           definition = 
482 482
             function(x, modified = FALSE){
483
-              if(!assertive::is_a_bool(modified)){
483
+              if(!.is_a_bool(modified)){
484 484
                 stop("'modified' has to be a single logical value.",
485 485
                      call. = FALSE)
486 486
               }
... ...
@@ -97,7 +97,7 @@ NULL
97 97
                "allTypes",
98 98
                "perTranscript",
99 99
                "sequenceData"),
100
-  testFUN = c(".is_a_non_empty_string",
100
+  testFUN = c(".is_non_empty_string",
101 101
               ".is_a_bool",
102 102
               ".is_a_bool",
103 103
               ".is_a_bool"),
... ...
@@ -263,7 +263,10 @@ setMethod("compareByCoord",
263 263
     colnames <- colnames(data)
264 264
     colnames <- colnames[!(colnames %in% c("positions","names","mod","Activity"))]
265 265
     if(is.character(normalize)){
266
-      assertive::assert_is_a_string(normalize)
266
+      if(!.is_non_empty_string(normalize)){
267
+        stop("'normalize' must be single non empty character value.",
268
+             call. = FALSE)
269
+      }
267 270
       if(!(normalize %in% colnames)){
268 271
         stop("Data column '",normalize,"' not found in data. Available columns",
269 272
              " are '",paste(colnames, collapse = "','"),"'.",
... ...
@@ -272,7 +275,10 @@ setMethod("compareByCoord",
272 275
       data[,colnames] <- as.data.frame(data[,colnames,drop = FALSE]) - 
273 276
         data[,normalize]
274 277
     } else if(is.logical(normalize)){
275
-      assertive::assert_is_a_bool(normalize)
278
+      if(!.is_a_bool(normalize)){
279
+        stop("'normalize' has to be TRUE or FALSE.",
280
+             call. = FALSE)
281
+      }
276 282
       if(normalize){
277 283
         data[,colnames] <- as.data.frame(data[,colnames,drop = FALSE]) - 
278 284
           apply(data[,colnames],1,max)
... ...
@@ -128,7 +128,7 @@ setMethod(
128 128
                         showSequence = TRUE, showAnnotation = FALSE, ...) {
129 129
     # get plotting arguments
130 130
     args <- .norm_viz_args_ModifierSet(list(...), x)
131
-    if(!assertive::is_a_string(name)){
131
+    if(!.is_a_string(name)){
132 132
       stop("'Name' must be a character.", call. = FALSE)
133 133
     }
134 134
     chromosome <- .norm_viz_chromosome(ranges(x), name)
... ...
@@ -64,7 +64,6 @@
64 64
 NULL
65 65
 
66 66
 #' @import methods
67
-#' @import assertive
68 67
 #' @import S4Vectors
69 68
 #' @import GenomicRanges
70 69
 #' @import BiocGenerics
... ...
@@ -110,7 +110,7 @@ setMethod(
110 110
   f = "initialize",
111 111
   signature = signature(.Object = "SequenceData"),
112 112
   definition = function(.Object, ...){
113
-    if(!assertive::is_a_non_empty_string(.Object@dataDescription)){
113
+    if(!.is_non_empty_string(.Object@dataDescription)){
114 114
       stop("'dataDescription' must be a single non empty character value.")
115 115
     }
116 116
     callNextMethod(.Object, ...)
... ...
@@ -467,7 +467,7 @@ setMethod("unlist", "SequenceData",
467 467
   proto@minQuality <- .norm_min_quality(args, proto@minQuality)
468 468
   condition <- factor(names(bamfiles))
469 469
   replicate <- .get_replicate_number(condition)
470
-  if(!assertive::is_a_non_empty_string(proto@dataDescription)){
470
+  if(!.is_non_empty_string(proto@dataDescription)){
471 471
     stop("'dataDescription' must be a single non empty character value.")
472 472
   }
473 473
   if(is.null(proto@minQuality)){
... ...
@@ -266,11 +266,11 @@ NULL
266 266
 }
267 267
 
268 268
 .construct_coord_from_name_from_to <- function(x, name, pos){
269
-  if(!assertive::is_a_string(name)){
270
-    stop("'name' must be a single character value.")
269
+  if(!.is_a_string(name)){
270
+    stop("'name' must be a single character value.", call. = FALSE)
271 271
   }
272 272
   if(!is.integer(pos)){
273
-    stop("'from' and 'to' must be integer and have the same length.")
273
+    stop("'from' and 'to' must be integer and have the same length.", call. = FALSE)
274 274
   }
275 275
   coord <- GenomicRanges::GRanges(seqnames = seq_len(pos),
276 276
                                   ranges = IRanges::IRanges(pos, pos),
... ...
@@ -4,7 +4,7 @@ NULL
4 4
 # Annotation -------------------------------------------------------------------
5 5
 
6 6
 #' @importFrom rtracklayer GFF3File
7
-.norm_gff <- function(x, className, .xname = assertive::get_name_in_parent(x)){
7
+.norm_gff <- function(x, className, .xname = .get_name_in_parent(x)){
8 8
   if(!is(x,"GFF3File")){
9 9
     x <- try(rtracklayer::GFF3File(x), silent = TRUE)
10 10
     if (is(x, "try-error")){
... ...
@@ -23,14 +23,19 @@ NULL
23 23
 #' @importFrom GenomicFeatures makeTxDbFromGFF
24 24
 # Returns a TxDb or a GRangesList object
25 25
 .norm_annotation <- function(annotation, className, 
26
-                  .annotationname = assertive::get_name_in_parent(annotation)){
26
+                  .annotationname = .get_name_in_parent(annotation)){
27 27
   if(!is(annotation,"GRangesList")){
28 28
     if(!is(annotation,"GFFFile") && !is(annotation,"TxDb")){
29 29
       annotation <- .norm_gff(annotation, className, .annotationname)
30 30
     } else if(is(annotation,"GFFFile")) {
31
-      assertive::assert_all_are_existing_files(c(BiocGenerics::path(annotation)))
31
+      if(!.all_are_existing_files(c(BiocGenerics::path(annotation)))){
32
+        stop("annotation files don't exist or cannot be accessed.",
33
+             call. = FALSE)
34
+      }
32 35
     } else if(is(annotation,"TxDb")) {
33
-      assertive::assert_all_are_true(validObject(annotation))
36
+      if(!all(validObject(annotation))){
37
+        stop(".")
38
+      }
34 39
     } else {
35 40
       stop("Something went wrong. Unrecognized annotation input during ",
36 41
            "creation of class '",className,"'.",
... ...
@@ -71,11 +76,19 @@ NULL
71 76
            call. = FALSE)
72 77
     }
73 78
     seq <- tmp
74
-    assertive::assert_all_are_existing_files(c(BiocGenerics::path(seq)))
79
+    if(!.all_are_existing_files(c(BiocGenerics::path(seq)))){
80
+      stop("sequence files don't exist or cannot be accessed.",
81
+           call. = FALSE)
82
+    }
75 83
   } else if(is(seq,"FaFile")) {
76
-    assertive::assert_all_are_existing_files(c(BiocGenerics::path(seq)))
84
+    if(!.all_are_existing_files(c(BiocGenerics::path(seq)))){
85
+      stop("sequence files don't exist or cannot be accessed.",
86
+           call. = FALSE)
87
+    }
77 88
   } else if(is(seq,"BSgenome")) {
78
-    assertive::assert_all_are_true(validObject(seq))
89
+    if(!all(validObject(seq))){
90
+      stop(".")
91
+    }
79 92
   } else {
80 93
     stop("Something went wrong. Unrecognized sequence input during creation of",
81 94
          " class '",className,"'.",
... ...
@@ -90,7 +103,7 @@ SAMPLE_TYPES <- c("treated","control")
90 103
 
91 104
 #' @importFrom Rsamtools BamFileList
92 105
 .norm_bamfiles <- function(x, className, 
93
-                           .xname = assertive::get_name_in_parent(x)){
106
+                           .xname = .get_name_in_parent(x)){
94 107
   if(is.list(x)){
95 108
     if(!is.character(x[[1]]) && !is(x[[1]],"BamFile")){
96 109
       ans <- lapply(x, .norm_bamfiles, className, .xname)
... ...
@@ -118,17 +118,10 @@ NULL
118 118
 }
119 119
 
120 120
 
121
-# test import from assertive ---------------------------------------------------
122
-
123
-.is_a_bool <- assertive::is_a_bool
124
-.is_numeric_string <- assertive::is_numeric_string
125
-.is_a_string <- assertive::is_a_string
126
-.is_a_non_empty_string <- assertive::is_a_non_empty_string
127
-
128 121
 # testing settings -------------------------------------------------------------
129 122
 
130 123
 .get_name_in_parent_list <- function(...){
131
-  xnames <- assertive::get_name_in_parent(list(...))
124
+  xnames <- .get_name_in_parent(list(...))
132 125
   xnames <- gsub("list\\(","",gsub("\\)","",xnames))
133 126
   xnames <- strsplit(xnames,", ")[[1]]
134 127
   xnames
... ...
@@ -206,3 +206,49 @@ NULL
206 206
   names(to) <- names(partitioning)
207 207
   .seqs_l_by(from,to)
208 208
 }
209
+
210
+################################################################################
211
+# testing
212
+
213
+.is_a_bool <- function(x){
214
+  is.logical(x) && length(x) == 1L && !is.na(x)
215
+}
216
+
217
+.is_non_empty_character <- function(x){
218
+  is.character(x) && all(nzchar(x))
219
+}
220
+
221
+.is_non_empty_string <- function(x){
222
+  .is_non_empty_character(x) && length(x) == 1L
223
+}
224
+
225
+.is_a_string <- function(x){
226
+  is.character(x) && length(x) == 1L
227
+}
228
+
229
+.are_whole_numbers <- function(x){
230
+  tol <- 100 * .Machine$double.eps
231
+  abs(x - round(x)) <= tol && !is.infinite(x)
232
+}
233
+
234
+.is_numeric_string <- function(x){
235
+  x <- as.character(x)
236
+  suppressWarnings({x <- as.numeric(x)})
237
+  !is.na(x)
238
+}
239
+
240
+.is_function <- function(x){
241
+  typeof(x) == "closure" && is(x, "function")
242
+}
243
+
244
+.all_are_existing_files <- function(x){
245
+  all(file.exists(x))
246
+}
247
+
248
+.get_name_in_parent <- function(x) {
249
+  .safe_deparse(do.call(substitute, list(substitute(x), parent.frame())))
250
+}
251
+
252
+.safe_deparse <- function (expr, ...) {
253
+  paste0(deparse(expr, width.cutoff = 500L, ...), collapse = "")
254
+}