Browse code

Get RNAmodR ready for the switch to virtual DataFrame (in S4Vectors package)

Hervé Pagès authored on 05/11/2021 01:34:40
Showing8 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.9.0
5
-Date: 2021-08-25
4
+Version: 1.9.1
5
+Date: 2021-11-04
6 6
 Authors@R: c(person("Felix G.M.", 
7 7
                     "Ernst", 
8 8
                     email = "felix.gm.ernst@outlook.com", 
... ...
@@ -226,7 +226,8 @@ setClass("Modifier",
226 226
                    settings = "list",
227 227
                    aggregateValidForCurrentArguments = "logical",
228 228
                    modificationsValidForCurrentArguments = "logical"),
229
-         prototype = list(aggregateValidForCurrentArguments = FALSE,
229
+         prototype = list(aggregate = new("CompressedSplitDFrameList"),
230
+                          aggregateValidForCurrentArguments = FALSE,
230 231
                           modificationsValidForCurrentArguments = FALSE))
231 232
 
232 233
 # validity ---------------------------------------------------------------------
... ...
@@ -206,7 +206,7 @@ coerceSequenceDataToCompressedSplitDataFrameList <- function(className){
206 206
           for (what in c("elementType", "elementMetadata", 
207 207
                          "metadata", "unlistData", "partitioning"
208 208
           )) slot(value, what) <- slot(from, what)
209
-          value@unlistData <- as(value@unlistData,"DataFrame")
209
+          value@unlistData <- as(value@unlistData,"DFrame")
210 210
           value
211 211
         }
212 212
       } else from
... ...
@@ -271,7 +271,7 @@ setMethod("getData",
271 271
 .aggregate_list_data_mean_sd <- function(x, condition){
272 272
   conditions <- conditions(x)
273 273
   f <- .subset_to_condition(conditions, condition)
274
-  df <- as(unlist(x,use.names=FALSE),"DataFrame")[,f,drop=FALSE]
274
+  df <- as(unlist(x,use.names=FALSE),"DFrame")[,f,drop=FALSE]
275 275
   conditions_u <- unique(conditions[f])
276 276
   # set up some base values. replicates is here the same as the number of
277 277
   # columns, since a list per replicate is assumed
... ...
@@ -254,7 +254,7 @@ setMethod("getData",
254 254
 .aggregate_data_frame_mean_sd <- function(x, condition){
255 255
   conditions <- conditions(x)
256 256
   f <- .subset_to_condition(conditions, condition)
257
-  df <- as(unlist(x,use.names=FALSE),"DataFrame")[,f,drop=FALSE]
257
+  df <- as(unlist(x,use.names=FALSE),"DFrame")[,f,drop=FALSE]
258 258
   conditions_u <- unique(conditions[f])
259 259
   replicates <- replicates(x)[f]
260 260
   # set up some base values
... ...
@@ -189,7 +189,7 @@ setMethod("summary",
189 189
 .aggregate_data_frame_percentage_mean_sd <- function(x,condition){
190 190
   conditions <- conditions(x)
191 191
   f <- .subset_to_condition(conditions, condition)
192
-  df <- as(unlist(x,use.names=FALSE),"DataFrame")[,f,drop=FALSE]
192
+  df <- as(unlist(x,use.names=FALSE),"DFrame")[,f,drop=FALSE]
193 193
   conditions_u <- unique(conditions[f])
194 194
   replicates <- replicates(x)[f]
195 195
   # set up some base values
... ...
@@ -222,7 +222,7 @@ NULL
222 222
   # converts everything to a GRangesList
223 223
   coord <- .norm_coord(coord, args[["type"]], args[["merge"]])
224 224
   if(args[["rawData"]]){
225
-    data <- relist(as(unlist(x, use.names = FALSE),"DataFrame"),
225
+    data <- relist(as(unlist(x, use.names = FALSE),"DFrame"),
226 226
                    IRanges::PartitioningByWidth(x))
227 227
     data <- .norm_sequence_data(data)
228 228
   } else {
... ...
@@ -403,7 +403,7 @@ setMethod("subsetByCoord",
403 403
   # converts everything to a GRangesList
404 404
   coord <- .norm_coord(coord, args[["type"]])
405 405
   if(args[["rawData"]]){
406
-    data <- relist(as(unlist(x, use.names = FALSE),"DataFrame"),
406
+    data <- relist(as(unlist(x, use.names = FALSE),"DFrame"),
407 407
                    IRanges::PartitioningByWidth(x))
408 408
   } else {
409 409
     data <- aggregate(x)
... ...
@@ -228,49 +228,6 @@ setMethod(
228 228
 
229 229
 # internals for SequenceDataFrame ----------------------------------------------
230 230
 
231
-#' @importClassesFrom IRanges PartitioningByEnd
232
-#' @importFrom IRanges PartitioningByEnd
233
-setMethod(
234
-  "extractROWS", "SequenceDataFrame",
235
-  function(x, i){
236
-    if(missing(i)){
237
-      return(x)
238
-    }
239
-    i <- normalizeSingleBracketSubscript(i, x, exact = FALSE, 
240
-                                         allow.NAs = TRUE, as.NSBS = TRUE)
241
-    if(length(i) == 0L){
242
-      return(do.call(class(x),list()))
243
-    }
244
-    start <- which(start(PartitioningByWidth(ranges(x))) == i@subscript[[1L]])
245
-    end <- which(end(PartitioningByWidth(ranges(x))) == i@subscript[[2L]])
246
-    x_ranges <- extractROWS(ranges(x), seq.int(start,end))
247
-    x_sequences <- extractROWS(sequences(x), i)
248
-    # save the other slots, in case they are deleted from the result by calling
249
-    # callNextMethod()
250
-    cl <- class(x)
251
-    x_condition <- conditions(x)
252
-    x_replicate <- replicates(x)
253
-    x_bamfiles <- bamfiles(x)
254
-    x_seqinfo <- seqinfo(x)
255
-    x <- callNextMethod()
256
-    if(!is(x,"SequenceDataFrame")){
257
-      x <- new(cl,
258
-               x,
259
-               ranges = x_ranges,
260
-               sequence = x_sequences,
261
-               condition = x_condition,
262
-               replicate = x_replicate,
263
-               bamfiles = x_bamfiles,
264
-               seqinfo = x_seqinfo)
265
-    } else {
266
-      slot(x, "ranges", check = FALSE) <- x_ranges
267
-      slot(x, "sequence", check = FALSE) <- x_sequences
268
-      validObject(x)
269
-    }
270
-    x
271
-  }
272
-)
273
-
274 231
 setMethod(
275 232
   "bindROWS", "SequenceDataFrame",
276 233
   function (x, objects = list(), use.names = TRUE, ignore.mcols = FALSE, 
... ...
@@ -505,3 +462,50 @@ S4Vectors::setValidity2(Class = "SequenceDataFrame", .valid_SequenceDataFrame)
505 462
 #' @export
506 463
 setClass(Class = "SequenceDFrame",
507 464
          contains = c("VIRTUAL","SequenceDataFrame","DFrame"))
465
+
466
+# internals for SequenceDFrame -------------------------------------------------
467
+
468
+#' @importClassesFrom IRanges PartitioningByEnd
469
+#' @importFrom IRanges PartitioningByEnd
470
+setMethod(
471
+  "extractROWS", "SequenceDFrame",
472
+  function(x, i){
473
+    if(missing(i)){
474
+      return(x)
475
+    }
476
+    i <- normalizeSingleBracketSubscript(i, x, exact = FALSE,
477
+                                         allow.NAs = TRUE, as.NSBS = TRUE)
478
+    if(length(i) == 0L){
479
+      return(do.call(class(x),list()))
480
+    }
481
+    start <- which(start(PartitioningByWidth(ranges(x))) == i@subscript[[1L]])
482
+    end <- which(end(PartitioningByWidth(ranges(x))) == i@subscript[[2L]])
483
+    x_ranges <- extractROWS(ranges(x), seq.int(start,end))
484
+    x_sequences <- extractROWS(sequences(x), i)
485
+    # save the other slots, in case they are deleted from the result by calling
486
+    # callNextMethod()
487
+    cl <- class(x)
488
+    x_condition <- conditions(x)
489
+    x_replicate <- replicates(x)
490
+    x_bamfiles <- bamfiles(x)
491
+    x_seqinfo <- seqinfo(x)
492
+    # call extractROWS() method for DFrame (there's no method for DataFrame!)
493
+    x <- callNextMethod()
494
+    if(!is(x,"SequenceDFrame")){
495
+      x <- new(cl,
496
+               x,
497
+               ranges = x_ranges,
498
+               sequence = x_sequences,
499
+               condition = x_condition,
500
+               replicate = x_replicate,
501
+               bamfiles = x_bamfiles,
502
+               seqinfo = x_seqinfo)
503
+    } else {
504
+      slot(x, "ranges", check = FALSE) <- x_ranges
505
+      slot(x, "sequence", check = FALSE) <- x_sequences
506
+      validObject(x)
507
+    }
508
+    x
509
+  }
510
+)
511
+