#' Helps identifying parameters for scRT analysis. It opens a shiny app
#'
#' @return list
#'
#' @importFrom tidyr %>%
#' @importFrom foreach foreach %:% %dopar%
#' @importFrom dplyr filter select tibble case_when mutate pull
#' @importFrom shinyjs disable enable extendShinyjs useShinyjs
#' @importFrom shiny actionButton brushOpts column div fluidPage fluidRow h4 htmlOutput isolate observe observeEvent onSessionEnded plotOutput radioButtons reactive reactiveValues renderPlot renderText runApp sliderInput stopApp tabPanel tabsetPanel updateSliderInput updateTabsetPanel
#' @importFrom shinybusy add_busy_spinner hide_spinner show_spinner
#' @importFrom ggplot2 aes element_blank geom_density geom_point geom_vline ggplot scale_color_manual theme theme_bw theme_set xlab ylab
#' @importFrom doSNOW registerDoSNOW
#' @importFrom snow stopCluster clusterApply
#' @importFrom shinybusy add_busy_spinner show_spinner hide_spinner
#' @importFrom LaplacesDemon is.unimodal
#'
#' @param PerCell, per cell dataframe from CallCNV
#' @param interactive, if TRUE the function will start a shiny app
#' @param min_RPMPH, min number of reads per megabase per haplotype for a cell to be considered
#' @param G1G2_th, variability value under which cells are considered in G1/G2
#' @param S_th, variability value above which cells are considered in S
#' @param First_half_factor, parameter to adjust the first part of the S-phase
#' @param Second_half_factor, parameter to adjust the second part of the S-phase
#' @param Automatic_correction, If TRUE it tries to automatically find the parameters to adjust the S-phase
#' @param lunch.in.Rstudio, if TRUE the shiny app is run in Rstudio otherwise on a browser.
#' @param cores, number of cores to parallelise
#'
#' @export
diagnostic = function(PerCell,
interactive = T,
min_RPMPH = 160,
G1G2_th = NULL,
S_th = NULL,
First_half_factor = NULL,
Second_half_factor = NULL,
Automatic_correction = F,
lunch.in.Rstudio = F,
cores = 1) {
#set theme for plots
ggplot2::theme_set(new = ggplot2::theme_bw())
# the user can chose whether to use an interactive shiny app or not
if (interactive) {
if (lunch.in.Rstudio) {
lunch.in.Rstudio = rstudioapi::viewer
} else{
lunch.in.Rstudio = T
}
#java function to close this app
jscode <- "shinyjs.closeWindow = function() { window.close(); }"
results = shiny::runApp(list(
ui = shiny::fluidPage(
#setting spinner
shinybusy::add_busy_spinner(
spin = "fading-circle",
position = 'bottom-right',
color = 'blue',
height = '200px',
width = '200px'
),
shinyjs::useShinyjs(),
#to close window
shinyjs::extendShinyjs(text = jscode, functions = c("closeWindow")),
shiny::tabsetPanel(
id = 'Diagnostic_tab',
shiny::tabPanel(
title = 'Setting RPMH and define G1/G2- S-phase populations',
align = 'center',
shiny::fluidRow(
shiny::column(width = 6,
plotOutput('plot__diagnostic')),
shiny::column(
width = 6,
plotOutput(
'plot2__diagnostic',
brush = shiny::brushOpts(id = "plot2_brush__diagnostic",
direction = 'y')
)
)
),
shiny::fluidRow(
shiny::sliderInput(
inputId = 'min_n_reads__diagnostic',
label = 'Reads per Mb per Haplotype',
min = 50,
max = 300,
value = 160,
width = '100%'
),
shiny::tags$div(
class = "header",
checked = NA,
tags$h4(
"To modify the S- and G1/G2- phase definition draw a line or a box between the two on the right plot."
)
),
radioButtons(
inputId = 'Auto__diagnostic',
choices = c('Auto', 'Manual'),
label = 'S-phase correction',
inline = T,
selected = 'Auto',
width = '25%'
),
shiny::actionButton(
inputId = 'CleanStaging__diagnostic',
label = 'Clean',
width = '25%'
),
shiny::actionButton(
inputId = 'Apply__diagnostic',
label = 'Apply',
width = '25%'
)
)
),
shiny::tabPanel(
title = 'Fix S-phase progression',
align = 'center',
shiny::fluidRow(
shiny::column(width = 6,
plotOutput('plot3__diagnostic')),
shiny::column(width = 6,
plotOutput('plot4__diagnostic'))
),
shiny::fluidRow(
shiny::column(
width = 6,
shiny::htmlOutput('parameters_text__diagnostic'),
shiny::sliderInput(
inputId = 'First_p_S__diagnostic',
label = 'Parameter fist part of the S phase',
min = 0.3,
max = 1.7,
step = 0.001,
value = 1,
width = '100%'
),
shiny::sliderInput(
inputId = 'Second_p_S__diagnostic',
label = 'Parameter second part of the S phase',
min = 0.3,
max = 1.7,
step = 0.001,
value = 1,
width = '100%'
),
shiny::actionButton(inputId = 'Reset_Correction__diagnostic',
'Reset',
width = '50%'),
shiny::actionButton(inputId = 'Apply_Correction__diagnostic',
'Done',
width = '50%')
),
shiny::column(width = 6,
plotOutput('plot5__diagnostic'))
)
)
)
),
server = function(input,
output,
session) {
#stop app when the session ends
session$onSessionEnded(function() {
shiny::stopApp()
})
#load required operators
`%>%` = tidyr::`%>%`
`%dopar%` = foreach::`%dopar%`
`%:%` = foreach::`%:%`
#initialize
R_df = shiny::reactiveValues(result = dplyr::tibble(),
PerCell = PerCell)
plots = shiny::reactiveValues()
shiny::observe({
#calculate median ploidy of the suppose G1
median_ploidy_not_noisy__diagnostic = R_df$PerCell %>%
dplyr::filter(is_noisy == F, is_high_dimapd == F) %>%
dplyr::pull(mean_ploidy) %>% stats::median()
#disable buttons
shinyjs::disable('First_p_S__diagnostic')
shinyjs::disable('Second_p_S__diagnostic')
shinyjs::disable('Reset_Correction__diagnostic')
shinyjs::disable('Apply_Correction__diagnostic')
if (is.numeric(input$min_n_reads__diagnostic)) {
#prepare df
R_df$PerCell = R_df$PerCell %>%
dplyr::mutate(
Type = dplyr::case_when(
as.logical(is_high_dimapd) == T &
as.logical(is_noisy) == T ~ 'S-phase cells',
as.logical(is_high_dimapd) == F &
as.logical(is_noisy) == T ~ 'unknown cells',
T ~ 'G1/G2-phase cells'
),
Type = dplyr::case_when(
coverage_per_1Mbp < input$min_n_reads__diagnostic * median_ploidy_not_noisy__diagnostic ~ 'Low Coverage',
ploidy_confidence < 2 &
ploidy_confidence != -100 ~ 'Low ploidy confidence',
mean_ploidy < median_ploidy_not_noisy__diagnostic / 1.5 ~ 'Too low ploidy compared to G1/G2-phase pool',
mean_ploidy > median_ploidy_not_noisy__diagnostic * 2 ~ 'Too high ploidy compared to G1/G2-phase pool',
T ~ Type
)
)
#select potentially suitable cells
R_df$PerCell_subset = R_df$PerCell %>%
dplyr::filter(
Type %in% c(
'S-phase cells',
'G1/G2-phase cells',
'Too low ploidy compared to G1/G2-phase pool',
'Too high ploidy compared to G1/G2-phase pool'
)
) %>%
dplyr::mutate(Type_mem = Type)
}
# first plot
plots$plot__diagnostic = shiny::reactive({
R_df$PerCell %>%
ggplot2::ggplot(ggplot2::aes(mean_ploidy,
normalized_dimapd,
color = Type)) +
ggplot2::geom_point(alpha = 0.3) +
ggplot2::scale_color_manual(
values = c(
'Low Coverage' = "#ff7949",
'Low ploidy confidence' = "#70001e",
'Too low ploidy compared to G1/G2-phase pool' = "#01e7ab",
'Too high ploidy compared to G1/G2-phase pool' = "#a7001b",
'G1/G2-phase cells' = "#005095",
'S-phase cells' = "#78bd3e",
'unknown cells' = "#dfbd31"
)
) +
ggplot2::theme(legend.position = 'top',
legend.title = ggplot2::element_blank()) +
ggplot2::xlab('Ploidy') + ggplot2::ylab('Variability')
})
output$plot__diagnostic <-
shiny::renderPlot({
plots$plot__diagnostic()
})
})
#calculate new median ploidy after brush selection
shiny::observeEvent(input$plot2_brush__diagnostic, {
if (!(
is.null(input$plot2_brush__diagnostic) |
is.numeric(input$plot2_brush__diagnostic)
)) {
R_df$median_ploidy_not_noisy_2__diagnostic = stats::median(
R_df$PerCell_subset %>% dplyr::filter(Type ==
'G1/G2-phase cells') %>% dplyr::pull(mean_ploidy)
)
#reassign cells based on new median ploidy
R_df$PerCell_subset = R_df$PerCell_subset %>%
dplyr::mutate(
Type = dplyr::case_when(
mean_ploidy < R_df$median_ploidy_not_noisy_2__diagnostic / 1.5 ~ 'Too low ploidy compared to G1/G2-phase pool',
mean_ploidy > R_df$median_ploidy_not_noisy_2__diagnostic * 2 ~ 'Too high ploidy compared to G1/G2-phase pool',
normalized_dimapd > input$plot2_brush__diagnostic$ymax ~ 'S-phase cells',
normalized_dimapd < input$plot2_brush__diagnostic$ymin &
!is_noisy ~
'G1/G2-phase cells',
T ~ 'unknown cells'
)
)
#save thresholds
S_th = input$plot2_brush__diagnostic$ymax
G1G2_th = input$plot2_brush__diagnostic$ymin
}
})
#reset S/G1G2 th
shiny::observeEvent(input$CleanStaging__diagnostic, {
R_df$PerCell_subset = R_df$PerCell_subset %>%
mutate(Type = Type_mem)
})
plots$plot2__diagnostic = shiny::reactive({
R_df$PerCell_subset %>%
ggplot2::ggplot(ggplot2::aes(mean_ploidy,
normalized_dimapd,
color = Type)) +
ggplot2::geom_point(alpha = 0.3) +
ggplot2::scale_color_manual(
values = c(
'G1/G2-phase cells' = "#005095",
'S-phase cells' = "#78bd3e",
'unknown cells' = "#dfbd31",
'Too low ploidy compared to G1/G2-phase pool' = "#01e7ab",
'Too high ploidy compared to G1/G2-phase pool' = "#a7001b"
)
) +
ggplot2::theme(legend.position = 'top',
legend.title = ggplot2::element_blank()) +
ggplot2::xlab('Ploidy') + ggplot2::ylab('Variability')
})
output$plot2__diagnostic <-
shiny::renderPlot({
plots$plot2__diagnostic()
})
shiny::observeEvent(input$Apply__diagnostic, {
shinyjs::disable('min_n_reads__diagnostic')
shinyjs::disable('Auto__diagnostic')
shinyjs::disable('CleanStaging__diagnostic')
shinyjs::disable('Apply__diagnostic')
shinyjs::enable('First_p_S__diagnostic')
shinyjs::enable('Second_p_S__diagnostic')
shinyjs::enable('Reset_Correction__diagnostic')
shinyjs::enable('Apply_Correction__diagnostic')
#start spinner
shinybusy::show_spinner()
#adjust S-phase
R_df$PerCell_subset_2 = R_df$PerCell_subset %>%
dplyr::mutate(
is_high_dimapd = ifelse(Type == 'S-phase cells', T, F),
is_noisy = ifelse(is_high_dimapd, T, is_noisy)
) %>%
dplyr::filter(Type %in% c('G1/G2-phase cells', 'S-phase cells'))
R_df$median_ploidy_not_noisy_3__diagnostic = stats::median(
R_df$PerCell_subset_2 %>% dplyr::filter(Type ==
'G1/G2-phase cells') %>% dplyr::pull(mean_ploidy)
)
plots$plot3__diagnostic <-
shiny::reactive({
R_df$PerCell_subset_2 %>%
ggplot2::ggplot(ggplot2::aes(mean_ploidy, normalized_dimapd, color = Type)) +
ggplot2::geom_point(alpha = 0.3) +
ggplot2::scale_color_manual(
values = c(
'Low Coverage' = "#ff7949",
'Low ploidy confidence' = "#70001e",
'Too low ploidy compared to G1/G2' = "#01e7ab",
'Too high ploidy compared to G1/G2' = "#a7001b",
'G1/G2-phase cells' = "#005095",
'S-phase cells' = "#78bd3e",
'unknown cells' = "#dfbd31"
)
) +
ggplot2::geom_vline(xintercept = R_df$median_ploidy_not_noisy_3__diagnostic) +
ggplot2::theme(legend.position = 'top',
legend.title = ggplot2::element_blank()) +
ggplot2::xlab('Ploidy') + ggplot2::ylab('Variability')
})
output$plot3__diagnostic <-
shiny::renderPlot({
plots$plot3__diagnostic()
})
if (input$Auto__diagnostic == 'Auto') {
shiny::isolate({
isolated_PerCell_subset_2 <- R_df$PerCell_subset_2
isolated_median_ploidy_not_noisy_3__diagnostic =
R_df$median_ploidy_not_noisy_3__diagnostic
})
# correct mean ploidy
cl = snow::makeCluster(cores)
doSNOW::registerDoSNOW(cl)
on.exit(snow::stopCluster(cl))
# test multiple parameters to correct S phase
R_df$distributions = foreach::foreach(a = seq(0.95, 1, by = 0.001),
.combine = 'rbind') %:%
foreach::foreach(b = seq(0.5, 0.55, by = 0.001),
.combine = 'rbind') %dopar% {
#load operators
`%>%` = tidyr::`%>%`
#adjust S-phase based on a and b
x = isolated_PerCell_subset_2 %>%
dplyr::filter(Type == 'S-phase cells') %>%
dplyr::mutate(
corrected_mean_ploidy = ifelse(
mean_ploidy >= isolated_median_ploidy_not_noisy_3__diagnostic,
mean_ploidy / a,
mean_ploidy / b
)
) %>%
dplyr::select(corrected_mean_ploidy) %>%
dplyr::pull()
# are the data unimodal?
if (LaplacesDemon::is.unimodal(x)) {
# d is the distance between theoretical center of the S phase (G1 median ploidy *1.5)
#and the average ploidy of the corrected S-phase
# d is divided by sd(x) in order to select parameters that keep the distribution as wide as possible
dplyr::tibble(
A = a,
B = b,
d = 1 / stats::sd(x),
unimodal = T
)
} else{
dplyr::tibble(
A = a,
B = b,
d = stats::sd(x),
unimodal = F
)
}
}
} else{
R_df$distributions = dplyr::tibble()
}
#select the minimum value of d
if (nrow(R_df$distributions) == 0) {
output$parameters_text__diagnosc = renderText('Please provide manual ones')
R_df$PerCell_corrected = R_df$PerCell_subset_2 %>% dplyr::mutate(
mean_ploidy_corrected = mean_ploidy,
Type = dplyr::case_when(
Type == 'S-phase cells' &
mean_ploidy < R_df$median_ploidy_not_noisy_3__diagnostic ~ 'Second-part-S-phase cells',
Type == 'S-phase cells' &
mean_ploidy > R_df$median_ploidy_not_noisy_3__diagnostic ~ 'First-part-S-phase cells',
T ~ Type
),
mean_ploidy_corrected_bu = mean_ploidy_corrected
)
} else{
R_df$distributions = R_df$distributions %>%
dplyr::filter(unimodal == ifelse(any(unimodal == T), T, F)) %>%
dplyr::filter(d == min(d))
if (nrow(R_df$distributions) > 1) {
R_df$PerCell_corrected = R_df$PerCell_subset_2 %>%
dplyr::mutate(
mean_ploidy_corrected = mean_ploidy,
Type = dplyr::case_when(
Type == 'S-phase cells' &
mean_ploidy < R_df$median_ploidy_not_noisy_3__diagnostic ~ 'Second-part-S-phase cells',
Type == 'S-phase cells' &
mean_ploidy > R_df$median_ploidy_not_noisy_3__diagnostic ~ 'First-part-S-phase cells',
T ~ Type
),
mean_ploidy_corrected_bu = mean_ploidy_corrected
)
output$parameters_text__diagnostic = renderText(
'S phase correction parameters could not be established, please provide manual ones.'
)
} else{
output$parameters_text__diagnostic = renderText(
paste(
'S phase correction parameters have been estimated.\n',
'Parameter first part S phase: ',
R_df$distributions$A,
'\n',
'Parameter Second part S phase: ',
R_df$distributions$B
)
)
#save parameters
shiny::updateSliderInput(
session,
"First_p_S__diagnostic",
value = R_df$distributions$A,
min = 0.3,
max = 1.7,
step = 0.001
)
shiny::updateSliderInput(
session,
"Second_p_S__diagnostic",
value = R_df$distributions$B,
min = 0.3,
max = 1.7,
step = 0.001
)
R_df$firstpart_S = R_df$distributions$A
R_df$secondpart_S = R_df$distributions$B
#correct
R_df$PerCell_corrected = R_df$PerCell_subset_2 %>%
dplyr::mutate(
mean_ploidy_corrected = dplyr::case_when(
Type == 'S-phase cells' &
mean_ploidy < R_df$median_ploidy_not_noisy_3__diagnostic ~ mean_ploidy / R_df$distributions$B,
Type == 'S-phase cells' &
mean_ploidy > R_df$median_ploidy_not_noisy_3__diagnostic ~ mean_ploidy / R_df$distributions$A,
T ~ mean_ploidy
),
Type = dplyr::case_when(
Type == 'S-phase cells' &
mean_ploidy < R_df$median_ploidy_not_noisy_3__diagnostic ~ 'Second-part-S-phase cells',
Type == 'S-phase cells' &
mean_ploidy > R_df$median_ploidy_not_noisy_3__diagnostic ~ 'First-part-S-phase cells',
T ~ Type
),
mean_ploidy_corrected_bu = mean_ploidy_corrected
)
}
}
#stop spinner
shinybusy::hide_spinner()
#change page
shiny::updateTabsetPanel(session = session,
"Diagnostic_tab",
selected = 'Fix S-phase progression')
#sliders
# manual correction
shiny::observeEvent(input$First_p_S__diagnostic,
{
R_df$PerCell_corrected = R_df$PerCell_corrected %>% dplyr::mutate(
mean_ploidy_corrected = dplyr::case_when(
Type == 'First-part-S-phase cells' ~ mean_ploidy / input$First_p_S__diagnostic,
T ~ mean_ploidy_corrected
)
)
R_df$firstpart_S = input$First_p_S__diagnostic
})
shiny::observeEvent(input$Second_p_S__diagnostic,
{
R_df$PerCell_corrected = R_df$PerCell_corrected %>% dplyr::mutate(
mean_ploidy_corrected = dplyr::case_when(
Type == 'Second-part-S-phase cells' ~ mean_ploidy / as.numeric(input$Second_p_S__diagnostic),
T ~ mean_ploidy_corrected
)
)
R_df$secondpart_S = input$Second_p_S__diagnostic
})
#plot corrected data
plots$plot4__diagnostic <-
shiny::reactive({
R_df$PerCell_corrected %>%
ggplot2::ggplot(ggplot2::aes(mean_ploidy_corrected,
normalized_dimapd,
color = Type)) +
ggplot2::geom_point(alpha = 0.3) +
ggplot2::scale_color_manual(
values = c(
'G1/G2-phase cells' = '#005095',
'First-part-S-phase cells' = '#78bd3e',
'Second-part-S-phase cells' = '#83007e',
'unknown cells' = '#dfbd31'
)
) +
ggplot2::geom_vline(xintercept = R_df$median_ploidy_not_noisy_3__diagnostic) +
ggplot2::theme(legend.position = 'top',
legend.title = ggplot2::element_blank()) +
ggplot2::xlab('Ploidy') + ggplot2::ylab('Variability')
})
output$plot4__diagnostic <-
shiny::renderPlot({
plots$plot4__diagnostic()
})
#plot density
plots$plot5__diagnostic <-
shiny::reactive({
R_df$PerCell_corrected %>% dplyr::filter(Type %in% c(
'Second-part-S-phase cells',
'First-part-S-phase cells'
)) %>%
ggplot2::ggplot() +
ggplot2::geom_density(ggplot2::aes(x = mean_ploidy_corrected, y = (..density..)),
color = "black") +
ggplot2::xlab('Ploidy') + ggplot2::ylab('Variability')
})
output$plot5__diagnostic <-
shiny::renderPlot({
plots$plot5__diagnostic()
})
})
shiny::observeEvent(input$Reset_Correction__diagnostic,
{
R_df$PerCell_corrected = R_df$PerCell_corrected %>%
dplyr::mutate(mean_ploidy_corrected = mean_ploidy_corrected_bu)
if (nrow(R_df$distributions) == 1) {
R_df$firstpart_S = R_df$distributions$A
R_df$secondpart_S = R_df$distributions$B
} else{
R_df$firstpart_S = 1
R_df$secondpart_S = 1
}
shiny::updateSliderInput(
session,
"First_p_S__diagnostic",
value = R_df$firstpart_S,
min = 0.3,
max = 1.7,
step = 0.001
)
shiny::updateSliderInput(
session,
"Second_p_S__diagnostic",
value = R_df$secondpart_S,
min = 0.3,
max = 1.7,
step = 0.001
)
})
shiny::observeEvent(input$Apply_Correction__diagnostic, {
#save setting file
if (!is.numeric(input$plot2_brush__diagnostic)) {
S_th = input$plot2_brush__diagnostic$ymax
G_th = input$plot2_brush__diagnostic$ymin
} else{
S_th = NULL
G_th = NULL
}
R_df$setting = dplyr::tibble(
threshold_Sphase = ifelse(is.null(S_th), NA, S_th),
threshold_G1G2phase = ifelse(is.null(G_th), NA, G_th),
Sphase_first_part = R_df$firstpart_S,
Sphase_second_part = R_df$secondpart_S,
Ploidy = R_df$median_ploidy_not_noisy_3__diagnostic,
RPMPH_TH = input$min_n_reads__diagnostic,
RPM_TH = round(
input$min_n_reads__diagnostic * R_df$median_ploidy_not_noisy_3__diagnostic
),
basename = unique(R_df$PerCell_corrected$basename),
group = unique(R_df$PerCell_corrected$group)
)
#close window
shinyjs::js$closeWindow()
#return all
shiny::stopApp(
returnValue = list(
Settings = R_df$setting,
all_cells_plot = plots$plot__diagnostic(),
first_filtering_plot = plots$plot2__diagnostic(),
selected_G1_S_cells_plot = plots$plot3__diagnostic(),
fixed_S_phase_plot = plots$plot4__diagnostic(),
S_phase_cell_distribution_plot = plots$plot5__diagnostic()
)
)
})
}
),
launch.browser = lunch.in.Rstudio)
} else{
#define results list
results = list(
Settings = dplyr::tibble(
threshold_Sphase = ifelse(is.null(S_th), NA, S_th),
threshold_G1G2phase = ifelse(is.null(G1G2_th), NA, G1G2_th),
Sphase_first_part = ifelse(is.null(First_half_factor), 1, First_half_factor),
Sphase_second_part = ifelse(is.null(Second_half_factor), 1, Second_half_factor),
Ploidy = NA,
RPMPH_TH = min_RPMPH,
RPM_TH = NA,
basename = unique(PerCell$basename),
group = unique(PerCell$group)
),
all_cells_plot = NA,
first_filtering_plot = NA,
selected_G1_S_cells_plot = NA,
fixed_S_phase_plot = NA,
S_phase_cell_distribution_plot = NA
)
#load required operators
`%>%` = tidyr::`%>%`
`%dopar%` = foreach::`%dopar%`
`%:%` = foreach::`%:%`
if (!is.null(G1G2_th) | !is.null(S_th)) {
#if only one threshold is assign
if (!is.null(G1G2_th) & is.null(S_th)) {
S_th = G1G2_th
} else if (is.null(G1G2_th) & !is.null(S_th)) {
G1G2_th = S_th
}
#assign new G/S
PerCell = PerCell %>%
dplyr::mutate(
is_noisy = dplyr::case_when(normalized_dimapd > S_th ~ T,
T ~ is_noisy),
is_high_dimapd = dplyr::case_when(
normalized_dimapd > S_th ~ T,
normalized_dimapd <= G1G2_th ~ F,
T ~ is_high_dimapd
),
Type = dplyr::case_when(
as.logical(is_high_dimapd) == T &
as.logical(is_noisy) == T ~ 'S-phase cells',
as.logical(is_high_dimapd) == F &
as.logical(is_noisy) == F &
normalized_dimapd <= G1G2_th ~ 'G1/G2-phase cells',
T ~ 'unknown cells'
)
)
} else{
PerCell = PerCell %>%
dplyr::mutate(
Type = dplyr::case_when(
as.logical(is_high_dimapd) == T &
as.logical(is_noisy) == T ~ 'S-phase cells',
as.logical(is_high_dimapd) == F &
as.logical(is_noisy) == F ~ 'G1/G2-phase cells',
T ~ 'unknown cells'
))
}
#calculate median ploidy of the supposed G1
median_ploidy_not_noisy__diagnostic = PerCell %>%
dplyr::filter(Type=='G1/G2-phase cells') %>%
dplyr::pull(mean_ploidy) %>%
stats::median()
results$Settings = results$Settings %>%
dplyr::mutate(Ploidy = median_ploidy_not_noisy__diagnostic,
RPM_TH = round(Ploidy * RPMPH_TH))
#prepare df
PerCell = PerCell %>%
dplyr::mutate(
Type = dplyr::case_when(
coverage_per_1Mbp < results$Settings$RPM_TH ~ 'Low Coverage',
ploidy_confidence < 2 &
ploidy_confidence != -100 ~ 'Low ploidy confidence',
mean_ploidy < median_ploidy_not_noisy__diagnostic / 1.5 ~ 'Too low ploidy compared to G1/G2-phase pool',
mean_ploidy > median_ploidy_not_noisy__diagnostic * 2 ~ 'Too high ploidy compared to G1/G2-phase pool',
T ~ Type
)
)
# first plot
results$all_cells_plot = PerCell %>%
ggplot2::ggplot(ggplot2::aes(mean_ploidy,
normalized_dimapd,
color = Type)) +
ggplot2::geom_point(alpha = 0.3) +
ggplot2::scale_color_manual(
values = c(
'Low Coverage' = "#ff7949",
'Low ploidy confidence' = "#70001e",
'Too low ploidy compared to G1/G2-phase pool' = "#01e7ab",
'Too high ploidy compared to G1/G2-phase pool' = "#a7001b",
'G1/G2-phase cells' = "#005095",
'S-phase cells' = "#78bd3e",
'unknown cells' = "#dfbd31"
)
) +
ggplot2::theme(legend.position = 'top',
legend.title = ggplot2::element_blank()) +
ggplot2::xlab('Ploidy') + ggplot2::ylab('Variability')
#select potentially suitable cells
PerCell = PerCell %>%
dplyr::filter(
Type %in% c(
'S-phase cells',
'G1/G2-phase cells',
'Too low ploidy compared to G1/G2-phase pool',
'Too high ploidy compared to G1/G2-phase pool'
)
)
#plot
results$first_filtering_plot = PerCell %>%
ggplot2::ggplot(ggplot2::aes(mean_ploidy,
normalized_dimapd,
color = Type)) +
ggplot2::geom_point(alpha = 0.3) +
ggplot2::scale_color_manual(
values = c(
'G1/G2-phase cells' = "#005095",
'S-phase cells' = "#78bd3e",
'unknown cells' = "#dfbd31",
'Too low ploidy compared to G1/G2-phase pool' = "#01e7ab",
'Too high ploidy compared to G1/G2-phase pool' = "#a7001b"
)
) +
ggplot2::theme(legend.position = 'top',
legend.title = ggplot2::element_blank()) +
ggplot2::xlab('Ploidy') + ggplot2::ylab('Variability')
#select only S and G
PerCell = PerCell %>%
dplyr::filter(Type %in% c('S-phase cells',
'G1/G2-phase cells')) %>%
dplyr::mutate(
Type = dplyr::case_when(
mean_ploidy < results$Settings$Ploidy &
Type == 'S-phase cells' ~ 'Second-part-S-phase cells',
mean_ploidy >= results$Settings$Ploidy &
Type == 'S-phase cells' ~ 'First-part-S-phase cells',
T ~ Type
)
)
results$selected_G1_S_cells_plot = PerCell %>%
ggplot2::ggplot(ggplot2::aes(mean_ploidy,
normalized_dimapd,
color = Type)) +
ggplot2::geom_point(alpha = 0.3) +
ggplot2::scale_color_manual(
values = c(
'G1/G2-phase cells' = '#005095',
'First-part-S-phase cells' = '#78bd3e',
'Second-part-S-phase cells' = '#83007e',
'unknown cells' = '#dfbd31'
)
) +
ggplot2::theme(legend.position = 'top',
legend.title = ggplot2::element_blank()) +
ggplot2::xlab('Ploidy') + ggplot2::ylab('Variability')
#how many s
nS = nrow(PerCell %>%
dplyr::filter(Type %in% c('Second-part-S-phase cells','First-part-S-phase cells')))
#automatic correction
if (Automatic_correction & nS >= 10) {
# correct mean ploidy
cl = snow::makeCluster(cores)
doSNOW::registerDoSNOW(cl)
on.exit(snow::stopCluster(cl))
# test multiple parameters to correct S phase
distributions = foreach::foreach(a = seq(0.95, 1, by = 0.001),
.combine = 'rbind') %:%
foreach::foreach(b = seq(0.5, 0.55, by = 0.001),
.combine = 'rbind') %dopar% {
#adjust S-phase based on a and b
x = PerCell %>%
dplyr::filter(Type %in% c(
'First-part-S-phase cells',
'Second-part-S-phase cells'
)) %>%
dplyr::mutate(
corrected_mean_ploidy = ifelse(
Type == 'First-part-S-phase cells',
mean_ploidy / a,
mean_ploidy / b
)
) %>%
dplyr::select(corrected_mean_ploidy) %>%
dplyr::pull()
# are the data unimodal?
if (LaplacesDemon::is.unimodal(x)) {
# d is the distance between theoretical center of the S-phase (G1 median ploidy *1.5)
#and the average ploidy of the corrected S-phase
# d is divided by sd(x) in order to select parameters that keep the distribution as wide as possible
dplyr::tibble(
A = a,
B = b,
d = 1 / stats::sd(x),
unimodal = T
)
} else{
dplyr::tibble(
A = a,
B = b,
d = stats::sd(x),
unimodal = F
)
}
}
#select the minimum value of d
if (nrow(distributions) == 0) {
print('Please provide manual parameters to fix S-phase progression')
} else{
distributions = distributions %>%
dplyr::filter(unimodal == ifelse(any(unimodal == T), T, F)) %>%
dplyr::filter(d == min(d))
if (nrow(distributions) != 1) {
print('Please provide manual parameters to fix S-phase progression')
} else {
results$Settings$Sphase_first_part = distributions$A
results$Settings$Sphase_second_part = distributions$B
}
}
} else if (Automatic_correction & nS < 10) {
warning(
'There are not enough cells identified as S-phase. Automatic correction could not be performed.Please provide manual parameters to fix S-phase progression.'
)
}
#correct mean ploidy
PerCell = PerCell %>%
dplyr::mutate(
mean_ploidy = dplyr::case_when(
Type == 'Second-part-S-phase cells' ~ mean_ploidy / results$Settings$Sphase_second_part,
Type == 'First-part-S-phase cells' ~ mean_ploidy / results$Settings$Sphase_first_part,
T ~ mean_ploidy
)
)
#corrected S phase
results$fixed_S_phase_plot = PerCell %>%
ggplot2::ggplot(ggplot2::aes(mean_ploidy,
normalized_dimapd,
color = Type)) +
ggplot2::geom_point(alpha = 0.3) +
ggplot2::scale_color_manual(
values = c(
'G1/G2-phase cells' = '#005095',
'First-part-S-phase cells' = '#78bd3e',
'Second-part-S-phase cells' = '#83007e',
'unknown cells' = '#dfbd31'
)
) +
ggplot2::theme(legend.position = 'top',
legend.title = ggplot2::element_blank()) +
ggplot2::xlab('Ploidy') + ggplot2::ylab('Variability')
#distribution plot
results$S_phase_cell_distribution_plot = PerCell %>% dplyr::filter(Type %in% c('Second-part-S-phase cells',
'First-part-S-phase cells')) %>%
ggplot2::ggplot() +
ggplot2::geom_density(ggplot2::aes(x = mean_ploidy, y = (..density..)),
color = "black") +
ggplot2::xlab('Ploidy') + ggplot2::ylab('Variability')
}
return(results)
}
#' Assigns cell cycle staging metadata
#'
#' @return tibble
#'
#' @importFrom dplyr select inner_join mutate
#' @importFrom tidyr %>%
#'
#' @param PerCell, per cell dataframe from CallCNV
#' @param WhoIsWho, dataframe containing two columns: Cell (character) and S_Phase (logical)
#'
#' @export
WhoIsWho = function(PerCell, WhoIsWho) {
#load required operators
`%>%` = tidyr::`%>%`
#assign info
PerCell = PerCell %>%
dplyr::inner_join(WhoIsWho,
by = c("Cell")) %>%
dplyr::mutate(is_high_dimapd = ifelse(S_Phase, T, F),
is_noisy = ifelse(S_Phase, T, F)) %>%
dplyr::select(-S_Phase)
return(PerCell)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.