Project: s41467-024-54621-3 | Function: calc_HER2_groups (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:** Comprehensive molecular classifier function that computes HER2-positive breast cancer subtypes from gene expression data. Includes data normalization, median rescaling, standardization, and subtype score calculation.

**KEY TERMS:** {
  "d": "gene expression matrix",
  "sig": "signature gene lists and coefficients",
  "median_rescale": "ratio-based correction method",
  "HER2_subtype": "classified molecular subtype"
}

**CONTEXT CODE:** ####### Installation of required packages

if (!require("dplyr", quietly = TRUE))
  install.packages("dplyr")
if (!require("matrixStats", quietly = TRUE))
  install.packages("matrixStats")


############################## R script to compute HER2-positive breast cancer subtypes


library(dplyr)
library(matrixStats)

# color palette for plots
col_HER2_subtypes <- c("IM" = "#db6d00",
                       "P/Met" = "#920000",
                       "Mes/S" = "#009292",
                       "LUM" = "#006ddb",
                       "ERBB2-D" = "#ff6db6")


#### FUNCTION TO COMPUTE THE HER2+ SUBTYPES

# To work, calc_HER2_groups() requires "sigs_groups_class_final.RDS", "median_genes.RDS", "x_mean_genes.RDS", "x_sd_genes.RDS" to be stored in your working directory.
# Otherwise, you can modify directly the path to load these files with readRDS() in the script below.

# The OUTPUT is a data frame with:
# - the sample names as row names
# - scores as continuous values for each subtype ("IM_score", "P_Met_score", "Mes_S_score", "LUM_score", "ERBB2_D_score") in each sample
# - the subtype as category (column "HER2_subtype", possible values: "IM", "P/Met", "Mes/S", "LUM", "ERBB2-D")
# - columns of each subtype (as category) vs. rest ("IM_vs_rest", "P_Met_vs_rest", "Mes_S_vs_rest", "LUM_vs_rest", "ERBB2_D_vs_rest") to facilitate downstream comparisons

calc_HER2_groups <- function(d,  # TO BE SPECIFIED: d = gene expression data (rows are gene symbols/entrezIDs, columns are samples)
                             sig = NULL, # signature file (a list of signatures with gene symbols, entrezID and coefficients)
                             type = c("TPM", "FPKM", "microarray"), # TO BE SPECIFIED: after ratio-based correction, if TPM/FPKM, it transforms in log2(d+1), if microarray, assumed in log scale, so first un-logged 2^d and then log2(d+1). If standardize_data = TRUE and TPM/FPKM, centering and scaling are performed using center_genes and sd_genes. If Microarray, scale() is applied with default options
                             is_list_gene_exp = FALSE, # if TRUE, it allows to apply the same median ratio procedure to a list of gene expression matrices (TPM/FPKM) independently, which are then merged at the end before standardization
                             median_genes = NULL, # the file containing median levels of TPM normalized gene expression from ALTTO TPM for genes included in the signatures
                             median_rescale = TRUE, # ratio-based correction: it will rescale gene expression data so that the median of selected genes will be the same as the median of TPM normalized genes in ALTTO (adapted from PMID: 28610557)
                             standardize_data_type = TRUE,  # if TRUE, it will apply scale() on gene expression data based on type, using scale(...,center=center_genes,scale=sd_genes) if TPM/FPKM, or scale(...,center=TRUE,scale=TRUE) if microarray. If FALSE, it will apply scale(...,center=TRUE,scale=TRUE) regardless
                             center_genes = NULL,
                             sd_genes = NULL,
                             fpkm_to_tpm = TRUE # it converts FPKM to TPM if type = "FPKM"
)
{
  stop("Function implementation has been masked")
}

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