Project: s41467-024-50602-8 | Function: get_bimodality_stat (r)

system: You are an expert R programmer implementing algorithms from scientific papers.
Complete the masked function based on the algorithm description.
Follow R best practices and maintain consistent code style.
Return **only** the complete R function code.

user: Complete this R function:

**DESCRIPTION:** Performs bimodality analysis using Hartigan's diptest and Gaussian mixture modeling to quantify population heterogeneity in cell size distributions across different nitrogen sources

**KEY TERMS:** {
  "dip.test": "Hartigan's diptest bimodality scores",
  "flexmix": "Gaussian mixture modeling",
  "FSC.H": "cell size measurements"
}

**CONTEXT CODE:** 
# This script is divided into two parts. 

# PART 1 : Pre-processing of flow data. Store bimodality score in excel file
#           Note that due to flexmix sometimes stuck in local optima when trying
#           to compute EM. Running the script on multiple time with different seeds
#           might be required. 
# PART 2 : Plotting of the bimodality score obtained form PART 1. 
#          (PART2 can be run without running PART1)


require(ggplot2)
require(diptest)
require(flexmix)
require(dplyr)
require(scales)
require(viridis)
require(data.table)


# setwd(dirname(rstudioapi::getActiveDocumentContext()$path)) 


# PART 1 : Compute bimodality scores --------------------------------------


# Change seed if flexmix stuck in local optima
set.seed(4) 

# Set file locations for each flow file
file_names <- read.csv('helper_file_names_replicates_NLIM.csv') 

# Extract condition names
conditions <- file_names$name

# Convert to list to lapply
file_names <- file_names %>% split(., seq(nrow(.)), drop=T)

# Function merge replicate files, perform analysis and export metrics
# as well as histogram with flexmix parameters for each condition
get_bimodality_stat <- function(file_name) {
  stop("Function implementation has been masked")
}

bimodality_stats <- lapply(file_names, get_bimodality_stat)

header <- c('rep1.stat',
            'rep1.pval',
            'rep2.stat',
            'rep2.pval',
            'rep3.stat',
            'rep3.pval',
            'mean.rep1.c1',
            'mean.rep1.c2',
            'mean.rep2.c1',
            'mean.rep2.c2',
            'mean.rep3.c1',
            'mean.rep3.c2',
            'sd.rep1.c1',
            'sd.rep1.c2',
            'sd.rep2.c1',
            'sd.rep2.c2',
            'sd.rep3.c1',
            'sd.rep3.c2',
            'rep1.ratio',
            'rep2.ratio',
            'rep3.ratio',
            'rep1.FC',
            'rep2.FC',
            'rep3.FC')

# Writing final output
output.table=as.data.frame(bimodality_stats) %>% transpose()
colnames(output.table)=header
output.table$condition=conditions

write.csv(output.table,file='../output_tables/bimodality_scores_6h_seed_4.csv')

# PART 2 : Plot bimodality scores -----------------------------------------

require(ggplot2)
require(dplyr)
require(plyr)
require(readxl)
require(stringr)
require(viridis)
require(reshape2)


# Upload data
scores <- read.csv('../output_tables/bimodality_scores_HO_HLM_6h_triplicates_summary.csv')

# Compute means and sds for metrics representing the bimodality

scores <- scores %>% 
  dplyr::rowwise() %>% 
  dplyr::mutate(
    rep.stat.mean = mean(c_across(c('rep1.stat', 'rep2.stat','rep3.stat'))),
    rep.stat.sd = sd(c_across(c('rep1.stat', 'rep2.stat','rep3.stat'))),
    rep.stat.stderror =  rep.stat.sd/sqrt(3),
    rep.FC.mean = mean(c_across(c('rep1.FC', 'rep2.FC','rep3.FC'))),
    rep.FC.sd = sd(c_across(c('rep1.FC', 'rep2.FC','rep3.FC'))),
    rep.FC.mean.inv = -rep.FC.mean, # FC high to low
    rep.FC.stderror = rep.FC.sd/sqrt(3),
    control = if_else(condition == 'NSTARVE', 'y', 'n'),
    nitrogen = if_else(control=='n',stringr::str_to_sentence(sub('.....', '',condition)),'None'),
  )

saveRDS(scores, file = "../Rdata/bimodality_scores_HO_HLM_triplicates.rds")



# Add boolean marker for p<0.05, p<0.005, p<0.0005

# Add control row


# Separate in two datasets for NLIM and NREP
scores.NLIM <- scores %>% filter(!grepl('NREP', condition))
scores.NREP <- scores %>% filter(!grepl('NLIM', condition))

# show_col(viridis(6))
#colour_map = c(cividis(6)[5],cividis(6)[3])
colour_map = c(inferno(10)[9],inferno(10)[2])

# Bimodality scores NLIM series
ggplot(scores.NLIM, aes(x=nitrogen, y=rep.stat.mean,fill=control))+
  geom_bar(aes(x=reorder(nitrogen, plyr::desc(rep.stat.mean)), y=rep.stat.mean,  fill=control, colour=control), stat="identity", alpha=0.8, width=0.7)+
  geom_point(aes(x=nitrogen,y=rep1.stat),size=1, alpha=1, colour="grey")+
  geom_point(aes(x=nitrogen,y=rep2.stat),size=1, alpha=1, colour="grey")+
  geom_point(aes(x=nitrogen,y=rep3.stat),size=1, alpha=1, colour="grey")+
  ylim(0, 0.05)+
  scale_colour_manual(values=colour_map)+
  scale_fill_manual(values=colour_map)+
  geom_errorbar(aes(ymin=rep.stat.mean-rep.stat.stderror, ymax=rep.stat.mean+rep.stat.stderror), width=.3, color='black')+ 
  ylab("Bimodality score (a.u.)")+
  theme_bw()+
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust=0.5),
        panel.background = element_blank(),
        panel.grid.major = element_blank(),


Complete the function implementation replacing "stop("Not implemented")".