R/create_labels.R

Defines functions create.labels

create.labels <- function(MEM_vals_scale,
             display.thresh,
             heatmap_data) {
        posRownamesMatrix <- matrix()
        negRownamesMatrix <- matrix()
        for (i in seq_len(nrow(heatmap_data))) {
            # Get markers above threshold
            posMarkers <- MEM_vals_scale[i,][MEM_vals_scale[i,] >= display.thresh]
            negMarkers <- MEM_vals_scale[i,][MEM_vals_scale[i,] < 0 & abs(MEM_vals_scale[i,]) >= display.thresh]
            #Order markers by abs(MEM)
            posMarkersOrdered <- posMarkers[order(posMarkers, decreasing = TRUE)]
            negMarkersOrdered <- negMarkers[order(abs(negMarkers), decreasing = TRUE)]
            #Get + or - sign for each corresponding marker
            posVector <- rep("+", length(posMarkers))
            negVector <- rep("-", length(negMarkers))
            if (length(posVector) == 0) {
                posVector <- rep("None", 1)
            }
            if (length(negVector) == 0) {
                negVector <- rep("None", 1)
            }
            #Put together character vectors for rownames
            posSignedVec <- as.matrix(paste(posVector, abs(round(
                posMarkersOrdered, 2
            )), sep = ""))
            posMarkersRanked <- as.matrix(names(posMarkersOrdered))
            posRownames <- t(paste(posMarkersRanked, posSignedVec, sep = ""))
            posRownamesMatrix[i] <- apply(posRownames, 1, paste, collapse = " ")
            negSignedVec <- as.matrix(paste(negVector, abs(round(
                negMarkersOrdered, 2
            )), sep = ""))
            negMarkersRanked <- as.matrix(names(negMarkersOrdered))
            negRownames <- t(paste(negMarkersRanked, negSignedVec, sep = ""))
            negRownamesMatrix[i] <- apply(negRownames, 1, paste, collapse = " ")
        }
        new_rownames <- paste(
            row.names(MEM_vals_scale),
            ":",
            '\U25B2',
            posRownamesMatrix,
            '\U25BC',
            negRownamesMatrix,
            sep = " "
        )
        return(new_rownames)
    }
cytolab/cytoMEM documentation built on Sept. 13, 2023, 7:28 a.m.