Project: s41467-024-48105-7 | Function: mr_forest_plot_outliers (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:** Custom implementation of forest plot visualization for Mendelian randomization with outlier detection and highlighting. Creates specialized plots for MR sensitivity analysis showing single SNP effects with outliers highlighted in different colors, implementing the outlier detection methodology described in the paper.

**KEY TERMS:** {
  "outliers_list": "SNPs identified as outliers",
  "outliers_colour": "color coding for outlier highlighting",
  "method": "outlier detection method used",
  "beta.exposure": "SNP effect on exposure",
  "beta.outcome": "SNP effect on outcome"
}

**CONTEXT CODE:** }


mr_leaveoneout_plot_manual <- function (leaveoneout_results) 
{
  requireNamespace("ggplot2", quietly = TRUE)
  requireNamespace("plyr", quietly = TRUE)
  res <- plyr::dlply(leaveoneout_results, c("id.exposure", 
                                            "id.outcome"), function(d) {
                                              d <- plyr::mutate(d)
                                              if (sum(!grepl("All", d$SNP)) < 3) {
                                                return(blank_plot("Insufficient number of SNPs"))
                                              }
                                              d$up <- d$b + 1.96 * d$se
                                              d$lo <- d$b - 1.96 * d$se
                                              d$tot <- 1
                                              d$tot[d$SNP != "All"] <- 0.01
                                              d$SNP <- as.character(d$SNP)
                                              nom <- d$SNP[d$SNP != "All"]
                                              nom <- nom[order(d$b)]
                                              d <- rbind(d, d[nrow(d), ])
                                              d$SNP[nrow(d) - 1] <- ""
                                              d$b[nrow(d) - 1] <- NA
                                              d$up[nrow(d) - 1] <- NA
                                              d$lo[nrow(d) - 1] <- NA
                                              d$SNP <- ordered(d$SNP, levels = c("All", "", nom))
                                              ggplot2::ggplot(d, ggplot2::aes(y = SNP, x = b)) +
                                                ggplot2::geom_vline(xintercept = 0,  linetype = "dotted") +
                                                ggplot2::geom_errorbarh(ggplot2::aes(xmin = lo,  xmax = up, 
                                                                                     size = as.factor(tot), 
                                                                                     colour = as.factor(tot)),
                                                                        height = 0) +
                                                ggplot2::geom_point(ggplot2::aes(colour = as.factor(tot))) + 
                                                ggplot2::geom_hline(ggplot2::aes(yintercept = which(levels(SNP) %in%  "")), colour = "grey") + 
                                                
                                                ggplot2::scale_colour_manual(values = c("black",  "red")) + 
                                                ggplot2::scale_size_manual(values = c(0.3,   1)) +
                                                theme_bw()+
                                                ggplot2::theme(legend.position = "none", 
                                                               axis.text.y = ggplot2::element_text(size = 8), 
                                                               axis.ticks.y = ggplot2::element_line(size = 0), 
                                                               axis.title.x = ggplot2::element_text(size = 8)) + 
                                                ggplot2::labs(y = "", x = paste0("MR leave-one-out sensitivity analysis for\n'", 
                                                                                 d$exposure[1], "' on '", d$outcome[1], "'"))
                                            })
  res
}



mr_forest_plot_outliers <- function (d,  outliers_list, outliers_colour, method, or=F, snp_order=NULL) {
    stop("Function implementation has been masked")
}


mr_forest_plot_clusters <- function (d,  outliers_df, outliers_colour_list) {
  # this is a modified version of TwpSampleMR function for single SNP forest plot
  
  requireNamespace("ggplot2", quietly = TRUE)
  requireNamespace("plyr", quietly = TRUE)
  
  #if (sum(!grepl("All", d$SNP)) < 2) {
  # return(blank_plot("Insufficient number of SNPs"))}
  
  levels(d$SNP)[levels(d$SNP) == "All - Inverse variance weighted"] <- "All - IVW"
  levels(d$SNP)[levels(d$SNP) == "All - MR Egger"] <- "All - Egger"
  am <- grep("All|cluster", d$SNP, value = TRUE)
  d$up <- d$b + 1.96 * d$se
  d$lo <- d$b - 1.96 * d$se
  d$tot <- 0.01
  d$tot[d$SNP %in% am] <- 1
  d$SNP <- as.character(d$SNP)
  nom <- d$SNP[!d$SNP %in% am]
  nom <- nom[order(d$b)]
  d <- rbind(d, d[nrow(d), ])
  d$SNP[nrow(d) - 1] <- ""
  d$b[nrow(d) - 1] <- NA
  d$up[nrow(d) - 1] <- NA
  d$lo[nrow(d) - 1] <- NA
  
  d <- d %>% left_join(outliers_df, by= c("SNP"="rsID")) 
  
  d$SNP <- ordered(d$SNP, levels = c(am, "", nom))
  xint <- 0
  

  
  out <- ggplot2::ggplot(d, ggplot2::aes(y = SNP, x = b)) + 
    ggplot2::geom_vline(xintercept = xint, linetype = "dotted") + 
    ggplot2::geom_errorbarh(ggplot2::aes(xmin = lo, xmax = up, colour = as.factor(cluster)), height = 0) +
    ggplot2::geom_point(ggplot2::aes(colour = as.factor(cluster))) + 
    ggplot2::geom_hline(ggplot2::aes(yintercept = which(levels(SNP) %in% "")), colour = "black") + 
    ggplot2::scale_colour_manual(values = outliers_colour_list) +
    ggplot2::theme_bw()+
    ggplot2::theme(legend.position = "none", 
                   axis.text.y = ggplot2::element_text(size = 8), 
                   axis.ticks.y = ggplot2::element_line(size = 0), 
                   axis.title.x = ggplot2::element_text(size = 8)) + 
    ggplot2::labs(y = "", 
                  subtitle = "Single SNP forest plot with MR-Clust clusters",
                  x = paste0("Effect size for\n", 
                                     d$exposure[1], " effect on ", d$outcome[1]))
  return(list(p=out,
              dat = d))
  
  
}


calc_steiger <- function(harmonised, exposure_ss, outcome_ss, outcome_ncase = NA, outcome_ncontrol =NA){
  # assumed both traits are continuous, not binary
  
  harmonised$samplesize.exposure <- exposure_ss
  harmonised$samplesize.outcome <- outcome_ss 
  
  if (NA %in% harmonised$eaf.outcome){
    # if eaf is not available for outcome GWAS, we can't apply r_func below, so we will treat this data as continuous
    print("EAF not available; can't analyses outcome as binary for steiger filtering")
    outcome_ncase = NA
    outcome_ncontrol =NA
  }
  
  if (!is.na(outcome_ncase) & !is.na(outcome_ncontrol)){
    # if outcome case/control is provided, calculate prevalence and add everything to harmonised 
    # this is done for binary outcome analyses
    prevelance = outcome_ncase / (outcome_ncase + outcome_ncontrol)
    harmonised$ncase.outcome = outcome_ncase
    harmonised$ncontrol.outcome = outcome_ncontrol
    harmonised$prevelance.outcome = prevelance
    
    ## estimate r for binary or continuous exposures/outcomes
    harmonised <- r_func(harmonised, logistic.exposure=F, logistic.outcome=T)
  }
    
  
  harmonised <- steiger_filtering(harmonised) 
  harmonised_sub <- harmonised %>%  select(SNP, exposure, beta.exposure, pval.exposure, outcome, beta.outcome, pval.outcome, rsq.exposure, rsq.outcome, steiger_dir, steiger_pval)
  
  
  directionality <- directionality_test(harmonised)
  
  N = unique(harmonised$samplesize.exposure) #sample size
  K = length(harmonised$SNP) #number of SNPs
  total_r2 <- sum(harmonised$rsq.exposure) 
  Fstat <- (N-K-1)/K * total_r2 / (1-total_r2)
  
  
  summary <- directionality
  summary$Fst <- Fstat
  summary$total_r2 <- total_r2


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