1. bsseq
  2. R
  3. FWIRanges-class.R
Browse code

Resync with latest internal changes to S4Vectors and IRanges

Hervé Pagès authored on 09/06/2020 01:36:15
Showing 1 changed files
R/FWIRanges-class.R
History View file @ d336f4c
... ... 
@@ -35,7 +35,7 @@ setValidity2("FWIRanges", .valid.FWIRanges)
35 35
36 36 
 # Internal methods -------------------------------------------------------------
37 37
38 
-setMethod("vertical_slot_names", "FWIRanges",
38 
+setMethod("parallel_slot_names", "FWIRanges",
39 39 
           function(x) c("start", "NAMES", callNextMethod())
40 40 
 )
41 41
... ... 
@@ -53,10 +53,6 @@ setMethod("end", "FWIRanges", function(x) {
53 53
54 54 
 setMethod("names", "FWIRanges", function(x) x@NAMES)
55 55
56 
-setMethod("vertical_slot_names", "FWIRanges",
57 
-          function(x) c("start", "NAMES", callNextMethod())
58 
-)
59 
-
60 56 
 # TODO: Room for optmisation (e.g., write in C to reduce memory allocations).
61 57 
 .set_FWIRanges_start <- function(x, value, check = TRUE) {
62 58 
     if (!isTRUEorFALSE(check)) stop("'check' must be TRUE or FALSE")
Browse code

parallelSlotNames() was renamed vertical_slot_names() in S4Vectors 0.25.14

Hervé Pagès authored on 24/03/2020 06:15:16
Showing 1 changed files
R/FWIRanges-class.R
History View file @ 59617ab
... ... 
@@ -35,7 +35,7 @@ setValidity2("FWIRanges", .valid.FWIRanges)
35 35
36 36 
 # Internal methods -------------------------------------------------------------
37 37
38 
-setMethod("parallelSlotNames", "FWIRanges",
38 
+setMethod("vertical_slot_names", "FWIRanges",
39 39 
           function(x) c("start", "NAMES", callNextMethod())
40 40 
 )
41 41
... ... 
@@ -53,7 +53,7 @@ setMethod("end", "FWIRanges", function(x) {
53 53
54 54 
 setMethod("names", "FWIRanges", function(x) x@NAMES)
55 55
56 
-setMethod("parallelSlotNames", "FWIRanges",
56 
+setMethod("vertical_slot_names", "FWIRanges",
57 57 
           function(x) c("start", "NAMES", callNextMethod())
58 58 
 )
59 59
Browse code

Use S4Vectors:::normarg_names() instead of S4Vectors:::normalize_names_replacement_value()

Hervé Pagès authored on 12/06/2019 15:24:37
Showing 1 changed files
R/FWIRanges-class.R
History View file @ 8691f7a
... ... 
@@ -118,7 +118,7 @@ setReplaceMethod(
118 118 
 )
119 119
120 120 
 set_FWIRanges_names <- function(x, value) {
121 
-    x@NAMES <- S4Vectors:::normalize_names_replacement_value(value, x)
121 
+    x@NAMES <- S4Vectors:::normarg_names(value, class(x), length(x))
122 122 
     # NOTE: No need to validate an FWIRanges object after setting its names so
123 123 
     #       this should be safe.
124 124 
     x
Browse code

Add FWIRanges and FWGRanges, use in read.bismark()

Peter Hickey authored on 05/06/2018 18:36:20
Showing 1 changed files
R/FWIRanges-class.R
History View file @ 1aef3bd
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,158 @@
1 
+# Internal classes -------------------------------------------------------------
2 
+
3 
+# The FWIRanges class is a simple container for storing a vector of fixed-width
4 
+# integer ranges.
5 
+# NOTE: The intention is to make this a fully-fledged IntegerRanges subclass
6 
+#       that is part of the IRanges package. For now, this class is internal to
7 
+#       bsseq and only a subset of methods are properly implemented.
8 
+.FWIRanges <- setClass(
9 
+    "FWIRanges",
10 
+    contains = "IPosRanges",
11 
+    representation(
12 
+        start = "integer",
13 
+        width = "integer",
14 
+        NAMES = "character_OR_NULL"  # R doesn't like @names !!
15 
+    )
16 
+)
17 
+
18 
+# # Validity methods -------------------------------------------------------------
19 
+
20 
+# TODO: Some of these may be redundant
21 
+.valid.FWIRanges <- function(x) {
22 
+    msg <- NULL
23 
+    if (!is.integer(x@width)) {
24 
+        msg <- validMsg(msg, "'width' must be an integer.")
25 
+    }
26 
+    if (length(x@width) != 1L ) {
27 
+        msg <- validMsg(msg, "'width' must have length 1.")
28 
+    }
29 
+    if (x@width < 0) {
30 
+        msg <- validMsg(msg, "'width' must be non-negative.")
31 
+    }
32 
+}
33 
+
34 
+setValidity2("FWIRanges", .valid.FWIRanges)
35 
+
36 
+# Internal methods -------------------------------------------------------------
37 
+
38 
+setMethod("parallelSlotNames", "FWIRanges",
39 
+          function(x) c("start", "NAMES", callNextMethod())
40 
+)
41 
+
42 
+setMethod("start", "FWIRanges", function(x, ...) x@start)
43 
+
44 
+setMethod("width", "FWIRanges", function(x) rep.int(x@width, length(x)))
45 
+
46 
+setMethod("end", "FWIRanges", function(x) {
47 
+    if (x@width == 1L) {
48 
+        x@start
49 
+    } else {
50 
+        width(x) - 1L + start(x)
51 
+    }
52 
+})
53 
+
54 
+setMethod("names", "FWIRanges", function(x) x@NAMES)
55 
+
56 
+setMethod("parallelSlotNames", "FWIRanges",
57 
+          function(x) c("start", "NAMES", callNextMethod())
58 
+)
59 
+
60 
+# TODO: Room for optmisation (e.g., write in C to reduce memory allocations).
61 
+.set_FWIRanges_start <- function(x, value, check = TRUE) {
62 
+    if (!isTRUEorFALSE(check)) stop("'check' must be TRUE or FALSE")
63 
+    old_start <- start(x)
64 
+    new_start <- S4Vectors:::numeric2integer(value)
65 
+    new_width <- x@width - new_start + old_start
66 
+    if (any(new_width != new_width[1L])) {
67 
+        x <- as(x, "IRanges")
68 
+        start(x) <- value
69 
+        return(x)
70 
+    }
71 
+    x@width <- new_width[1L]
72 
+    if (check) validObject(x)
73 
+    x
74 
+}
75 
+
76 
+setReplaceMethod(
77 
+    "start",
78 
+    "FWIRanges",
79 
+    function(x, ..., value) .set_FWIRanges_start(x, value)
80 
+)
81 
+
82 
+.set_FWIRanges_end <- function(x, value, check = TRUE) {
83 
+    if (!isTRUEorFALSE(check)) stop("'check' must be TRUE or FALSE")
84 
+    new_width <- x@width + S4Vectors:::numeric2integer(value) - end(x)
85 
+    if (any(new_width != new_width[1L])) {
86 
+        x <- as(x, "IRanges")
87 
+        end(x) <- value
88 
+        return(x)
89 
+    }
90 
+    x@width <- new_width[1L]
91 
+    if (check) validObject(x)
92 
+    x
93 
+}
94 
+
95 
+setReplaceMethod(
96 
+    "end",
97 
+    "FWIRanges",
98 
+    function(x, ..., value) .set_FWIRanges_end(x, value)
99 
+)
100 
+
101 
+.set_FWIRanges_width <- function(x, value, check = TRUE) {
102 
+    if (!isTRUEorFALSE(check)) stop("'check' must be TRUE or FALSE")
103 
+    new_width <- S4Vectors:::numeric2integer(value)
104 
+    if (any(new_width != new_width[1L])) {
105 
+        x <- as(x, "IRanges")
106 
+        width(x) <- value
107 
+        return(x)
108 
+    }
109 
+    x@width <- new_width[1L]
110 
+    if (check) validObject(x)
111 
+    x
112 
+}
113 
+
114 
+setReplaceMethod(
115 
+    "width",
116 
+    "FWIRanges",
117 
+    function(x, ..., value) .set_FWIRanges_width(x, value)
118 
+)
119 
+
120 
+set_FWIRanges_names <- function(x, value) {
121 
+    x@NAMES <- S4Vectors:::normalize_names_replacement_value(value, x)
122 
+    # NOTE: No need to validate an FWIRanges object after setting its names so
123 
+    #       this should be safe.
124 
+    x
125 
+}
126 
+
127 
+setReplaceMethod("names", "FWIRanges", set_FWIRanges_names)
128 
+
129 
+setMethod("replaceROWS", "FWIRanges", function(x, i, value) {
130 
+    x_width <- x@width
131 
+    value_width <- value@width
132 
+    if (!identical(x_width, value_width)) {
133 
+        x <- as(x, "IRanges")
134 
+        value <- as(value, "IRanges")
135 
+        return(replaceROWS(x, i, value))
136 
+    }
137 
+    i <- normalizeSingleBracketSubscript(i, x, as.NSBS = TRUE)
138 
+    ans_start <- replaceROWS(start(x), i, start(value))
139 
+    ans_width <- value@width
140 
+    ans_mcols <- replaceROWS(mcols(x), i, mcols(value))
141 
+    BiocGenerics:::replaceSlots(
142 
+        x,
143 
+        start = ans_start,
144 
+        width = ans_width,
145 
+        mcols = ans_mcols,
146 
+        check = FALSE)
147 
+})
148 
+
149 
+# TODO: Follow shift,IRanges-method
150 
+setMethod("shift", "FWIRanges", function(x, shift = 0L, use.names = TRUE) {
151 
+    stopifnot(use.names)
152 
+    shift <- recycleIntegerArg(shift, "shift", length(x))
153 
+    new_start <- start(x) + shift
154 
+    # TODO: Use BiocGenerics:::replaceSlots()
155 
+    x@start <- new_start
156 
+    validObject(x)
157 
+    x
158 
+})