Skip to content

Commit 58100af

Browse files
rcannoodrcannood
committed
WIP documentation improvements.
1 parent 89d7276 commit 58100af

30 files changed

+385
-221
lines changed

‎DESCRIPTION‎

Lines changed: 23 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -59,23 +59,26 @@ Suggests:
5959
uwot
6060
VignetteBuilder: knitr
6161
Collate:
62-
'milestone_palette.R'
63-
'add_coloring.R'
64-
'data.R'
65-
'dummy_proofing.R'
66-
'expect_ggplot.R'
67-
'is_colour_vector.R'
68-
'linearise_cells.R'
69-
'optimize_order.R'
70-
'package.R'
71-
'plot_dendro.R'
72-
'project_waypoints.R'
73-
'plot_dimred.R'
74-
'plot_edge_flips.R'
75-
'plot_graph.R'
76-
'plot_heatmap.R'
77-
'plot_linearised_comparison.R'
78-
'plot_onedim.R'
79-
'plot_strip.R'
80-
'plot_topology.R'
81-
'theme_clean.R'
62+
'milestone_palette.R'
63+
'add_milestone_coloring.R'
64+
'add_cell_coloring.R'
65+
'add_density_coloring.R'
66+
'data.R'
67+
'dummy_proofing.R'
68+
'expect_ggplot.R'
69+
'is_colour_vector.R'
70+
'linearise_cells.R'
71+
'mix_colors.R'
72+
'optimize_order.R'
73+
'package.R'
74+
'plot_dendro.R'
75+
'project_waypoints.R'
76+
'plot_dimred.R'
77+
'plot_edge_flips.R'
78+
'plot_graph.R'
79+
'plot_heatmap.R'
80+
'plot_linearised_comparison.R'
81+
'plot_onedim.R'
82+
'plot_strip.R'
83+
'plot_topology.R'
84+
'theme_clean.R'

‎NAMESPACE‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
# Generated by roxygen2: do not edit by hand
22

3+
export(add_milestone_coloring)
34
export(empty_plot)
45
export(get_milestone_palette_names)
56
export(plot_dendro)

‎NEWS.md‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,8 @@ Initial release on CRAN.
1616
* MINOR CHANGE `plot_dendro()`: Allow plotting of disconnected graphs (#32).
1717
This assumes that `dynwrap::add_root(traj, root_milestone_id = c(...))` has been called properly.
1818

19+
* DOCUMENTATION: Extend documentation on usage of parameters and the expected output values
20+
of functions.
1921

2022
# dynplot 1.0.2 (04-07-2019)
2123

‎R/add_cell_coloring.R‎

Lines changed: 122 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,122 @@
1+
#' Add colouring to a set of cells.
2+
#'
3+
#' @param cell_positions The positions of the cells, represented by a tibble.
4+
#' Must contain column `cell_id` (character) and may contain columns `from`,
5+
#' `to`, `pseudotime`, depending on the value of `color_cells`.
6+
#' @param color_cells How to color the cells
7+
#' @param trajectory The trajectory
8+
#' @param grouping The grouping of the cells
9+
#' @param groups Tibble containing information of the cell groups
10+
#' @param feature_oi feature to plot expression
11+
#' @param expression_source Source of the feature expression, defaults to `expression`
12+
#' @param pseudotime The pseudotime
13+
#' @param milestone_percentages The milestone percentages
14+
#'
15+
#' @inheritParams add_milestone_coloring
16+
#'
17+
#' @include add_milestone_coloring.R
18+
add_cell_coloring <- dynutils::inherit_default_params(
19+
add_milestone_coloring,
20+
function(
21+
cell_positions,
22+
color_cells = c("auto", "none", "grouping", "feature", "milestone", "pseudotime"),
23+
trajectory,
24+
grouping = NULL,
25+
groups = NULL,
26+
feature_oi = NULL,
27+
expression_source = "expression",
28+
pseudotime = NULL,
29+
color_milestones = NULL,
30+
milestones = NULL,
31+
milestone_percentages = NULL
32+
) {
33+
# check cell coloration
34+
color_cells <- match.arg(color_cells)
35+
if (color_cells == "auto") {
36+
if (!is.null(grouping)) {
37+
message("Coloring by grouping")
38+
color_cells <- "grouping"
39+
} else if (!is.null(feature_oi)) {
40+
message("Coloring by expression")
41+
color_cells <- "feature"
42+
} else if (!is.null(milestones) | !is.null(milestone_percentages)) {
43+
message("Coloring by milestone")
44+
color_cells <- "milestone"
45+
} else if (!is.null(pseudotime)) {
46+
message("Coloring by pseudotime")
47+
color_cells <- "pseudotime"
48+
} else {
49+
color_cells <- "grey"
50+
}
51+
}
52+
if (color_cells == "grouping") {
53+
grouping <- get_grouping(trajectory, grouping)
54+
} else if (color_cells == "feature") {
55+
expression <- get_expression(trajectory, expression_source)
56+
check_feature(expression, feature_oi)
57+
} else if (color_cells == "milestone") {
58+
if (is.null(milestone_percentages)) {
59+
message("Using milestone_percentages from trajectory")
60+
milestone_percentages <- trajectory$milestone_percentages
61+
}
62+
# TODO more checks
63+
} else if (color_cells == "pseudotime") {
64+
pseudotime <- check_pseudotime(trajectory, pseudotime)
65+
cell_positions$pseudotime <- pseudotime[cell_positions$cell_id]
66+
}
67+
68+
# now create the actual coloring
69+
if (color_cells == "grouping") {
70+
groups <- check_groups(grouping, groups)
71+
72+
cell_positions$color <- grouping[match(cell_positions$cell_id, names(grouping))]
73+
74+
color_scale <- scale_color_manual(color_cells, values = set_names(groups$color, groups$group_id), guide = guide_legend(ncol = 5))
75+
fill_scale <- scale_fill_manual(color_cells, values = set_names(groups$color, groups$group_id), guide = guide_legend(ncol = 5))
76+
77+
} else if (color_cells == "feature") {
78+
cell_positions$color <- expression[cell_positions$cell_id, feature_oi]
79+
color_scale <- scale_color_distiller(paste0(feature_oi, " expression"), palette = "RdYlBu")
80+
fill_scale <- scale_fill_distiller(paste0(feature_oi, " expression"), palette = "RdYlBu")
81+
} else if (is_colour_vector(color_cells)) {
82+
cell_positions$color <- "trajectories_are_awesome"
83+
color_scale <- scale_color_manual(NULL, values = c("trajectories_are_awesome" = color_cells), guide = "none")
84+
fill_scale <- scale_fill_manual(NULL, values = c("trajectories_are_awesome" = color_cells), guide = "none")
85+
} else if (color_cells == "milestone") {
86+
if (is.null(milestones)) {
87+
assert_that(
88+
milestone_percentages$milestone_id %in% trajectory$milestone_ids,
89+
msg = "Not all milestones were found in milestones tibble. Supply milestones tibble if supplying milestone_percentages separately."
90+
)
91+
milestones <- tibble(milestone_id = trajectory$milestone_ids)
92+
}
93+
if (!"color" %in% names(milestones)) {
94+
milestones <- milestones %>% add_milestone_coloring(color_milestones)
95+
}
96+
97+
milestone_colors <- set_names(milestones$color, milestones$milestone_id) %>% col2rgb %>% t
98+
99+
cell_colors <-
100+
milestone_percentages %>%
101+
group_by(.data$cell_id) %>%
102+
summarise(color = mix_colors(.data$milestone_id, .data$percentage, milestone_colors))
103+
104+
cell_positions <- left_join(cell_positions, cell_colors, "cell_id")
105+
106+
color_scale <- scale_color_identity(NULL, guide = "none")
107+
fill_scale <- scale_fill_identity(NULL, guide = "none")
108+
} else if (color_cells == "pseudotime") {
109+
cell_positions$color <- cell_positions$pseudotime
110+
# color_scale <- viridis::scale_color_viridis("pseudotime")
111+
# fill_scale <- viridis::scale_fill_viridis("pseudotime")
112+
color_scale <- ggplot2::scale_color_viridis_c("pseudotime")
113+
fill_scale <- ggplot2::scale_fill_viridis_c("pseudotime")
114+
} else if (color_cells == "none") {
115+
cell_positions$color <- "black"
116+
color_scale <- scale_color_identity()
117+
fill_scale <- scale_fill_identity()
118+
}
119+
120+
lst(cell_positions, color_scale, fill_scale, color_cells)
121+
}
122+
)

‎R/add_coloring.R‎ renamed to ‎R/add_density_coloring.R‎

Lines changed: 3 additions & 157 deletions
Original file line numberDiff line numberDiff line change
@@ -1,156 +1,3 @@
1-
#' Add milestone coloring
2-
#' @param color_milestones How to color the cells
3-
#' @param milestones Tibble containing the `milestone_id` and a `color` for each milestone
4-
#'
5-
#' @include milestone_palette.R
6-
add_milestone_coloring <- function(
7-
milestones = NULL,
8-
color_milestones = c("auto", "given", get_milestone_palette_names())
9-
) {
10-
color_milestones <- match.arg(color_milestones)
11-
12-
if (color_milestones == "given") {
13-
if (!"color" %in% names(milestones)) {
14-
stop("Milestone colors need to be given")
15-
}
16-
} else if (color_milestones %in% get_milestone_palette_names()) {
17-
if (!(color_milestones == "auto" && "color" %in% names(milestones))) {
18-
milestones <- milestones %>%
19-
mutate(color = milestone_palette(color_milestones, n = n()))
20-
}
21-
}
22-
23-
milestones
24-
}
25-
formals(add_milestone_coloring)$color_milestones <- unique(c("auto", "given", get_milestone_palette_names()))
26-
27-
28-
#' @importFrom grDevices rgb
29-
mix_colors <- function(milid, milpct, milestone_colors) {
30-
color_rgb <- apply(milestone_colors[milid,,drop = FALSE], 2, function(x) sum(x * milpct))
31-
color_rgb[color_rgb < 0] <- 0
32-
color_rgb[color_rgb > 256] <- 256
33-
do.call(grDevices::rgb, as.list(c(color_rgb, maxColorValue = 256)))
34-
}
35-
36-
#' Add coloring
37-
#' @param cell_positions The positions of the cells
38-
#' @param color_cells How to color the cells
39-
#' @param trajectory The trajectory
40-
#' @param grouping The grouping of the cells
41-
#' @param groups Tibble containing information of the cell groups
42-
#' @param feature_oi feature to plot expression
43-
#' @param expression_source Source of the feature expression, defaults to `expression`
44-
#' @param pseudotime The pseudotime
45-
#' @param milestone_percentages The milestone percentages
46-
#'
47-
#' @inheritParams add_milestone_coloring
48-
add_cell_coloring <- dynutils::inherit_default_params(
49-
add_milestone_coloring,
50-
function(
51-
cell_positions,
52-
color_cells = c("auto", "none", "grouping", "feature", "milestone", "pseudotime"),
53-
trajectory,
54-
grouping = NULL,
55-
groups = NULL,
56-
feature_oi = NULL,
57-
expression_source = "expression",
58-
pseudotime = NULL,
59-
color_milestones = NULL,
60-
milestones = NULL,
61-
milestone_percentages = NULL
62-
) {
63-
# check cell coloration
64-
color_cells <- match.arg(color_cells)
65-
if (color_cells == "auto") {
66-
if (!is.null(grouping)) {
67-
message("Coloring by grouping")
68-
color_cells <- "grouping"
69-
} else if (!is.null(feature_oi)) {
70-
message("Coloring by expression")
71-
color_cells <- "feature"
72-
} else if (!is.null(milestones) | !is.null(milestone_percentages)) {
73-
message("Coloring by milestone")
74-
color_cells <- "milestone"
75-
} else if (!is.null(pseudotime)) {
76-
message("Coloring by pseudotime")
77-
color_cells <- "pseudotime"
78-
} else {
79-
color_cells <- "grey"
80-
}
81-
}
82-
if (color_cells == "grouping") {
83-
grouping <- get_grouping(trajectory, grouping)
84-
} else if (color_cells == "feature") {
85-
expression <- get_expression(trajectory, expression_source)
86-
check_feature(expression, feature_oi)
87-
} else if (color_cells == "milestone") {
88-
if (is.null(milestone_percentages)) {
89-
message("Using milestone_percentages from trajectory")
90-
milestone_percentages <- trajectory$milestone_percentages
91-
}
92-
# TODO more checks
93-
} else if (color_cells == "pseudotime") {
94-
pseudotime <- check_pseudotime(trajectory, pseudotime)
95-
cell_positions$pseudotime <- pseudotime[cell_positions$cell_id]
96-
}
97-
98-
# now create the actual coloring
99-
if (color_cells == "grouping") {
100-
groups <- check_groups(grouping, groups)
101-
102-
cell_positions$color <- grouping[match(cell_positions$cell_id, names(grouping))]
103-
104-
color_scale <- scale_color_manual(color_cells, values = set_names(groups$color, groups$group_id), guide = guide_legend(ncol = 5))
105-
fill_scale <- scale_fill_manual(color_cells, values = set_names(groups$color, groups$group_id), guide = guide_legend(ncol = 5))
106-
107-
} else if (color_cells == "feature") {
108-
cell_positions$color <- expression[cell_positions$cell_id, feature_oi]
109-
color_scale <- scale_color_distiller(paste0(feature_oi, " expression"), palette = "RdYlBu")
110-
fill_scale <- scale_fill_distiller(paste0(feature_oi, " expression"), palette = "RdYlBu")
111-
} else if (is_colour_vector(color_cells)) {
112-
cell_positions$color <- "trajectories_are_awesome"
113-
color_scale <- scale_color_manual(NULL, values = c("trajectories_are_awesome" = color_cells), guide = "none")
114-
fill_scale <- scale_fill_manual(NULL, values = c("trajectories_are_awesome" = color_cells), guide = "none")
115-
} else if (color_cells == "milestone") {
116-
if (is.null(milestones)) {
117-
assert_that(
118-
milestone_percentages$milestone_id %in% trajectory$milestone_ids,
119-
msg = "Not all milestones were found in milestones tibble. Supply milestones tibble if supplying milestone_percentages separately."
120-
)
121-
milestones <- tibble(milestone_id = trajectory$milestone_ids)
122-
}
123-
if (!"color" %in% names(milestones)) {
124-
milestones <- milestones %>% add_milestone_coloring(color_milestones)
125-
}
126-
127-
milestone_colors <- set_names(milestones$color, milestones$milestone_id) %>% col2rgb %>% t
128-
129-
cell_colors <-
130-
milestone_percentages %>%
131-
group_by(.data$cell_id) %>%
132-
summarise(color = mix_colors(.data$milestone_id, .data$percentage, milestone_colors))
133-
134-
cell_positions <- left_join(cell_positions, cell_colors, "cell_id")
135-
136-
color_scale <- scale_color_identity(NULL, guide = "none")
137-
fill_scale <- scale_fill_identity(NULL, guide = "none")
138-
} else if (color_cells == "pseudotime") {
139-
cell_positions$color <- cell_positions$pseudotime
140-
# color_scale <- viridis::scale_color_viridis("pseudotime")
141-
# fill_scale <- viridis::scale_fill_viridis("pseudotime")
142-
color_scale <- ggplot2::scale_color_viridis_c("pseudotime")
143-
fill_scale <- ggplot2::scale_fill_viridis_c("pseudotime")
144-
} else if (color_cells == "none") {
145-
cell_positions$color <- "black"
146-
color_scale <- scale_color_identity()
147-
fill_scale <- scale_fill_identity()
148-
}
149-
150-
lst(cell_positions, color_scale, fill_scale, color_cells)
151-
}
152-
)
153-
1541
#' Color cells using a background density
1552
#'
1563
#' @param cell_positions The positions of the cells in 2D
@@ -244,9 +91,9 @@ add_density_coloring <- function(
24491

24592
# find closest empty position to put label
24693
group_label_positions <- crossing(
247-
centers %>% rename_if(is.numeric, ~paste0(., "_center")),
248-
blank_space
249-
) %>%
94+
centers %>% rename_if(is.numeric, ~paste0(., "_center")),
95+
blank_space
96+
) %>%
25097
mutate(
25198
distance = sqrt((.data$comp_1_center - .data$comp_1)**2 + abs(.data$comp_2_center - .data$comp_2)**2)
25299
) %>%
@@ -314,7 +161,6 @@ add_density_coloring <- function(
314161
density_plots
315162
}
316163

317-
318164
smooth_2d <- function(x, y, h, e, n, lims) {
319165
# create points
320166
gx <- seq(lims[1], lims[2], length = n)

0 commit comments

Comments
 (0)