-
Notifications
You must be signed in to change notification settings - Fork 16
/
s3-soma-adat.R
198 lines (177 loc) · 6.08 KB
/
s3-soma-adat.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
#' The `soma_adat` Class and S3 Methods
#'
#' The `soma_adat` data structure is the primary internal `R` representation
#' of SomaScan data. A `soma_adat` is automatically created via [read_adat()]
#' when loading a `*.adat` text file. It consists of a `data.frame`-like
#' object with leading columns as clinical variables and SomaScan RFU data
#' as the remaining variables. Two main attributes corresponding to analyte
#' and SomaScan run information contained in the `*.adat` file are added:
#' \itemize{
#' \item `Header.Meta`: information about the SomaScan run, see [parseHeader()]
#' or `attr(x, "Header.Meta")`
#' \item `Col.Meta`: annotations information about the SomaScan reagents/analytes,
#' see [getAnalyteInfo()] or `attr(x, "Col.Meta")`
#' \item `file_specs`: parsing specifications for the ingested `*.adat` file
#' \item `row_meta`: the names of the non-RFU fields. See [getMeta()].
#' }
#' See [groupGenerics()] for a details on [Math()], [Ops()], and [Summary()]
#' methods that dispatch on class `soma_adat`.
#' \cr\cr
#' See [reexports()] for a details on re-exported S3 generics from other
#' packages (mostly `dplyr` and `tidyr`) to enable S3 methods to be
#' dispatched on class `soma_adat`.
#' \cr\cr
#' Below is a list of *all* currently available S3 methods that dispatch on
#' the `soma_adat` class:
#' ```{r methods, echo = FALSE}
#' options(width = 70)
#' withr::with_collate("en_US.UTF-8", methods(class = "soma_adat"))
#' ```
#'
#' @family IO
#' @name soma_adat
#' @order 1
#' @param x,object A `soma_adat` class object.
#' @return The set of S3 methods above return the `soma_adat` object with
#' the corresponding S3 method applied.
#' @seealso [groupGenerics()]
NULL
# Extraction ----
#' S3 extract method for class `soma_adat`.
#'
#' The S3 [Extract()] method is used for sub-setting a `soma_adat`
#' object and relies heavily on the `[` method that maintains the `soma_adat`
#' attributes intact *and* subsets the `Col.Meta` so that it is consistent
#' with the newly created object.
#'
#' @rdname soma_adat
#' @param i,j Row and column indices respectively. If `j` is omitted,
#' `i` is used as the column index.
#' @param ... Ignored.
#' @param drop Coerce to a vector if fetching one column via `tbl[, j]`.
#' Default `FALSE`, ignored when accessing a column via `tbl[j]`.
#' @export
`[.soma_adat` <- function(x, i, j, drop = TRUE, ...) {
if ( missing(j) ) {
# if sub-setting rows; nothing special to do
.data <- NextMethod()
return(addClass(.data, "soma_adat"))
}
if ( !is_intact_attr(x) || (length(j) == 1L && j > 0 ) ) {
# if 1) attributes already broken OR
# 2) extracting a single column
# this behavior may change to match `tbl_df` class
# where `drop = FALSE` by default
return(NextMethod(drop = drop))
}
# below column sub-setting
# attributes must be considered
atts <- attributes(x)
apts <- getAnalytes(x)
if ( is.character(j) ) {
# Character case
k <- match(j[j %in% apts], apts)
} else if ( is.numeric(j) || is.logical(j) ) {
# Integer/Logical case
# this is tricky
# must figure out the numeric indices of the feature data
k <- match(getAnalytes(names(x)[j]), apts)
}
# Update the attributes -> Col.Meta information
atts$Col.Meta <- atts$Col.Meta[k, ]
.data <- addAttributes(NextMethod(), atts)
.sort_attr(.data, names(atts)) |> # re-order back to original
structure(class = class(x)) # ensure same class out
}
#' S3 extract with `$`
#'
#' S3 extraction via `$` is fully supported, however,
#' as opposed to the `data.frame` method, partial matching
#' is *not* allowed for class `soma_adat`.
#'
#' @rdname soma_adat
#' @param name A [name] or a string.
#' @export
`$.soma_adat` <- function(x, name) {
if ( is.character(name) ) {
ret <- .subset2(x, name)
if ( is.null(ret) ) {
warning(
"Unknown or uninitialised column: '", name, "'", call. = FALSE
)
}
return(ret)
}
.subset2(x, name)
}
#' S3 extract with `[[`
#'
#' S3 extraction via `[[` is supported, however, we restrict
#' the usage of `[[` for `soma_adat`. Use only a numeric index (e.g. `1L`)
#' or a character identifying the column (e.g. `"SampleID"`).
#' Do not use `[[i,j]]` syntax with `[[`, use `[` instead.
#' As with `$`, partial matching is *not* allowed.
#'
#' @rdname soma_adat
#' @param exact Ignored with a [warning()].
#' @export
`[[.soma_adat` <- function(x, i, j, ..., exact = TRUE) {
if ( !exact ) {
warning("`exact=` is ignored in `[[`.", call. = FALSE)
}
if ( !missing(j) ) {
stop(
"Passing jth column index not supported via `[[` for `soma_adat`.\n",
"Please use `x[", deparse(substitute(i)), ", ", deparse(substitute(j)),
"]` instead.", call. = FALSE
)
}
return(`$.soma_adat`(x, i))
}
# Assignment ----
#' S3 assignment with `[`
#'
#' S3 assignment via `[` is supported for class `soma_adat`.
#'
#' @rdname soma_adat
#' @param value A value to store in a row, column, range or cell.
#' @export
`[<-.soma_adat` <- function(x, i, j, ..., value) {
anames <- names(attributes(x))
.data <- NextMethod()
.sort_attr(.data, anames) |> # re-order back to original
structure(class = class(x)) # ensure same class out
}
#' S3 assignment with `$`
#'
#' S3 assignment via `$` is fully supported for class `soma_adat`.
#'
#' @rdname soma_adat
#' @export
`$<-.soma_adat` <- `[<-.soma_adat`
#' S3 assignment with `[[`
#'
#' S3 assignment via `[[` is supported for class `soma_adat`.
#'
#' @rdname soma_adat
#' @export
`[[<-.soma_adat` <- `[<-.soma_adat`
#' S3 `median` method
#'
#' S3 [median()] is *not* currently supported for the `soma_adat` class,
#' however a dispatch is in place to direct users to alternatives.
#'
#' @rdname soma_adat
#' @importFrom stats median
#' @inheritParams stats::median
#' @export
median.soma_adat <- function(x, na.rm = FALSE, ...) {
warning(
"As with the `data.frame` class, numeric data is required for `stats::median()`.\n",
"Please use either:\n\n ",
.code("median(data.matrix(x[, getAnalytes(x)]))"),
"\nOR\n ",
.code("apply(x[, getAnalytes(x)] 2, median)"), call. = FALSE
)
invisible()
}