Skip to content

Commit

Permalink
fix the bugs on exposure plot function
Browse files Browse the repository at this point in the history
  • Loading branch information
Azad Sadr committed Jul 8, 2024
1 parent fcb76e2 commit 9d33da1
Show file tree
Hide file tree
Showing 2 changed files with 113 additions and 58 deletions.
154 changes: 103 additions & 51 deletions R/plot_exposures.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,9 @@ plot_exposures = function(x,
color_palette=NULL,
add_centroid=FALSE,
sort_by=NULL,
min_exposure=0) {
min_exposure=0,
quantile_thr=0) {


exposures = lapply(types, function(t)
get_exposure(x, types=types, samples=samples,
Expand All @@ -32,37 +34,68 @@ plot_exposures = function(x,
do.call(rbind, .)

if (is.null(color_palette)) cls = gen_palette(x, types=sort(types))

sigs_levels <- NULL

if ( min_exposure > 0 & quantile_thr == 0 ) {
# # merging signatures where their exposure in all the samples are below the threshold
max_exposures = tapply(exposures$value, exposures$sigs, max)
to_remove = exposures$sigs[exposures$sigs %in% (max_exposures[max_exposures < min_exposure] %>% names)] %>% unique()
to_keep = setdiff(names(cls), to_remove)
exposures <- exposures %>% subset(sigs %in% to_keep)
sigs_levels <- c(to_keep, "Others")
# cls[to_remove] = grDevices::gray.colors(n=length(to_remove), start=0.5, end=0.9) %>% sample()
} else if (min_exposure > 0 || quantile_thr > 0) {
scores <- get_clusters_score(
x, types=types, min_exposure=min_exposure, quantile_thr=quantile_thr) %>%
dplyr::rename("sigs"="signature", "samples"="cluster")

# merge two dataframe
merged = merge(
exposures,
scores[, c("sigs", "samples", "score", "significance", "type")],
by.x=c('sigs', 'clusters', 'type'),
by.y=c('sigs', 'samples', 'type')
)

merged <- merged %>% dplyr::mutate(signature = dplyr::case_when(!significance ~ "Others", .default=sigs))
merged <- merged[, c("samples", "signature", "value", "clusters", "type", "score", "significance")]
merged <- merged %>% dplyr::rename("sigs"="signature")
exposures <- merged

to_keep <- exposures %>% subset(significance) %>% dplyr::pull(sigs) %>% unique
cls <- NULL
if (is.null(cls)) cls = gen_palette(x, types=types)
cls <- cls[ to_keep ]
cls["Others"] = "gainsboro"
sigs_levels <- c(to_keep, "Others")
}

# # merging signatures where their exposure in all the samples are below the threshold
max_exposures = tapply(exposures$value, exposures$sigs, max)
to_remove = exposures$sigs[exposures$sigs %in% (max_exposures[max_exposures < min_exposure] %>% names)] %>% unique()
to_keep = setdiff(names(cls), to_remove)
# cls[to_remove] = grDevices::gray.colors(n=length(to_remove), start=0.5, end=0.9) %>% sample()

exposures = exposures %>% dplyr::mutate(sigs=dplyr::case_when(sigs %in% to_remove ~ "Other", .default=sigs))
cls["Other"] = "gainsboro"

p = plot_exposures_aux(exposures=exposures, cls=cls,
titlee="Exposure",
sample_name=sample_name,
sort_by=sort_by,
sigs_levels=c(to_keep, "Other")) +
scale_fill_manual(values=cls, breaks=c(to_keep, "Other"))

p_centr = plot_centroids(x,
types=types,
cls=cls,
sort_by=sort_by,
exposure_thr=min_exposure, quantile_thr=0,
sigs_levels=c(to_keep, "Other")) +
scale_fill_manual(values=cls, breaks=c(to_keep, "Other"))
p = plot_exposures_aux(
exposures=exposures,
cls=cls,
titlee="Exposure",
sample_name=sample_name,
sort_by=sort_by,
sigs_levels=sigs_levels) +
scale_fill_manual(values=cls, breaks=sigs_levels)

p_centr = plot_centroids(
x,
types=types,
cls=cls,
sort_by=sort_by,
min_exposure=min_exposure, quantile_thr=quantile_thr,
sigs_levels=sigs_levels
) + scale_fill_manual(values=cls, breaks=sigs_levels)

if (add_centroid)
p = patchwork::wrap_plots(p, p_centr, ncol=2, widths=c(9,1), guides="collect")

return(p)
}

#-------------------------------------------------------------------------------

match_type = function(types, sigs) {
sapply(sigs, function(sid) {
Expand All @@ -73,44 +106,63 @@ match_type = function(types, sigs) {
}) %>% setNames(NULL)
}


plot_centroids = function(x,
types=get_types(x),
cls=NULL,
sort_by=NULL,
exposure_thr=0,
quantile_thr=0, ...) {

centr = get_centroids(x)
#-------------------------------------------------------------------------------

plot_centroids = function(
x,
types = get_types(x),
cls = NULL,
sort_by = NULL,
min_exposure = 0,
quantile_thr = 0,
...
) {

centr0 = get_centroids(x)

if ("sigs_levels" %in% names(list(...)))
sigs_levels = list(...)$sigs_levels else sigs_levels = NULL

if (!have_groups(x) || is.null(centr)) return(NULL)
a_pr = centr %>%
dplyr::mutate(type=match_type(types, sigs)) %>%
dplyr::filter(!is.na(type)) %>%
if (!have_groups(x) || is.null(centr0)) return(NULL)

centr = centr0 %>%
dplyr::mutate(type=match_type(types, sigs)) %>%
dplyr::filter(!is.na(type)) %>%
dplyr::rename(samples=clusters)

if (is.null(cls)) cls = gen_palette(x, types=sort(types))


# Just plot significant signatures in each cluster [concise=TRUE]
to_keep = a_pr$sigs %>% unique()
if (exposure_thr > 0 | quantile_thr > 0) {
scores = get_clusters_score(x, types=types, exposure_thr=exposure_thr,
quantile_thr=quantile_thr) %>%
to_keep = centr$sigs %>% unique()

if (min_exposure > 0 || quantile_thr > 0) {
scores = get_clusters_score(
x, types=types, min_exposure=min_exposure, quantile_thr=quantile_thr) %>%
dplyr::rename("sigs"="signature", "samples"="cluster")

to_keep = scores %>% dplyr::filter(significance) %>% dplyr::pull(sigs) %>% unique() %>% as.character()
to_remove = setdiff(names(cls), to_keep)
# cls[to_remove] = grDevices::gray.colors(n=length(to_remove), start=0.5, end=0.9) %>% sample()
sigs_levels = c(to_keep, "Other")

a_pr = a_pr %>% dplyr::mutate(sigs=dplyr::case_when(sigs %in% to_remove ~ "Other", .default=sigs))
cls["Other"] = "gainsboro"

# merge two dataframe
merged = merge(
centr,
scores[, c("sigs", "samples", "score", "significance", "type")],
by.x=c('sigs', 'samples', 'type'),
by.y=c('sigs', 'samples', 'type')
)

merged <- merged %>% dplyr::mutate(signature = dplyr::case_when(!significance ~ "Others", .default=sigs))
merged <- merged[, c("signature", "samples", "value", "score", "type", "significance")]
merged <- merged %>% dplyr::rename("sigs"="signature")
centr <- merged

to_keep <- centr %>% subset(significance) %>% dplyr::pull(sigs) %>% unique
cls <- NULL
if (is.null(cls)) cls = gen_palette(x, types=types)
cls <- cls[ to_keep ]
cls["Others"] = "gainsboro"
}

return(
plot_exposures_aux(exposures=a_pr,
plot_exposures_aux(exposures=centr,
cls=cls,
titlee="Centroids",
sample_name=TRUE,
Expand Down
17 changes: 10 additions & 7 deletions R/utils_cls_analysis.R
View file
Original file line number Diff line number Diff line change
@@ -1,23 +1,26 @@


get_clusters_score = function(x, types=get_types(x), exposure_thr=0.05, quantile_thr=0.9) {
get_clusters_score = function(x, types=get_types(x), min_exposure=0.05, quantile_thr=0.9) {
return(
lapply(
types,
function(tid)
get_clusters_score_aux(x, type=tid,
exposure_thr=exposure_thr,
min_exposure=min_exposure,
quantile_thr=quantile_thr) %>%
dplyr::mutate(type=tid)) %>%
do.call(rbind, .) %>% dplyr::filter(!is.na(type))
)
}


get_clusters_score_aux = function(x, type, exposure_thr, quantile_thr) {
exposures = get_exposure(x, types=type, matrix=FALSE, add_groups=TRUE)[[type]] #%>% subset(value > exposure_thr)
#-------------------------------------------------------------------------------


get_clusters_score_aux = function(x, type, min_exposure, quantile_thr) {
exposures = get_exposure(x, types=type, matrix=FALSE, add_groups=TRUE)[[type]] #%>% subset(value > min_exposure)
exposures = exposures %>% dplyr::group_by(sigs) %>%
dplyr::filter(any(value > exposure_thr))
dplyr::filter(any(value > min_exposure))
df = data.frame(signature=c(), cluster=c(), varRatio=c(), activeRatio=c(), mutRatio=c(), score=c())

if (nrow(exposures) == 0) return(df)
Expand All @@ -39,7 +42,7 @@ get_clusters_score_aux = function(x, type, exposure_thr, quantile_thr) {
}

# samples with active signature / all samples
num_one = exposures %>% subset(clusters == cls & sigs == signature & value > exposure_thr, select=c("samples")) %>% unique() %>% nrow()
num_one = exposures %>% subset(clusters == cls & sigs == signature & value > min_exposure, select=c("samples")) %>% unique() %>% nrow()
num_all = exposures %>% subset(clusters == cls, select=c("samples")) %>% unique() %>% nrow()
ratio_active = num_one / num_all

Expand Down Expand Up @@ -92,7 +95,7 @@ get_clusters_score_aux = function(x, type, exposure_thr, quantile_thr) {
}
) %>% do.call(rbind, .)

df1 = df1 %>% dplyr::mutate(significance = score >= score_quantile)
df1 = df1 %>% dplyr::mutate( significance = (score >= score_quantile) )

return(df1)
}
Expand Down

0 comments on commit 9d33da1

Please sign in to comment.