Browse code

fix checkmate errors and apply styling

Daniel Sabanes Bove authored on 27/04/2022 07:55:48
Showing1 changed files
... ...
@@ -42,7 +42,7 @@ h_pca_var_rsquared <- function(pca, x) {
42 42
   )
43 43
   use_sample <- !is.na(x)
44 44
   x <- x[use_sample]
45
-  if(is_constant(x)){
45
+  if (is_constant(x)) {
46 46
     warning("sample variable is constant and R2 values cannot be calculated")
47 47
   }
48 48
   pca <- pca[use_sample, ]
... ...
@@ -216,11 +216,13 @@ setMethod(
216 216
 #' autoplot(result, cluster_columns = FALSE)
217 217
 #'
218 218
 #' # We can also choose break-points for color customization.
219
-#' autoplot(result,
220
-#'          cor_colors = circlize::colorRamp2(
221
-#'          c(-0.5, -0.25, 0, 0.25, 0.5, 0.75, 1),
222
-#'          c("blue", "green", "purple", "yellow", "orange", "red", "brown")
223
-#'          ))
219
+#' autoplot(
220
+#'   result,
221
+#'   cor_colors = circlize::colorRamp2(
222
+#'     c(-0.5, -0.25, 0, 0.25, 0.5, 0.75, 1),
223
+#'     c("blue", "green", "purple", "yellow", "orange", "red", "brown")
224
+#'   )
225
+#' )
224 226
 setMethod(
225 227
   f = "autoplot",
226 228
   signature = c(object = "HermesDataPcaCor"),
Browse code

don't suppress warnings from `lmFit`

Daniel Sabanes Bove authored on 16/11/2021 10:27:56
Showing1 changed files
... ...
@@ -49,7 +49,7 @@ h_pca_var_rsquared <- function(pca, x) {
49 49
   design <- stats::model.matrix(~x)
50 50
   # Transpose such that PCs are in rows, and samples in columns.
51 51
   y0 <- t(pca)
52
-  suppressWarnings(utils::capture.output(fit <- limma::lmFit(y0, design = design)))
52
+  utils::capture.output(fit <- limma::lmFit(y0, design = design))
53 53
   had_problems <- apply(fit$coefficients, 1L, function(row) any(is.na(row)))
54 54
   sst <- rowSums(y0^2)
55 55
   ssr <- sst - fit$df.residual * fit$sigma^2
Browse code

65: Check h_pca_var_rsquared() (#88)

* updated pca_cor_samplevar.R

* updated pca_cor_samplevar.R

* updated test-pca_cor_samplevar.R

* Update R/pca_cor_samplevar.R

Co-authored-by: Daniel Sabanes Bove <danielinteractive@users.noreply.github.com>

* Update tests/testthat/test-pca_cor_samplevar.R

Co-authored-by: Daniel Sabanes Bove <danielinteractive@users.noreply.github.com>

Co-authored-by: Daniel Sabanes Bove <danielinteractive@users.noreply.github.com>

Jeff Luong authored on 28/09/2021 17:03:26 • GitHub committed on 28/09/2021 17:03:26
Showing1 changed files
... ...
@@ -42,6 +42,9 @@ h_pca_var_rsquared <- function(pca, x) {
42 42
   )
43 43
   use_sample <- !is.na(x)
44 44
   x <- x[use_sample]
45
+  if(is_constant(x)){
46
+    warning("sample variable is constant and R2 values cannot be calculated")
47
+  }
45 48
   pca <- pca[use_sample, ]
46 49
   design <- stats::model.matrix(~x)
47 50
   # Transpose such that PCs are in rows, and samples in columns.
Browse code

31 change names to standardised specs@main (#63)

Co-authored-by: Daniel Sabanes Bove <danielinteractive@users.noreply.github.com>
Co-authored-by: Pawel Rucki <pawel.rucki@roche.com>
Co-authored-by: dinakar29 <26552821+dinakar29@users.noreply.github.com>
Co-authored-by: Daniel Sabanes Bove <daniel.sabanes_bove@roche.com>
Co-authored-by: benoit <benoit.falquet@roche.com>
Co-authored-by: Stefanie Bienert <75780729+bienerts@users.noreply.github.com>
Co-authored-by: colinisstudent <87772156+colinisstudent@users.noreply.github.com>
Co-authored-by: Konrad Pagacz <konrad.pagacz@contractors.roche.com>
Co-authored-by: Insights Engineering Bot <68416928+insights-engineering-bot@users.noreply.github.com>
Co-authored-by: Nikolas Burkoff <nikolas.burkoff@roche.com>
Co-authored-by: b_falquet <64274616+BFalquet@users.noreply.github.com>
Co-authored-by: arkadiuszbeer <86738093+arkadiuszbeer@users.noreply.github.com>

Tim Treis authored on 16/09/2021 13:05:42 • GitHub committed on 16/09/2021 13:05:42
Showing1 changed files
... ...
@@ -20,7 +20,7 @@ NULL
20 20
 #' @export
21 21
 #'
22 22
 #' @examples
23
-#' object <- HermesData(summarized_experiment) %>%
23
+#' object <- hermes_data %>%
24 24
 #'   add_quality_flags() %>%
25 25
 #'   filter() %>%
26 26
 #'   normalize()
... ...
@@ -29,7 +29,7 @@ NULL
29 29
 #' pca <- calc_pca(object)$x
30 30
 #'
31 31
 #' # Obtain the sample variable.
32
-#' x <- colData(object)$LowDepthFlag
32
+#' x <- colData(object)$AGE18
33 33
 #'
34 34
 #' # Correlate them.
35 35
 #' r2 <- h_pca_var_rsquared(pca, x)
... ...
@@ -82,7 +82,7 @@ h_pca_var_rsquared <- function(pca, x) {
82 82
 #' @export
83 83
 #'
84 84
 #' @examples
85
-#' object <- HermesData(summarized_experiment) %>%
85
+#' object <- hermes_data %>%
86 86
 #'   add_quality_flags() %>%
87 87
 #'   filter() %>%
88 88
 #'   normalize()
... ...
@@ -159,7 +159,7 @@ h_pca_df_r2_matrix <- function(pca, df) {
159 159
 #' @export
160 160
 #'
161 161
 #' @examples
162
-#' object <- HermesData(summarized_experiment) %>%
162
+#' object <- hermes_data %>%
163 163
 #'   add_quality_flags() %>%
164 164
 #'   filter() %>%
165 165
 #'   normalize()
Browse code

23: pca correlation heatmap color update (#26)

namratabhatia authored on 16/08/2021 07:34:21 • GitHub committed on 16/08/2021 07:34:21
Showing1 changed files
... ...
@@ -211,13 +211,20 @@ setMethod(
211 211
 #'
212 212
 #' # We can also choose to not reorder the columns.
213 213
 #' autoplot(result, cluster_columns = FALSE)
214
+#'
215
+#' # We can also choose break-points for color customization.
216
+#' autoplot(result,
217
+#'          cor_colors = circlize::colorRamp2(
218
+#'          c(-0.5, -0.25, 0, 0.25, 0.5, 0.75, 1),
219
+#'          c("blue", "green", "purple", "yellow", "orange", "red", "brown")
220
+#'          ))
214 221
 setMethod(
215 222
   f = "autoplot",
216 223
   signature = c(object = "HermesDataPcaCor"),
217 224
   definition = function(object,
218 225
                         cor_colors = circlize::colorRamp2(
219
-                          c(-0.5, -0.25, 0, 0.25, 0.5, 0.75, 1),
220
-                          c("blue", "green", "purple", "yellow", "orange", "red", "brown")
226
+                          c(-1, 0, 1),
227
+                          c("blue", "white", "red")
221 228
                         ),
222 229
                         ...) {
223 230
     mat <- as(object, "matrix")
Browse code

Merge branch 'main' into 14_autoplot_warning

Daniel Sabanes Bove authored on 10/08/2021 13:37:31
Showing0 changed files
Browse code

resolve warnings with explicit matrix coercion

Daniel Sabanes Bove authored on 10/08/2021 13:37:16
Showing1 changed files
... ...
@@ -225,8 +225,9 @@ setMethod(
225 225
                           c("blue", "green", "purple", "yellow", "orange", "red", "brown")
226 226
                         ),
227 227
                         ...) {
228
+    mat <- as(object, "matrix")
228 229
     ComplexHeatmap::Heatmap(
229
-      matrix = t(object),
230
+      matrix = t(mat),
230 231
       col = cor_colors,
231 232
       name = "R2",
232 233
       ...
Browse code

more progress

Daniel Sabanes Bove authored on 09/08/2021 18:01:04
Showing1 changed files
... ...
@@ -17,9 +17,6 @@ NULL
17 17
 #'
18 18
 #' @return A vector with R2 values for each principal component.
19 19
 #'
20
-#' @importFrom stats model.matrix
21
-#' @importFrom limma lmFit
22
-#' @importFrom utils capture.output
23 20
 #' @export
24 21
 #'
25 22
 #' @examples
... ...
@@ -205,8 +202,6 @@ setMethod(
205 202
 #'   produced by [circlize::colorRamp2()].
206 203
 #' @param ... other arguments to be passed to [ComplexHeatmap::Heatmap()].
207 204
 #'
208
-#' @importFrom ComplexHeatmap Heatmap
209
-#' @importFrom circlize colorRamp2
210 205
 #' @export
211 206
 #'
212 207
 #' @examples
Browse code

141: Polish documentation of hermes. (#176)

Sabanes Bove, Daniel {MDBR~Basel} authored on 01/07/2021 07:33:51 • GitHub Enterprise committed on 01/07/2021 07:33:51
Showing1 changed files
... ...
@@ -27,8 +27,14 @@ NULL
27 27
 #'   add_quality_flags() %>%
28 28
 #'   filter() %>%
29 29
 #'   normalize()
30
+#'
31
+#' # Obtain the principal components.
30 32
 #' pca <- calc_pca(object)$x
33
+#'
34
+#' # Obtain the sample variable.
31 35
 #' x <- colData(object)$LowDepthFlag
36
+#'
37
+#' # Correlate them.
32 38
 #' r2 <- h_pca_var_rsquared(pca, x)
33 39
 h_pca_var_rsquared <- function(pca, x) {
34 40
   assert_that(
... ...
@@ -59,12 +65,23 @@ h_pca_var_rsquared <- function(pca, x) {
59 65
 #' This function processes sample variables from [`AnyHermesData`] and the
60 66
 #' corresponding principal components matrix, and then generates the matrix of R2 values.
61 67
 #'
68
+#' @details
69
+#'   - Note that only the `df` columns which are `numeric`, `character`, `factor` or
70
+#'     `logical` are included in the resulting matrix, because other variable types are not
71
+#'     supported.
72
+#'   - In addition, `df` columns which are constant, all `NA`, or `character` or `factor`
73
+#'     columns with too many levels are also dropped before the analysis.
74
+#'
62 75
 #' @param pca (`matrix`)\cr comprises principal components generated by [calc_pca()].
63
-#' @param df (`dataframe`)\cr [SummarizedExperiment::colData()] of a [`AnyHermesData`] object.
76
+#' @param df (`data.frame`)\cr from the [SummarizedExperiment::colData()] of a
77
+#'   [`AnyHermesData`] object.
64 78
 #'
65
-#' @return A matrix with R2 values for all combinations of sample variables and principle
79
+#' @return A matrix with R2 values for all combinations of sample variables and principal
66 80
 #'   components.
67 81
 #'
82
+#' @seealso [h_pca_var_rsquared()] which is used internally to calculate the R2 for one
83
+#'   sample variable.
84
+#'
68 85
 #' @export
69 86
 #'
70 87
 #' @examples
... ...
@@ -72,8 +89,21 @@ h_pca_var_rsquared <- function(pca, x) {
72 89
 #'   add_quality_flags() %>%
73 90
 #'   filter() %>%
74 91
 #'   normalize()
92
+#'
93
+#' # Obtain the principal components.
75 94
 #' pca <- calc_pca(object)$x
76
-#' r2_all <- h_pca_df_r2_matrix(pca, as.data.frame(colData(object)))
95
+#'
96
+#' # Obtain the `colData` as a `data.frame`.
97
+#' df <- as.data.frame(colData(object))
98
+#'
99
+#' # Correlate them.
100
+#' r2_all <- h_pca_df_r2_matrix(pca, df)
101
+#' str(r2_all)
102
+#'
103
+#' # We can see that only about half of the columns from `df` were
104
+#' # used for the correlations.
105
+#' ncol(r2_all)
106
+#' ncol(df)
77 107
 h_pca_df_r2_matrix <- function(pca, df) {
78 108
   assert_that(
79 109
     is.matrix(pca),
... ...
@@ -113,8 +143,10 @@ h_pca_df_r2_matrix <- function(pca, df) {
113 143
 #'
114 144
 #' @description `r lifecycle::badge("stable")`
115 145
 #'
116
-#' This method analyses the correlations (in R2 values) between all sample variables
117
-#' in [AnyHermesData] object and the principal components of the samples.
146
+#' This `correlate()` method analyses the correlations (in R2 values) between all sample variables
147
+#' in a [`AnyHermesData`] object and the principal components of the samples.
148
+#'
149
+#' A corresponding `autoplot()` method then can visualize the results in a heatmap.
118 150
 #'
119 151
 #' @rdname pca_cor_samplevar
120 152
 #' @aliases pca_cor_samplevar
... ...
@@ -125,6 +157,8 @@ h_pca_df_r2_matrix <- function(pca, df) {
125 157
 #'
126 158
 #' @return A [`HermesDataPcaCor`] object with R2 values for all sample variables.
127 159
 #'
160
+#' @seealso [h_pca_df_r2_matrix()] which is used internally for the details.
161
+#'
128 162
 #' @export
129 163
 #'
130 164
 #' @examples
... ...
@@ -132,6 +166,8 @@ h_pca_df_r2_matrix <- function(pca, df) {
132 166
 #'   add_quality_flags() %>%
133 167
 #'   filter() %>%
134 168
 #'   normalize()
169
+#'
170
+#' # Perform PCA and then correlate the prinicipal components with the sample variables.
135 171
 #' object_pca <- calc_pca(object)
136 172
 #' result <- correlate(object_pca, object)
137 173
 setMethod(
... ...
@@ -174,6 +210,8 @@ setMethod(
174 210
 #' @export
175 211
 #'
176 212
 #' @examples
213
+#'
214
+#' # Visualize the correlations in a heatmap.
177 215
 #' autoplot(result)
178 216
 #'
179 217
 #' # We can also choose to not reorder the columns.
Browse code

136: Add alternative annotation functionality via BiomaRt (#169)

Sabanes Bove, Daniel {MDBR~Basel} authored on 29/06/2021 20:51:26 • GitHub Enterprise committed on 29/06/2021 20:51:26
Showing1 changed files
... ...
@@ -169,6 +169,10 @@ setMethod(
169 169
 #'   produced by [circlize::colorRamp2()].
170 170
 #' @param ... other arguments to be passed to [ComplexHeatmap::Heatmap()].
171 171
 #'
172
+#' @importFrom ComplexHeatmap Heatmap
173
+#' @importFrom circlize colorRamp2
174
+#' @export
175
+#'
172 176
 #' @examples
173 177
 #' autoplot(result)
174 178
 #'
Browse code

125: Use lifecycle. (#152)

Sabanes Bove, Daniel {MDBR~Basel} authored on 24/06/2021 09:35:28 • GitHub Enterprise committed on 24/06/2021 09:35:28
Showing1 changed files
... ...
@@ -4,14 +4,16 @@ NULL
4 4
 
5 5
 #' Calculation of R2 between Sample Variable and Principal Components
6 6
 #'
7
-#' This helper function calculates R2 values between one sample variable from [AnyHermesData]
7
+#' @description `r lifecycle::badge("stable")`
8
+#'
9
+#' This helper function calculates R2 values between one sample variable from [`AnyHermesData`]
8 10
 #' and all Principal Components (PCs) separately (one linear model is fit for each PC).
9 11
 #'
10
-#' Note that in case there are estimation problems for any of the PCs, then `NA` will
12
+#' @details Note that in case there are estimation problems for any of the PCs, then `NA` will
11 13
 #' be returned for those.
12 14
 #'
13 15
 #' @param pca (`matrix`)\cr principal components matrix generated by [calc_pca()].
14
-#' @param x (`vector`)\cr values of one sample variable from [AnyHermesData] object.
16
+#' @param x (`vector`)\cr values of one sample variable from a [`AnyHermesData`] object.
15 17
 #'
16 18
 #' @return A vector with R2 values for each principal component.
17 19
 #'
... ...
@@ -52,11 +54,13 @@ h_pca_var_rsquared <- function(pca, x) {
52 54
 
53 55
 #' Calculation of R2 Matrix between Sample Variables and Principal Components
54 56
 #'
55
-#' This function processes sample variables from [AnyHermesData] and the
57
+#' @description `r lifecycle::badge("stable")`
58
+#'
59
+#' This function processes sample variables from [`AnyHermesData`] and the
56 60
 #' corresponding principal components matrix, and then generates the matrix of R2 values.
57 61
 #'
58 62
 #' @param pca (`matrix`)\cr comprises principal components generated by [calc_pca()].
59
-#' @param df (`dataframe`)\cr [SummarizedExperiment::colData()] of [AnyHermesData] object.
63
+#' @param df (`dataframe`)\cr [SummarizedExperiment::colData()] of a [`AnyHermesData`] object.
60 64
 #'
61 65
 #' @return A matrix with R2 values for all combinations of sample variables and principle
62 66
 #'   components.
... ...
@@ -107,6 +111,8 @@ h_pca_df_r2_matrix <- function(pca, df) {
107 111
 
108 112
 #' Correlation of Principal Components with Sample Variables
109 113
 #'
114
+#' @description `r lifecycle::badge("stable")`
115
+#'
110 116
 #' This method analyses the correlations (in R2 values) between all sample variables
111 117
 #' in [AnyHermesData] object and the principal components of the samples.
112 118
 #'
... ...
@@ -117,7 +123,7 @@ h_pca_df_r2_matrix <- function(pca, df) {
117 123
 #'   on [`AnyHermesData`].
118 124
 #' @param data (`AnyHermesData`)\cr input that was used originally for the PCA.
119 125
 #'
120
-#' @return A [HermesDataPcaCor] object with R2 values for all sample variables.
126
+#' @return A [`HermesDataPcaCor`] object with R2 values for all sample variables.
121 127
 #'
122 128
 #' @export
123 129
 #'
... ...
@@ -157,7 +163,7 @@ setMethod(
157 163
 # autoplot-HermesDataPcaCor ----
158 164
 
159 165
 #' @describeIn pca_cor_samplevar This plot method uses the [ComplexHeatmap::Heatmap()] function
160
-#'   to visualize a [HermesDataPcaCor] object.
166
+#'   to visualize a [`HermesDataPcaCor`] object.
161 167
 #'
162 168
 #' @param cor_colors (`function`)\cr color scale function for the correlation values in the heatmap,
163 169
 #'   produced by [circlize::colorRamp2()].
Browse code

145: Fix problems with filtering down to empty object, and better MAE example (#146)

Sabanes Bove, Daniel {MDBR~Basel} authored on 23/06/2021 13:38:07 • GitHub Enterprise committed on 23/06/2021 13:38:07
Showing1 changed files
... ...
@@ -7,6 +7,9 @@ NULL
7 7
 #' This helper function calculates R2 values between one sample variable from [AnyHermesData]
8 8
 #' and all Principal Components (PCs) separately (one linear model is fit for each PC).
9 9
 #'
10
+#' Note that in case there are estimation problems for any of the PCs, then `NA` will
11
+#' be returned for those.
12
+#'
10 13
 #' @param pca (`matrix`)\cr principal components matrix generated by [calc_pca()].
11 14
 #' @param x (`vector`)\cr values of one sample variable from [AnyHermesData] object.
12 15
 #'
... ...
@@ -14,6 +17,7 @@ NULL
14 17
 #'
15 18
 #' @importFrom stats model.matrix
16 19
 #' @importFrom limma lmFit
20
+#' @importFrom utils capture.output
17 21
 #' @export
18 22
 #'
19 23
 #' @examples
... ...
@@ -37,10 +41,13 @@ h_pca_var_rsquared <- function(pca, x) {
37 41
   design <- stats::model.matrix(~x)
38 42
   # Transpose such that PCs are in rows, and samples in columns.
39 43
   y0 <- t(pca)
40
-  fit <- limma::lmFit(y0, design = design)
44
+  suppressWarnings(utils::capture.output(fit <- limma::lmFit(y0, design = design)))
45
+  had_problems <- apply(fit$coefficients, 1L, function(row) any(is.na(row)))
41 46
   sst <- rowSums(y0^2)
42 47
   ssr <- sst - fit$df.residual * fit$sigma^2
43
-  ssr / sst
48
+  result <- ssr / sst
49
+  result[had_problems] <- NA
50
+  result
44 51
 }
45 52
 
46 53
 #' Calculation of R2 Matrix between Sample Variables and Principal Components
Browse code

fix refs to classes

Daniel Sabanes Bove authored on 16/06/2021 14:03:03
Showing1 changed files
... ...
@@ -107,7 +107,7 @@ h_pca_df_r2_matrix <- function(pca, df) {
107 107
 #' @aliases pca_cor_samplevar
108 108
 #'
109 109
 #' @param object (`HermesDataPca`)\cr input. It can be generated using [calc_pca()] function
110
-#'   on `[AnyHermesData]`.
110
+#'   on [`AnyHermesData`].
111 111
 #' @param data (`AnyHermesData`)\cr input that was used originally for the PCA.
112 112
 #'
113 113
 #' @return A [HermesDataPcaCor] object with R2 values for all sample variables.
Browse code

fix spellings

Daniel Sabanes Bove authored on 16/06/2021 13:42:03
Showing1 changed files
... ...
@@ -106,7 +106,8 @@ h_pca_df_r2_matrix <- function(pca, df) {
106 106
 #' @rdname pca_cor_samplevar
107 107
 #' @aliases pca_cor_samplevar
108 108
 #'
109
-#' @param object (`HermesDataPca`)\cr input. It can be generated using [calc_pca()] function on [AnyHermesData].
109
+#' @param object (`HermesDataPca`)\cr input. It can be generated using [calc_pca()] function
110
+#'   on `[AnyHermesData]`.
110 111
 #' @param data (`AnyHermesData`)\cr input that was used originally for the PCA.
111 112
 #'
112 113
 #' @return A [HermesDataPcaCor] object with R2 values for all sample variables.
Browse code

auto styler

Daniel Sabanes Bove authored on 16/06/2021 13:04:26
Showing1 changed files
... ...
@@ -24,7 +24,6 @@ NULL
24 24
 #' pca <- calc_pca(object)$x
25 25
 #' x <- colData(object)$LowDepthFlag
26 26
 #' r2 <- h_pca_var_rsquared(pca, x)
27
-#'
28 27
 h_pca_var_rsquared <- function(pca, x) {
29 28
   assert_that(
30 29
     is.matrix(pca),
... ...
@@ -35,7 +34,7 @@ h_pca_var_rsquared <- function(pca, x) {
35 34
   use_sample <- !is.na(x)
36 35
   x <- x[use_sample]
37 36
   pca <- pca[use_sample, ]
38
-  design <- stats::model.matrix(~ x)
37
+  design <- stats::model.matrix(~x)
39 38
   # Transpose such that PCs are in rows, and samples in columns.
40 39
   y0 <- t(pca)
41 40
   fit <- limma::lmFit(y0, design = design)
... ...
@@ -64,7 +63,6 @@ h_pca_var_rsquared <- function(pca, x) {
64 63
 #'   normalize()
65 64
 #' pca <- calc_pca(object)$x
66 65
 #' r2_all <- h_pca_df_r2_matrix(pca, as.data.frame(colData(object)))
67
-#'
68 66
 h_pca_df_r2_matrix <- function(pca, df) {
69 67
   assert_that(
70 68
     is.matrix(pca),
... ...
@@ -86,7 +84,7 @@ h_pca_df_r2_matrix <- function(pca, df) {
86 84
   # Filter character or factor sample variable that has too many (more than half the
87 85
   # number of samples) unique values.
88 86
   too_many_levels <- vapply(df, function(x) {
89
-    (is.character(x) || is.factor(x)) && (length(unique(x)) > nrow(df)/2)
87
+    (is.character(x) || is.factor(x)) && (length(unique(x)) > nrow(df) / 2)
90 88
   }, TRUE)
91 89
   df <- df[, !too_many_levels]
92 90
   # On all remaining columns, run R2 analysis vs. all principal components.
... ...
@@ -122,7 +120,6 @@ h_pca_df_r2_matrix <- function(pca, df) {
122 120
 #'   normalize()
123 121
 #' object_pca <- calc_pca(object)
124 122
 #' result <- correlate(object_pca, object)
125
-#'
126 123
 setMethod(
127 124
   f = "correlate",
128 125
   signature = c(object = "HermesDataPca"),
... ...
@@ -144,7 +141,7 @@ setMethod(
144 141
 #' @rdname pca_cor_samplevar
145 142
 #' @aliases HermesDataPcaCor
146 143
 #' @exportClass HermesDataPcaCor
147
-.HermesDataPcaCor <- setClass(  #nolint
144
+.HermesDataPcaCor <- setClass( # nolint
148 145
   Class = "HermesDataPcaCor",
149 146
   contains = "matrix"
150 147
 )
... ...
@@ -163,18 +160,15 @@ setMethod(
163 160
 #'
164 161
 #' # We can also choose to not reorder the columns.
165 162
 #' autoplot(result, cluster_columns = FALSE)
166
-#'
167 163
 setMethod(
168 164
   f = "autoplot",
169 165
   signature = c(object = "HermesDataPcaCor"),
170
-  definition = function(
171
-    object,
172
-    cor_colors = circlize::colorRamp2(
173
-      c(-0.5, -0.25, 0, 0.25, 0.5, 0.75, 1),
174
-      c("blue", "green", "purple", "yellow", "orange", "red", "brown")
175
-    ),
176
-    ...
177
-  ) {
166
+  definition = function(object,
167
+                        cor_colors = circlize::colorRamp2(
168
+                          c(-0.5, -0.25, 0, 0.25, 0.5, 0.75, 1),
169
+                          c("blue", "green", "purple", "yellow", "orange", "red", "brown")
170
+                        ),
171
+                        ...) {
178 172
     ComplexHeatmap::Heatmap(
179 173
       matrix = t(object),
180 174
       col = cor_colors,
Browse code

avoid snake_case lintr error for constructor functions

Daniel Sabanes Bove authored on 16/06/2021 12:57:49
Showing1 changed files
... ...
@@ -144,7 +144,7 @@ setMethod(
144 144
 #' @rdname pca_cor_samplevar
145 145
 #' @aliases HermesDataPcaCor
146 146
 #' @exportClass HermesDataPcaCor
147
-.HermesDataPcaCor <- setClass(
147
+.HermesDataPcaCor <- setClass(  #nolint
148 148
   Class = "HermesDataPcaCor",
149 149
   contains = "matrix"
150 150
 )
Browse code

cleanup all files re: trailing whitespace

Daniel Sabanes Bove authored on 16/06/2021 12:50:01
Showing1 changed files
... ...
@@ -4,7 +4,7 @@ NULL
4 4
 
5 5
 #' Calculation of R2 between Sample Variable and Principal Components
6 6
 #'
7
-#' This helper function calculates R2 values between one sample variable from [AnyHermesData] 
7
+#' This helper function calculates R2 values between one sample variable from [AnyHermesData]
8 8
 #' and all Principal Components (PCs) separately (one linear model is fit for each PC).
9 9
 #'
10 10
 #' @param pca (`matrix`)\cr principal components matrix generated by [calc_pca()].
... ...
@@ -24,7 +24,7 @@ NULL
24 24
 #' pca <- calc_pca(object)$x
25 25
 #' x <- colData(object)$LowDepthFlag
26 26
 #' r2 <- h_pca_var_rsquared(pca, x)
27
-#'  
27
+#'
28 28
 h_pca_var_rsquared <- function(pca, x) {
29 29
   assert_that(
30 30
     is.matrix(pca),
... ...
@@ -46,13 +46,13 @@ h_pca_var_rsquared <- function(pca, x) {
46 46
 
47 47
 #' Calculation of R2 Matrix between Sample Variables and Principal Components
48 48
 #'
49
-#' This function processes sample variables from [AnyHermesData] and the 
49
+#' This function processes sample variables from [AnyHermesData] and the
50 50
 #' corresponding principal components matrix, and then generates the matrix of R2 values.
51 51
 #'
52 52
 #' @param pca (`matrix`)\cr comprises principal components generated by [calc_pca()].
53 53
 #' @param df (`dataframe`)\cr [SummarizedExperiment::colData()] of [AnyHermesData] object.
54 54
 #'
55
-#' @return A matrix with R2 values for all combinations of sample variables and principle 
55
+#' @return A matrix with R2 values for all combinations of sample variables and principle
56 56
 #'   components.
57 57
 #'
58 58
 #' @export
... ...
@@ -64,7 +64,7 @@ h_pca_var_rsquared <- function(pca, x) {
64 64
 #'   normalize()
65 65
 #' pca <- calc_pca(object)$x
66 66
 #' r2_all <- h_pca_df_r2_matrix(pca, as.data.frame(colData(object)))
67
-#' 
67
+#'
68 68
 h_pca_df_r2_matrix <- function(pca, df) {
69 69
   assert_that(
70 70
     is.matrix(pca),
... ...
@@ -83,7 +83,7 @@ h_pca_df_r2_matrix <- function(pca, df) {
83 83
   # Sample variable cannot have a constant value.
84 84
   is_all_constant <- vapply(df, is_constant, TRUE)
85 85
   df <- df[, !is_all_constant]
86
-  # Filter character or factor sample variable that has too many (more than half the 
86
+  # Filter character or factor sample variable that has too many (more than half the
87 87
   # number of samples) unique values.
88 88
   too_many_levels <- vapply(df, function(x) {
89 89
     (is.character(x) || is.factor(x)) && (length(unique(x)) > nrow(df)/2)
... ...
@@ -101,18 +101,18 @@ h_pca_df_r2_matrix <- function(pca, df) {
101 101
 # correlate-HermesDataPca ----
102 102
 
103 103
 #' Correlation of Principal Components with Sample Variables
104
-#' 
105
-#' This method analyses the correlations (in R2 values) between all sample variables 
104
+#'
105
+#' This method analyses the correlations (in R2 values) between all sample variables
106 106
 #' in [AnyHermesData] object and the principal components of the samples.
107 107
 #'
108 108
 #' @rdname pca_cor_samplevar
109 109
 #' @aliases pca_cor_samplevar
110
-#' 
110
+#'
111 111
 #' @param object (`HermesDataPca`)\cr input. It can be generated using [calc_pca()] function on [AnyHermesData].
112 112
 #' @param data (`AnyHermesData`)\cr input that was used originally for the PCA.
113 113
 #'
114 114
 #' @return A [HermesDataPcaCor] object with R2 values for all sample variables.
115
-#' 
115
+#'
116 116
 #' @export
117 117
 #'
118 118
 #' @examples
... ...
@@ -122,7 +122,7 @@ h_pca_df_r2_matrix <- function(pca, df) {
122 122
 #'   normalize()
123 123
 #' object_pca <- calc_pca(object)
124 124
 #' result <- correlate(object_pca, object)
125
-#' 
125
+#'
126 126
 setMethod(
127 127
   f = "correlate",
128 128
   signature = c(object = "HermesDataPca"),
... ...
@@ -151,28 +151,28 @@ setMethod(
151 151
 
152 152
 # autoplot-HermesDataPcaCor ----
153 153
 
154
-#' @describeIn pca_cor_samplevar This plot method uses the [ComplexHeatmap::Heatmap()] function 
154
+#' @describeIn pca_cor_samplevar This plot method uses the [ComplexHeatmap::Heatmap()] function
155 155
 #'   to visualize a [HermesDataPcaCor] object.
156 156
 #'
157
-#' @param cor_colors (`function`)\cr color scale function for the correlation values in the heatmap, 
157
+#' @param cor_colors (`function`)\cr color scale function for the correlation values in the heatmap,
158 158
 #'   produced by [circlize::colorRamp2()].
159 159
 #' @param ... other arguments to be passed to [ComplexHeatmap::Heatmap()].
160 160
 #'
161 161
 #' @examples
162 162
 #' autoplot(result)
163
-#' 
163
+#'
164 164
 #' # We can also choose to not reorder the columns.
165 165
 #' autoplot(result, cluster_columns = FALSE)
166
-#' 
166
+#'
167 167
 setMethod(
168 168
   f = "autoplot",
169 169
   signature = c(object = "HermesDataPcaCor"),
170 170
   definition = function(
171 171
     object,
172 172
     cor_colors = circlize::colorRamp2(
173
-      c(-0.5, -0.25, 0, 0.25, 0.5, 0.75, 1), 
173
+      c(-0.5, -0.25, 0, 0.25, 0.5, 0.75, 1),
174 174
       c("blue", "green", "purple", "yellow", "orange", "red", "brown")
175
-    ), 
175
+    ),
176 176
     ...
177 177
   ) {
178 178
     ComplexHeatmap::Heatmap(
Browse code

progress

Daniel Sabanes Bove authored on 15/06/2021 13:59:52
Showing1 changed files
... ...
@@ -1,24 +1,26 @@
1
-#' Calculation of R2
1
+#' @include pca.R
2
+#' @include HermesData-methods.R
3
+NULL
4
+
5
+#' Calculation of R2 between Sample Variable and Principal Components
2 6
 #'
3
-#' This function calculates R2 between one sample variable from [AnyHermesData] and Principal Component matrix.
7
+#' This helper function calculates R2 values between one sample variable from [AnyHermesData] 
8
+#' and all Principal Components (PCs) separately (one linear model is fit for each PC).
4 9
 #'
5
-#' @param pca (`matrix`)\cr A matrix comprising of principal components matrix generated by [calc_pca()] function.
6
-#'   function.
7
-#' @param x (`vector`)\cr A vector with one sample variable from [AnyHermesData] object.
10
+#' @param pca (`matrix`)\cr principal components matrix generated by [calc_pca()].
11
+#' @param x (`vector`)\cr values of one sample variable from [AnyHermesData] object.
8 12
 #'
9
-#' @return A vector with R2 values for each principal component for the sample variable of interest from [AnyHermesData]
10
-#'   object.
13
+#' @return A vector with R2 values for each principal component.
11 14
 #'
12 15
 #' @importFrom stats model.matrix
13 16
 #' @importFrom limma lmFit
14
-#'
15 17
 #' @export
16 18
 #'
17 19
 #' @examples
18 20
 #' object <- HermesData(summarized_experiment) %>%
19
-#'  add_quality_flags() %>%
20
-#'  filter() %>%
21
-#'  normalize()
21
+#'   add_quality_flags() %>%
22
+#'   filter() %>%
23
+#'   normalize()
22 24
 #' pca <- calc_pca(object)$x
23 25
 #' x <- colData(object)$LowDepthFlag
24 26
 #' r2 <- h_pca_var_rsquared(pca, x)
... ...
@@ -37,33 +39,29 @@ h_pca_var_rsquared <- function(pca, x) {
37 39
   # Transpose such that PCs are in rows, and samples in columns.
38 40
   y0 <- t(pca)
39 41
   fit <- limma::lmFit(y0, design = design)
40
-  ## Compute total sum of squares
41 42
   sst <- rowSums(y0^2)
42
-  ## Compute residual sum of squares
43 43
   ssr <- sst - fit$df.residual * fit$sigma^2
44
-  r2 <- ssr / sst
45
-  r2
44
+  ssr / sst
46 45
 }
47 46
 
48
-
49
-#' Generate R2 values for all sample variables
47
+#' Calculation of R2 Matrix between Sample Variables and Principal Components
50 48
 #'
51
-#' This function processes sample variables from [AnyHermesData] and the corresponding principal component matrix, and
52
-#' then generates R2 values for all sample variables in [AnyHermesData] object, giving correlations between all sample
53
-#' variables in [AnyHermesData] object and the principal components of the samples.
49
+#' This function processes sample variables from [AnyHermesData] and the 
50
+#' corresponding principal components matrix, and then generates the matrix of R2 values.
54 51
 #'
55
-#' @param pca (`matrix`)\cr A matrix comprising of principal components matrix generated by [calc_pca()] function.
56
-#' @param df (`dataframe`)\cr A dataframe with sample data [colData] from [AnyHermesData] object.
52
+#' @param pca (`matrix`)\cr comprises principal components generated by [calc_pca()].
53
+#' @param df (`dataframe`)\cr [SummarizedExperiment::colData()] of [AnyHermesData] object.
57 54
 #'
58
-#' @return A matrix with R2 values for all sample variables in [AnyHermesData] object.
55
+#' @return A matrix with R2 values for all combinations of sample variables and principle 
56
+#'   components.
59 57
 #'
60 58
 #' @export
61 59
 #'
62 60
 #' @examples
63 61
 #' object <- HermesData(summarized_experiment) %>%
64
-#'  add_quality_flags() %>%
65
-#'  filter() %>%
66
-#'  normalize()
62
+#'   add_quality_flags() %>%
63
+#'   filter() %>%
64
+#'   normalize()
67 65
 #' pca <- calc_pca(object)$x
68 66
 #' r2_all <- h_pca_df_r2_matrix(pca, as.data.frame(colData(object)))
69 67
 #' 
... ...
@@ -79,13 +77,14 @@ h_pca_df_r2_matrix <- function(pca, df) {
79 77
     is.numeric(x) || is.character(x) || is.factor(x) || is.logical(x)
80 78
   }, TRUE)
81 79
   df <- df[, is_accepted_type]
82
-  # Sample variable cannot be completely `NA`
80
+  # Sample variable cannot be completely `NA`.
83 81
   is_all_na <- vapply(df, all_na, TRUE)
84 82
   df <- df[, !is_all_na]
85
-  # Sample variable cannot have a constant value
83
+  # Sample variable cannot have a constant value.
86 84
   is_all_constant <- vapply(df, is_constant, TRUE)
87 85
   df <- df[, !is_all_constant]
88
-  # Filter character or factor sample variable that has too many (more than half the number of samples) unique values
86
+  # Filter character or factor sample variable that has too many (more than half the 
87
+  # number of samples) unique values.
89 88
   too_many_levels <- vapply(df, function(x) {
90 89
     (is.character(x) || is.factor(x)) && (length(unique(x)) > nrow(df)/2)
91 90
   }, TRUE)
... ...
@@ -99,29 +98,18 @@ h_pca_df_r2_matrix <- function(pca, df) {
99 98
   )
100 99
 }
101 100
 
102
-# HermesDataTopGenes ----
103
-#' @rdname correlate
104
-#' @aliases HermesDataPcaCor
105
-#' @aliases correlate
106
-#' @exportClass HermesDataPcaCor
107
-.HermesDataPcaCor <- setClass(
108
-  Class = "HermesDataPcaCor",
109
-  contains = "matrix"
110
-)
111
-
112
-setGeneric("correlate", function(object_pca, ...) {})
101
+# correlate-HermesDataPca ----
113 102
 
114
-#' Correlate
103
+#' Correlation of Principal Components with Sample Variables
115 104
 #' 
116
-#' Method to generate correlation between all sample variables in [AnyHermesData] object and the principal components of
117
-#' the samples.
105
+#' This method analyses the correlations (in R2 values) between all sample variables 
106
+#' in [AnyHermesData] object and the principal components of the samples.
118 107
 #'
119
-#' @describeIn correlate Method to obtain [HermesDataPcaCor] object with R2 values for all sample variables in
120
-#'   [AnyHermesData] object, giving correlations between all sample variables in [AnyHermesData] object and the
121
-#'   principal components of the samples.
122
-#'
123
-#' @param object_pca (`HermesDataPca`)\cr input. It can be generated using [calc_pca()] function on [AnyHermesData].
124
-#' @param data object (`AnyHermedData`)\cr input.
108
+#' @rdname pca_cor_samplevar
109
+#' @aliases pca_cor_samplevar
110
+#' 
111
+#' @param object (`HermesDataPca`)\cr input. It can be generated using [calc_pca()] function on [AnyHermesData].
112
+#' @param data (`AnyHermesData`)\cr input that was used originally for the PCA.
125 113
 #'
126 114
 #' @return A [HermesDataPcaCor] object with R2 values for all sample variables.
127 115
 #' 
... ...
@@ -129,20 +117,20 @@ setGeneric("correlate", function(object_pca, ...) {})
129 117
 #'
130 118
 #' @examples
131 119
 #' object <- HermesData(summarized_experiment) %>%
132
-#'  add_quality_flags() %>%
133
-#'  filter() %>%
134
-#'  normalize()
120
+#'   add_quality_flags() %>%
121
+#'   filter() %>%
122
+#'   normalize()
135 123
 #' object_pca <- calc_pca(object)
136 124
 #' result <- correlate(object_pca, object)
137 125
 #' 
138 126
 setMethod(
139 127
   f = "correlate",
140
-  signature = c(object_pca = "HermesDataPca"),
141
-  definition = function(object_pca, data) {
142
-    pca <- object_pca$x
128
+  signature = c(object = "HermesDataPca"),
129
+  definition = function(object, data) {
130
+    pca <- object$x
143 131
     assert_that(
144 132
       is_hermes_data(data),
145
-      is(object_pca, "HermesDataPca"),
133
+      is(object, "HermesDataPca"),
146 134
       identical(rownames(pca), colnames(data))
147 135
     )
148 136
     df <- as.data.frame(colData(data))
... ...
@@ -151,35 +139,46 @@ setMethod(
151 139
   }
152 140
 )
153 141
 
154
-# autoplot ----
142
+# HermesDataPcaCor ----
143
+
144
+#' @rdname pca_cor_samplevar
145
+#' @aliases HermesDataPcaCor
146
+#' @exportClass HermesDataPcaCor
147
+.HermesDataPcaCor <- setClass(
148
+  Class = "HermesDataPcaCor",
149
+  contains = "matrix"
150
+)
155 151
 
156
-setGeneric("autoplot")
152
+# autoplot-HermesDataPcaCor ----
157 153
 
158
-#' @describeIn correlate This plot method uses the [ComplexHeatmap::Heatmap()] function to plot the correlations between
159
-#'   samples variables in [AnyHermesData] object and the principal components of the samples saved in a [HermesDataPcaCor]
160
-#'   object.
154
+#' @describeIn pca_cor_samplevar This plot method uses the [ComplexHeatmap::Heatmap()] function 
155
+#'   to visualize a [HermesDataPcaCor] object.
161 156
 #'
162
-#' @param object (`HermesDataPcaCor`)\cr Generated using [correlate] method.
163 157
 #' @param cor_colors (`function`)\cr color scale function for the correlation values in the heatmap, 
164 158
 #'   produced by [circlize::colorRamp2()].
165
-#' @param cluster_columns (`function`)\cr Indicate whether re-ordering of columns is desired.
166 159
 #' @param ... other arguments to be passed to [ComplexHeatmap::Heatmap()].
167 160
 #'
168 161
 #' @examples
169 162
 #' autoplot(result)
170 163
 #' 
164
+#' # We can also choose to not reorder the columns.
165
+#' autoplot(result, cluster_columns = FALSE)
166
+#' 
171 167
 setMethod(
172 168
   f = "autoplot",
173 169
   signature = c(object = "HermesDataPcaCor"),
174
-  definition = function(object,
175
-                        cor_colors = circlize::colorRamp2(c(-0.5, -0.25, 0, 0.25, 0.5, 0.75, 1), c("blue", "green", "purple", "yellow", "orange", "red", "brown")),
176
-                        cluster_columns = FALSE, 
177
-                        ...) {
170
+  definition = function(
171
+    object,
172
+    cor_colors = circlize::colorRamp2(
173
+      c(-0.5, -0.25, 0, 0.25, 0.5, 0.75, 1), 
174
+      c("blue", "green", "purple", "yellow", "orange", "red", "brown")
175
+    ), 
176
+    ...
177
+  ) {
178 178
     ComplexHeatmap::Heatmap(
179 179
       matrix = t(object),
180 180
       col = cor_colors,
181 181
       name = "R2",
182
-      cluster_columns = FALSE,
183 182
       ...
184 183
     )
185 184
   }
Browse code

95: PCA plot showing correlation between all sample vars & PC

Namrata Bhatia authored on 15/06/2021 03:35:16
Showing1 changed files
1 1
new file mode 100644
... ...
@@ -0,0 +1,186 @@
1
+#' Calculation of R2
2
+#'
3
+#' This function calculates R2 between one sample variable from [AnyHermesData] and Principal Component matrix.
4
+#'
5
+#' @param pca (`matrix`)\cr A matrix comprising of principal components matrix generated by [calc_pca()] function.
6
+#'   function.
7
+#' @param x (`vector`)\cr A vector with one sample variable from [AnyHermesData] object.
8
+#'
9
+#' @return A vector with R2 values for each principal component for the sample variable of interest from [AnyHermesData]
10
+#'   object.
11
+#'
12
+#' @importFrom stats model.matrix
13
+#' @importFrom limma lmFit
14
+#'
15
+#' @export
16
+#'
17
+#' @examples
18
+#' object <- HermesData(summarized_experiment) %>%
19
+#'  add_quality_flags() %>%
20
+#'  filter() %>%
21
+#'  normalize()
22
+#' pca <- calc_pca(object)$x
23
+#' x <- colData(object)$LowDepthFlag
24
+#' r2 <- h_pca_var_rsquared(pca, x)
25
+#'  
26
+h_pca_var_rsquared <- function(pca, x) {
27
+  assert_that(
28
+    is.matrix(pca),
29
+    is.numeric(x) || is.factor(x) || is.character(x) || is.logical(x),
30
+    identical(length(x), nrow(pca)),
31
+    all(abs(colMeans(pca)) < 1e-10)
32
+  )
33
+  use_sample <- !is.na(x)
34
+  x <- x[use_sample]
35
+  pca <- pca[use_sample, ]
36
+  design <- stats::model.matrix(~ x)
37
+  # Transpose such that PCs are in rows, and samples in columns.
38
+  y0 <- t(pca)
39
+  fit <- limma::lmFit(y0, design = design)
40
+  ## Compute total sum of squares
41
+  sst <- rowSums(y0^2)
42
+  ## Compute residual sum of squares
43
+  ssr <- sst - fit$df.residual * fit$sigma^2
44
+  r2 <- ssr / sst
45
+  r2
46
+}
47
+
48
+
49
+#' Generate R2 values for all sample variables
50
+#'
51
+#' This function processes sample variables from [AnyHermesData] and the corresponding principal component matrix, and
52
+#' then generates R2 values for all sample variables in [AnyHermesData] object, giving correlations between all sample
53
+#' variables in [AnyHermesData] object and the principal components of the samples.
54
+#'
55
+#' @param pca (`matrix`)\cr A matrix comprising of principal components matrix generated by [calc_pca()] function.
56
+#' @param df (`dataframe`)\cr A dataframe with sample data [colData] from [AnyHermesData] object.
57
+#'
58
+#' @return A matrix with R2 values for all sample variables in [AnyHermesData] object.
59
+#'
60
+#' @export
61
+#'
62
+#' @examples
63
+#' object <- HermesData(summarized_experiment) %>%
64
+#'  add_quality_flags() %>%
65
+#'  filter() %>%
66
+#'  normalize()
67
+#' pca <- calc_pca(object)$x
68
+#' r2_all <- h_pca_df_r2_matrix(pca, as.data.frame(colData(object)))
69
+#' 
70
+h_pca_df_r2_matrix <- function(pca, df) {
71
+  assert_that(
72
+    is.matrix(pca),
73
+    is.data.frame(df),
74
+    identical(nrow(pca), nrow(df))
75
+  )
76
+  # Sequentially filter down the columns in `df`.
77
+  # Sample variable must be numeric, character, factor or logical.
78
+  is_accepted_type <- vapply(df, function(x) {
79
+    is.numeric(x) || is.character(x) || is.factor(x) || is.logical(x)
80
+  }, TRUE)
81
+  df <- df[, is_accepted_type]
82
+  # Sample variable cannot be completely `NA`
83
+  is_all_na <- vapply(df, all_na, TRUE)
84
+  df <- df[, !is_all_na]
85
+  # Sample variable cannot have a constant value
86
+  is_all_constant <- vapply(df, is_constant, TRUE)
87
+  df <- df[, !is_all_constant]
88
+  # Filter character or factor sample variable that has too many (more than half the number of samples) unique values
89
+  too_many_levels <- vapply(df, function(x) {
90
+    (is.character(x) || is.factor(x)) && (length(unique(x)) > nrow(df)/2)
91
+  }, TRUE)
92
+  df <- df[, !too_many_levels]
93
+  # On all remaining columns, run R2 analysis vs. all principal components.
94
+  vapply(
95
+    X = df,
96
+    FUN = h_pca_var_rsquared,
97
+    pca = pca,
98
+    FUN.VALUE = rep(0.5, ncol(pca))
99
+  )
100
+}
101
+
102
+# HermesDataTopGenes ----
103
+#' @rdname correlate
104
+#' @aliases HermesDataPcaCor
105
+#' @aliases correlate
106
+#' @exportClass HermesDataPcaCor
107
+.HermesDataPcaCor <- setClass(
108
+  Class = "HermesDataPcaCor",
109
+  contains = "matrix"
110
+)
111
+
112
+setGeneric("correlate", function(object_pca, ...) {})
113
+
114
+#' Correlate
115
+#' 
116
+#' Method to generate correlation between all sample variables in [AnyHermesData] object and the principal components of
117
+#' the samples.
118
+#'
119
+#' @describeIn correlate Method to obtain [HermesDataPcaCor] object with R2 values for all sample variables in
120
+#'   [AnyHermesData] object, giving correlations between all sample variables in [AnyHermesData] object and the
121
+#'   principal components of the samples.
122
+#'
123
+#' @param object_pca (`HermesDataPca`)\cr input. It can be generated using [calc_pca()] function on [AnyHermesData].
124
+#' @param data object (`AnyHermedData`)\cr input.
125
+#'
126
+#' @return A [HermesDataPcaCor] object with R2 values for all sample variables.
127
+#' 
128
+#' @export
129
+#'
130
+#' @examples
131
+#' object <- HermesData(summarized_experiment) %>%
132
+#'  add_quality_flags() %>%
133
+#'  filter() %>%
134
+#'  normalize()
135
+#' object_pca <- calc_pca(object)
136
+#' result <- correlate(object_pca, object)
137
+#' 
138
+setMethod(
139
+  f = "correlate",
140
+  signature = c(object_pca = "HermesDataPca"),
141
+  definition = function(object_pca, data) {
142
+    pca <- object_pca$x
143
+    assert_that(
144
+      is_hermes_data(data),
145
+      is(object_pca, "HermesDataPca"),
146
+      identical(rownames(pca), colnames(data))
147
+    )
148
+    df <- as.data.frame(colData(data))
149
+    r2_matrix <- h_pca_df_r2_matrix(pca, df)
150
+    .HermesDataPcaCor(r2_matrix)
151
+  }
152
+)
153
+
154
+# autoplot ----
155
+
156
+setGeneric("autoplot")
157
+
158
+#' @describeIn correlate This plot method uses the [ComplexHeatmap::Heatmap()] function to plot the correlations between
159
+#'   samples variables in [AnyHermesData] object and the principal components of the samples saved in a [HermesDataPcaCor]
160
+#'   object.
161
+#'
162
+#' @param object (`HermesDataPcaCor`)\cr Generated using [correlate] method.
163
+#' @param cor_colors (`function`)\cr color scale function for the correlation values in the heatmap, 
164
+#'   produced by [circlize::colorRamp2()].
165
+#' @param cluster_columns (`function`)\cr Indicate whether re-ordering of columns is desired.
166
+#' @param ... other arguments to be passed to [ComplexHeatmap::Heatmap()].
167
+#'
168
+#' @examples
169
+#' autoplot(result)
170
+#' 
171
+setMethod(
172
+  f = "autoplot",
173
+  signature = c(object = "HermesDataPcaCor"),
174
+  definition = function(object,
175
+                        cor_colors = circlize::colorRamp2(c(-0.5, -0.25, 0, 0.25, 0.5, 0.75, 1), c("blue", "green", "purple", "yellow", "orange", "red", "brown")),
176
+                        cluster_columns = FALSE, 
177
+                        ...) {
178
+    ComplexHeatmap::Heatmap(
179
+      matrix = t(object),
180
+      col = cor_colors,
181
+      name = "R2",
182
+      cluster_columns = FALSE,
183
+      ...
184
+    )
185
+  }
186
+)