Thanks to visit codestin.com
Credit goes to github.com

Skip to content

Commit 849bf51

Browse files
stemangiolastemangiola
authored
Merge pull request #112 from stemangiola/dev
Dev
2 parents 6b16004 + 035137b commit 849bf51

27 files changed

+2400
-39
lines changed

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
Type: Package
22
Package: tidyHeatmap
33
Title: A Tidy Implementation of Heatmap
4-
Version: 1.9.2
4+
Version: 1.10.0
55
Authors@R:
66
c(person(given = "Stefano",
77
family = "Mangiola",

‎NAMESPACE‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ export(layer_diamond)
1818
export(layer_point)
1919
export(layer_square)
2020
export(layer_star)
21+
export(layer_text)
2122
export(save_pdf)
2223
export(scale_robust)
2324
export(split_columns)
@@ -42,6 +43,7 @@ importFrom(grDevices,colorRampPalette)
4243
importFrom(grid,gpar)
4344
importFrom(grid,grid.grabExpr)
4445
importFrom(grid,grid.points)
46+
importFrom(grid,grid.text)
4547
importFrom(grid,unit)
4648
importFrom(grid,unit.c)
4749
importFrom(lifecycle,deprecate_warn)

‎R/functions.R‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -510,3 +510,4 @@ setMethod("layer_symbol", "InputHeatmap", function(.data,
510510

511511

512512
})
513+

‎R/methods.R‎

Lines changed: 167 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,8 @@ InputHeatmap<-setClass(
1111
top_annotation = "tbl",
1212
left_annotation = "tbl",
1313
arguments = "list" ,
14-
layer_symbol = "tbl"
14+
layer_symbol = "tbl",
15+
layer_text = "tbl"
1516
),
1617
prototype=list(
1718
palette_discrete=
@@ -36,7 +37,9 @@ InputHeatmap<-setClass(
3637
left_annotation = tibble(col_name = character(), orientation = character(), col_orientation = character(), data = list(), fx = list(), annot = list(), annot_type= character(), idx = integer(), color = list(), further_arguments = list()),
3738
group_top_annotation = list(),
3839
group_left_annotation = list(),
39-
layer_symbol = tibble(column = integer(), row = integer(), shape = integer())
40+
layer_symbol = tibble(column = integer(), row = integer(), shape = integer()),
41+
layer_text = tibble(column = integer(), row = integer(), text = character(), size = numeric())
42+
4043
)
4144
)
4245

@@ -49,7 +52,7 @@ InputHeatmap<-setClass(
4952
#'
5053
#' @importFrom methods show
5154
#' @importFrom tibble rowid_to_column
52-
#' @importFrom grid grid.points
55+
#' @importFrom grid grid.points grid.text
5356
#'
5457
#'
5558
#' @name as_ComplexHeatmap
@@ -124,21 +127,44 @@ setMethod("as_ComplexHeatmap", "InputHeatmap", function(tidyHeatmap){
124127

125128
# On-top layer
126129
tidyHeatmap@input$layer_fun = function(j, i, x, y, w, h, fill) {
130+
131+
132+
# Add symbol
127133
ind =
128134
tibble(row = i, column = j) |>
129135
rowid_to_column("index_column_wise") |>
130136

131137
# Filter just points to label
132-
inner_join(tidyHeatmap@layer_symbol, by = c("row", "column")) |>
133-
select(`index_column_wise`, `shape`)
138+
inner_join(tidyHeatmap@layer_symbol, by = c("row", "column"))
134139

135-
if(nrow(ind)>0)
140+
# Return graphical elements
141+
if(nrow(ind)>0){
136142
grid.points(
137143
x[ind$index_column_wise], y[ind$index_column_wise],
138144
pch = ind$shape ,
139145
size = unit(3, "mm"),
140146
gp = gpar(col = NULL, fill="#161616")
141147
)
148+
}
149+
150+
# Add text
151+
ind_text =
152+
tibble(row = i, column = j) |>
153+
rowid_to_column("index_column_wise") |>
154+
155+
# Filter just points to label
156+
inner_join(tidyHeatmap@layer_text, by = c("row", "column"))
157+
158+
# Return graphical elements
159+
if(nrow(ind_text) > 0){
160+
grid.text(
161+
ind_text$text,
162+
x[ind_text$index_column_wise],
163+
y[ind_text$index_column_wise],
164+
gp = gpar(fontsize = ind_text$size, col = "#000000")
165+
)
166+
}
167+
142168
}
143169

144170
return(do.call(Heatmap, tidyHeatmap@input))
@@ -249,13 +275,13 @@ heatmap_ <-
249275

250276
# Check if scale is of correct type
251277
if(scale %in% c("none", "row", "column", "both") |> not()) stop("tidyHeatmap says: the scale parameter has to be one of c(\"none\", \"row\", \"column\", \"both\")")
252-
278+
253279
# # Message about change of style, once per session
254280
# if(length(palette_grouping)==0 & getOption("tidyHeatmap_white_group_message",TRUE)) {
255281
# message("tidyHeatmap says: (once per session) from release 1.2.3 the grouping labels have white background by default. To add color for one-ay grouping specify palette_grouping = list(c(\"red\", \"blue\"))")
256282
# options("tidyHeatmap_white_group_message"=FALSE)
257283
# }
258-
284+
259285
# Message about change of scale, once per session
260286
if(scale == "none" & getOption("tidyHeatmap_default_scaling_none",TRUE)) {
261287
message("tidyHeatmap says: (once per session) from release 1.7.0 the scaling is set to \"none\" by default. Please use scale = \"row\", \"column\" or \"both\" to apply scaling")
@@ -265,7 +291,7 @@ heatmap_ <-
265291
.row = enquo(.row)
266292
.column = enquo(.column)
267293
.value <- enquo(.value)
268-
294+
269295
# Validation
270296
.data |> validation(!!.column, !!.row, !!.value)
271297

@@ -276,7 +302,7 @@ heatmap_ <-
276302
deprecate_warn("1.7.0", "tidyHeatmap::heatmap(.scale = )", details = "Please use scale (without dot prefix) instead: heatmap(scale = ...)")
277303

278304
scale = .scale
279-
305+
280306
}
281307

282308
.data |>
@@ -378,8 +404,8 @@ setMethod("heatmap", "tbl_df", heatmap_)
378404
#'
379405
#' @export
380406
setGeneric("annotation_tile", function(.data,
381-
.column,
382-
palette = NULL, size = NULL, ...)
407+
.column,
408+
palette = NULL, size = NULL, ...)
383409
standardGeneric("annotation_tile"))
384410

385411
#' annotation_tile
@@ -390,8 +416,8 @@ setGeneric("annotation_tile", function(.data,
390416
#' @return A `InputHeatmap` object that gets evaluated to a `ComplexHeatmap`
391417
#'
392418
setMethod("annotation_tile", "InputHeatmap", function(.data,
393-
.column,
394-
palette = NULL, size = NULL,...){
419+
.column,
420+
palette = NULL, size = NULL,...){
395421

396422
.column = enquo(.column)
397423

@@ -462,8 +488,8 @@ setMethod("annotation_tile", "InputHeatmap", function(.data,
462488
#'
463489
#' @export
464490
setGeneric("annotation_point", function(.data,
465-
.column,
466-
palette = NULL, size = NULL,...)
491+
.column,
492+
palette = NULL, size = NULL,...)
467493
standardGeneric("annotation_point"))
468494

469495
#' annotation_point
@@ -474,8 +500,8 @@ setGeneric("annotation_point", function(.data,
474500
#' @return A `InputHeatmap` object that gets evaluated to a `ComplexHeatmap`
475501
#'
476502
setMethod("annotation_point", "InputHeatmap", function(.data,
477-
.column,
478-
palette = NULL, size = NULL,...){
503+
.column,
504+
palette = NULL, size = NULL,...){
479505

480506
.column = enquo(.column)
481507

@@ -524,8 +550,8 @@ setMethod("annotation_point", "InputHeatmap", function(.data,
524550
#'
525551
#' @export
526552
setGeneric("annotation_line", function(.data,
527-
.column,
528-
palette = NULL,size = NULL, ...)
553+
.column,
554+
palette = NULL,size = NULL, ...)
529555
standardGeneric("annotation_line"))
530556

531557
#' annotation_line
@@ -537,8 +563,8 @@ setGeneric("annotation_line", function(.data,
537563
#' @return A `InputHeatmap` object that gets evaluated to a `ComplexHeatmap`
538564
#'
539565
setMethod("annotation_line", "InputHeatmap", function(.data,
540-
.column,
541-
palette = NULL, size = NULL,...){
566+
.column,
567+
palette = NULL, size = NULL,...){
542568

543569
.column = enquo(.column)
544570

@@ -587,8 +613,8 @@ setMethod("annotation_line", "InputHeatmap", function(.data,
587613
#'
588614
#' @export
589615
setGeneric("annotation_bar", function(.data,
590-
.column,
591-
palette = NULL, size = NULL,...)
616+
.column,
617+
palette = NULL, size = NULL,...)
592618
standardGeneric("annotation_bar"))
593619

594620
#' annotation_bar
@@ -599,8 +625,8 @@ setGeneric("annotation_bar", function(.data,
599625
#' @return A `InputHeatmap` object that gets evaluated to a `ComplexHeatmap`
600626
#'
601627
setMethod("annotation_bar", "InputHeatmap", function(.data,
602-
.column,
603-
palette = NULL, size = NULL,...){
628+
.column,
629+
palette = NULL, size = NULL,...){
604630

605631
.column = enquo(.column)
606632

@@ -897,7 +923,7 @@ setMethod("layer_diamond", "InputHeatmap", function(.data, ...){ .data |> layer_
897923
#'
898924
#' @export
899925
setGeneric("layer_star", function(.data, ...)
900-
standardGeneric("layer_star"))
926+
standardGeneric("layer_star"))
901927

902928
#' layer_star
903929
#'
@@ -947,7 +973,7 @@ setMethod("layer_star", "InputHeatmap", function(.data, ...){ .data |> layer_sym
947973
#'
948974
#' @export
949975
setGeneric("layer_asterisk", function(.data, ...)
950-
standardGeneric("layer_asterisk"))
976+
standardGeneric("layer_asterisk"))
951977

952978
#' layer_asterisk
953979
#'
@@ -959,6 +985,119 @@ setGeneric("layer_asterisk", function(.data, ...)
959985
#'
960986
setMethod("layer_asterisk", "InputHeatmap", function(.data, ...){ .data |> layer_symbol(..., symbol="asterisk") })
961987

988+
989+
#' Adds a layers of texts above the heatmap tiles to a `InputHeatmap`, that on evaluation creates a `ComplexHeatmap`
990+
#'
991+
#' \lifecycle{maturing}
992+
#'
993+
#' @description layer_text() from a `InputHeatmap` object, adds a text annotation layer.
994+
#'
995+
#' @importFrom rlang enquo
996+
#' @importFrom magrittr "%>%"
997+
#'
998+
#'
999+
#'
1000+
#' @name layer_text
1001+
#' @rdname layer_text-method
1002+
#'
1003+
#' @param .data A `InputHeatmap`
1004+
#' @param ... Expressions that return a logical value, and are defined in terms of the variables in .data. If multiple expressions are included, they are combined with the & operator. Only rows for which all conditions evaluate to TRUE are kept.
1005+
#' @param .value A column name or character string.
1006+
#' @param .size A column name or a double.
1007+
#'
1008+
#'
1009+
#' @details It uses `ComplexHeatmap` as visualisation tool.
1010+
#'
1011+
#' @return A `InputHeatmap` object that gets evaluated to a `ComplexHeatmap`
1012+
#'
1013+
#'
1014+
#'
1015+
#' @examples
1016+
#'
1017+
#' library(dplyr)
1018+
#'
1019+
#' hm =
1020+
#' tidyHeatmap::N52 |>
1021+
#' mutate(my_text = "t") |>
1022+
#' tidyHeatmap::heatmap(
1023+
#' .row = symbol_ct,
1024+
#' .column = UBR,
1025+
#' .value = `read count normalised log`
1026+
#' )
1027+
#'
1028+
#' hm |> layer_text(.value = "a")
1029+
#' hm |> layer_text(.value = my_text)
1030+
#'
1031+
#' @export
1032+
setGeneric("layer_text", function(.data,
1033+
...,
1034+
.value,
1035+
.size = NULL)
1036+
standardGeneric("layer_text"))
1037+
1038+
#' layer_text
1039+
#'
1040+
#' @importFrom rlang quo_is_null
1041+
#'
1042+
#' @docType methods
1043+
#' @rdname layer_text-method
1044+
#'
1045+
#'
1046+
#' @return A `InputHeatmap` object that gets evaluated to a `ComplexHeatmap`
1047+
#'
1048+
setMethod("layer_text", "InputHeatmap", function(.data,
1049+
...,
1050+
.value,
1051+
.size = NULL){
1052+
1053+
.data_drame = .data@data
1054+
.size = enquo(.size)
1055+
1056+
# Comply with CRAN NOTES
1057+
. = NULL
1058+
column = NULL
1059+
row = NULL
1060+
1061+
# Make col names
1062+
# Column names
1063+
.horizontal = .data@arguments$.horizontal
1064+
.vertical = .data@arguments$.vertical
1065+
.abundance = .data@arguments$.abundance
1066+
1067+
# Extract the abundance matrix for dimensions of the text
1068+
abundance_mat = .data@input[[1]]
1069+
1070+
# Append which cells have to be signed
1071+
.data@layer_text=
1072+
.data@layer_text |>
1073+
bind_rows(
1074+
1075+
.data_drame |>
1076+
droplevels() |>
1077+
mutate(
1078+
column = !!.horizontal %>% as.factor() %>% as.integer(),
1079+
row = !!.vertical %>% as.factor() %>% as.integer()
1080+
) |>
1081+
filter(...) |>
1082+
1083+
mutate(text := as.character( !!enquo(.value) )) |>
1084+
1085+
# Add size
1086+
when(
1087+
quo_is_null(.size) ~ mutate(., size = min(12, 320 / max(dim(abundance_mat)) )) ,
1088+
~ mutate(., size := !!.size )
1089+
) |>
1090+
1091+
select(column, row, text, size)
1092+
1093+
1094+
)
1095+
1096+
.data
1097+
1098+
1099+
})
1100+
9621101
#' Split the heatmap row-wise depending on the biggest branches in the cladogram.
9631102
#'
9641103
#' \lifecycle{maturing}

0 commit comments

Comments
 (0)