R/enrichFCSbyCIPHE.R

In Selkie-13/Jarvis:

enrichFCSbyCIPHE <- function(original, new.column, nw.names=NULL){
  new_p <- parameters(original)[1,]

  ## Now, let's change it's name from $P1 to $P26 (or whatever the next new number is)
  new_p_number <- as.integer(dim(original)[2]+1)
  rownames(new_p) <- c(paste0("$P", new_p_number))

  ## Now, let's combine the original parameter with the new parameter
   ## for the combine function
  allPars <-  BiocGenerics::combine(parameters(original), new_p)

  ## Fix the name and description of the newly added parameter, say we want to be calling it cluster_id

  if(is.null(nw.names)){
    new_p_name <- "cluster"
  } else {
    new_p_name <- nw.names
  }

  allPars@data$name[new_p_number] <- new_p_name
  allPars@data$desc[new_p_number] <- new_p_name

  new_exprs <- cbind(original@exprs, new.column)
  colnames(new_exprs) <- c(colnames(original@exprs),new_p_name)

  new_kw <- original@description
  new_kw["$PAR"] <- as.character(new_p_number)
  new_kw[paste0("$P",as.character(new_p_number),"N")] <- new_p_name
  new_kw[paste0("$P",as.character(new_p_number),"S")] <- new_p_name
  new_kw[paste0("$P",as.character(new_p_number),"E")] <- "0,0"
  new_kw[paste0("$P",as.character(new_p_number),"G")] <- "1"
  new_kw[paste0("$P",as.character(new_p_number),"B")] <- new_kw["$P1B"]
  new_kw[paste0("$P",as.character(new_p_number),"R")] <- new_kw["$P1R"]
  new_kw[paste0("flowCore_$P",as.character(new_p_number),"Rmin")] <- new_kw["flowCore_$P1Rmin"]
  new_kw[paste0("flowCore_$P",as.character(new_p_number),"Rmax")] <- new_kw["flowCore_$P1Rmax"]

  ## Now, let's just combine it into a new flowFrame
  new_fcs <- new("flowFrame", exprs=new_exprs, parameters=allPars, description=new_kw)

  return(new_fcs)
}

concatenateCIPHE <- function(flow.frames, params="Flag") {
  ff.concat <- NULL
  n <- length(flow.frames)
  for(i in 1:n){
    ff.raw <- flow.frames[[i]]
    p <- matrix(i, nrow = nrow(ff.raw), ncol=1, dimnames = list(NULL, params))
    new.col <- as.vector(p)
    ff.raw <- enrichFCSbyCIPHE(ff.raw, new.col, nw.names=params)
    if(is.null(ff.concat)){
      ff.concat  <- ff.raw
    } else {
      exprs(ff.concat) <- rbind(exprs(ff.concat),exprs(ff.raw))
    }
  }
  return(ff.concat)
}

writeLabelEnrichCIPHE <- function(fcs, annotation.column, populations.dataframe)
{
  #populations : >id1;pop1> ... >idN;popN

  #populations.dataframe: noms de colonne = ID, Name

  #Number of populations
  keyword.data <- ""

  #Populations
  for(i in 1:nrow(populations.dataframe))
  {
    pop <- populations.dataframe[i,]
    tmp.data <- paste(pop$Name, pop$ID, sep=";")
    keyword.data <- paste0(keyword.data, tmp.data, ">")
  }

  fcs@description[[paste0("P",annotation.column,"PopN")]] <- keyword.data

  return(fcs)
}

readLabelEnrichCIPHE <- function(fcs, annotation.column, add.pop.size = T)
{
  pop.table <- NULL
  pop.keyword <- fcs@description[[paste0("P",annotation.column,"PopN")]]
  if(!is.na(pop.keyword) && length(pop.keyword)>0)
  {
    tmp.populations <- unlist(strsplit(pop.keyword, ">", fixed = T))[-1]
    pop.table <- matrix(0, ncol=3, nrow=length(tmp.populations))
    colnames(pop.table) <- c("ID", "Name", "Events")
    for(i in 1:length(tmp.populations))
    {
      tmp.pop <- tmp.populations[[i]]
      pop.table[i,c(1,2)] <- as.character(unlist(strsplit(tmp.pop, ";", fixed = T)))
      if(add.pop.size)
      {
        pop.table[i,3] <- as.integer(sum(fcs@exprs[,annotation.column]==as.integer(pop.table[i,1])))
      }
    }
    pop.table <- data.frame(pop.table, stringsAsFactors = F)
    pop.table$Events <- as.integer(pop.table$Events)
    if(!add.pop.size)
    {
      pop.table <- pop.table[,c(1,2)]
    }
  }
  return(pop.table)
}