Project: s41467-025-59529-0 | Function: calculate_CellProprtion (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:** Calculate cell type proportions from single-cell or bulk expression data. Implements proportional analysis methodology for cell composition estimation.

**KEY TERMS:** {
  "CellProprtion": "cell type proportions",
  "calculate": "proportion computation"
}

**CONTEXT CODE:**          cellchat_pt_major.rds,
         cellchat_pt_sub.rds)
      #Parallelize loop
      doFuture::registerDoFuture()
      #foreach(indent = 1:length(clusterList)) %dopar%
      for (indent in 1:length(clusterList))
      {
        #try for catching errors but keep going
        sub_cellchat_sub_diffPtMt <- subsetCellChat(object=cellchat_sub_diffPtMt,idents.use=clusterList[[indent]])#cells.use=NULL,thresh=0,
        sub_cellchat_sub_diffPnMn<-subsetCellChat(object=cellchat_sub_diffPnMn,idents.use=clusterList[[indent]])#cells.use=NULL,thresh=0,
        #sub_cellchat_sub_diffLnMn<-subsetCellChat(object=cellchat_sub_diffLnMn,idents.use=clusterList[[indent]])#cells.use=NULL,thresh=0,
        #sub_cellchat_sub_diffLnMt<-subsetCellChat(object=cellchat_sub_diffLnMt,idents.use=clusterList[[indent]])#cells.use=NULL,thresh=0,
        sub_cellchat_sub_diffMnMt<-subsetCellChat(object=cellchat_sub_diffMnMt,idents.use=clusterList[[indent]])#cells.use=NULL,thresh=0,
        
        
        try(differentialPathwaySubChord(sub_cellchat_sub_diffPtMt, object.list_sub_diffPtMt,"MT","pTRT",clusterListforChordPathSubfunction[[indent]],clusterListCategories[[indent]],deparse(substitute(sub_cellchat_sub_diffPtMt))))
        #try(dev.off())
        print(1)
        try(differentialPathwaySubChord(sub_cellchat_sub_diffPnMn, object.list_sub_diffPnMn, "MN", "pTRT",clusterListforChordPathSubfunction[[indent]],clusterListCategories[[indent]],deparse(substitute(sub_cellchat_sub_diffPnMn))))
        #try(dev.off())
        print(2)
        #try(differentialPathwaySubChord(sub_cellchat_sub_diffLnMn, object.list_sub_diffLnMn,"MN", "pTRT",clusterListforChordPathSubfunction[[indent]],clusterListCategories[[indent]],deparse(substitute(sub_cellchat_sub_diffLnMn))))
        print(3)
        #try(differentialPathwaySubChord(sub_cellchat_sub_diffLnMt, object.list_sub_diffLnMt,"MT", "pTRT",clusterListforChordPathSubfunction[[indent]],clusterListCategories[[indent]],deparse(substitute(sub_cellchat_sub_diffLnMt))))
        print(4)
        try(differentialPathwaySubChord(sub_cellchat_sub_diffMnMt, object.list_sub_diffMnMt,"MT", "pTRT",clusterListforChordPathSubfunction[[indent]],clusterListCategories[[indent]],deparse(substitute(sub_cellchat_sub_diffMnMt))))
        #try(dev.off())
        print(5)
        print(indent)
        #}else{print('Could Not Run this One')}
        
        # functiontoComparepTRTInteraction(cellchat_sub_diffPnMn, clusterList[indent], clusterListCategories[indent])
        # functiontoComparepTRTInteraction(cellchat_sub_diffLnMn, clusterList[indent], clusterListCategories[indent])
        # functiontoComparepTRTInteraction(cellchat_sub_diffLnMt, clusterList[indent], clusterListCategories[indent])
        # functiontoComparepTRTInteraction(cellchat_sub_diffMnMt, clusterList[indent], clusterListCategories[indent])
        
      }
      
      #For Major PT vs MT but now just pTRT and macrophages
      subset_cellchat_MAJOR_diffPtMt <- subsetCellChat(object=cellchat_major_diffPtMt,idents.use=c("pTRT","Macrophage","Monocyte"))#cells.use=NULL,thresh=0,
      try(
        differentialPathwaySubChord(subset_cellchat_MAJOR_diffPtMt,object.list_major_diffPtMt,"MT","pTRT",c("pTRT","Macrophage","Monocyte"),"Macrophage and Monocyte",deparse(substitute(cellchat_major_diffPtMt)))
      )
    }
    
    
  }
}
#Publication Figures
{
  calculate_CellProprtion <- function(x, geneList, assay) {
    # Extract the expression matrix
    x_expr <- LayerData(x, assay = assay, search = NA)
    totalNumberofCells <- ncol(x_expr)

    # Convert the expression matrix to a numeric matrix
    x_expr <- as.matrix(x_expr)
    x_expr <- x_expr[rowSums(x_expr) > 0, ] # remove genes that don't have any values

    for (geneIterator in geneList) {
      if (geneIterator %in% rownames(x_expr)) {
        x_expr <- x_expr[, x_expr[geneIterator, ] > 0]
        if (!is.null(ncol(x_expr))) {
          x_expr <- x_expr[rowSums(x_expr) > 0, ]
        }
      } else {
        x_expr <- NULL
        break
      }
    }

    if (is.null(x_expr)) {
      return(0)
    } else {
      return((ncol(as.matrix(x_expr)) / totalNumberofCells) * 100)
    }
  }
  calculate_CellProprtionPerPatient <- function(x,geneList,assay){##ChangGroupingvariableName
    listToReturn<-list()
    for(perPatient in levels(factor(x@meta.data[["patient"]]))){
      
      x_subset<-subset(x,subset=(patient==perPatient))
      # Extract the expression matrix for the CD8+ T cells
      x_expr <- LayerData(x_subset, assay = assay,search=NA)
      totalNumberofCells<-ncol(x_expr)
      #x_expr <- GetAssayData(x, assay = "RNA")
      
      # Convert the expression matrix to a numeric matrix
      x_expr <- as.matrix(x_expr)
      x_expr<-x_expr[rowSums(x_expr)>0,] #remove genes that dont have any values
      
      for(geneIterator in geneList){
        if(geneIterator %in% rownames(x_expr)){
          x_expr<-x_expr[,x_expr[geneIterator,]>0]
          if(!is.null(ncol(x_expr))){x_expr<-x_expr[rowSums(x_expr)>0,]}
        }
        else{
          x_expr<-NULL#matrix(, nrow = 1, ncol = 1)
          break
        }
      }
      if(is.null(x_expr)){
        listToReturn[perPatient]<-0
      }else(
        #tryCatch({listToReturn[perPatient]<-(ncol(x_expr)/totalNumberofCells)*100}, error = function(e){listToReturn[perPatient]<-0})
        listToReturn[perPatient]<-(ncol(as.matrix(x_expr))/totalNumberofCells)*100
      )
      
    }
    listToReturn<-as.data.frame(listToReturn)
    return(listToReturn)
  }
  calculate_CellProprtionExclusivePerPatient <- function(x,geneList,geneListExclusive,assay){##ChangGroupingvariableName
    listToReturn<-list()
    for(perPatient in levels(factor(x@meta.data[["patient"]]))){
      
      x_subset<-subset(x,subset=(patient==perPatient))
      # Extract the expression matrix for the CD8+ T cells
      x_expr <- LayerData(x_subset, assay = assay,search=NA)
      totalNumberofCells<-ncol(x_expr)
      #x_expr <- GetAssayData(x, assay = "RNA")
      
      # Convert the expression matrix to a numeric matrix
      x_expr <- as.matrix(x_expr)
      x_expr<-x_expr[rowSums(x_expr)>0,] #remove genes that dont have any values
      
      #To Cacluate for Positive
      for(geneIterator in geneList){
        if(geneIterator %in% rownames(x_expr)){
          x_expr<-x_expr[,x_expr[geneIterator,]>0]
          if(!is.null(ncol(x_expr))){x_expr<-x_expr[rowSums(x_expr)>0,]}
        }
        else{
          x_expr<-NULL#matrix(, nrow = 1, ncol = 1)
          break
        }
      }
      for(geneIterator in geneListExclusive){
        if(geneIterator %in% rownames(x_expr)){
          x_expr<-x_expr[,x_expr[geneIterator,]==0]
          if(!is.null(ncol(x_expr))){x_expr<-x_expr[rowSums(x_expr)>0,]}
        }
      }#no need for else because if it is not there then it does not express it
      
      if(is.null(x_expr)){
        listToReturn[perPatient]<-0
      }else(
        #tryCatch({listToReturn[perPatient]<-(ncol(x_expr)/totalNumberofCells)*100}, error = function(e){listToReturn[perPatient]<-0})
        listToReturn[perPatient]<-(ncol(as.matrix(x_expr))/totalNumberofCells)*100
      )


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