R/dotchart.uco.R

In seqinr: Biological Sequences Retrieval and Analysis

dotchart.uco <- function(x, numcode = 1, aa3 = TRUE, pt.cex = 0.7, 
                         alphabet = s2c("tcag"), pch = 21, gpch = 20, bg = par("bg"), cex = 0.7,
                         color = "black", gcolor = "black", lcolor = grey(0.9), xlim, 
                         offset = 0.4, ...)
{
    if( is.null(names(x)) ) names(x) <- words( alphabet = alphabet )
    bcknames <- names(x)
    x <- as.numeric(x)
    names(x) <- bcknames
    #
    # General sorting 
    #
    x <- sort(x)
    labels <- names(x)
    stringlabel = paste(labels, sep = "", collapse = "")
    groups <- as.factor(translate(s2c(stringlabel), numcode =  numcode))
    gdata <- sapply(split(x, groups), sum)
    #
    # Now, sorting by aa order
    #
    gordered <- rank(gdata)
    xidx <- numeric(64)
    
    for( i in seq_len(64) )
    {
        xidx[i] <- -0.01*i + gordered[groups[i]]
    }
    
    x <- x[order(xidx)]
    labels <- names(x)
    stringlabel = paste(labels, sep = "", collapse = "")
    aa <- translate(s2c(stringlabel), numcode =  numcode)
    groups <- factor(aa, levels = unique(aa))
    gdata <- sapply(split(x, groups), sum)
    
    if( missing(xlim) ) xlim <- c(0, max(gdata))
    if( aa3 ) levels(groups) <- aaa(levels(groups))
    
    graphics::dotchart(x = x, labels = labels, groups = groups, gdata = gdata,
             pt.cex = pt.cex, pch = pch, gpch = gpch, bg = bg, color = color,
             gcolor = gcolor, lcolor = lcolor, cex = cex, xlim = xlim, 
             offset = offset, ...)
    #
    # Return invisibly for further plots
    #
    result <- list(0)
    #
    # Sorting according to groups for nicer results
    #
    aordered = rank(groups)
    x <- x[order(aordered)]
    labels <- labels[order(aordered)]
    groups <- groups[order(aordered)]
    
    result$x <- x
    result$labels <- labels
    result$groups <- groups
    result$gdata <- gdata
    
    ypg <- numeric( length(levels(groups)) )
    i <- 1
    for( aa in levels(groups) )
    {
        ypg[i] <- length(which(groups == aa)) + 2
        i <- i + 1
    }
    ypg <- rev(cumsum(rev(ypg))) - 1
    names(ypg) <- levels(groups)
    result$ypg <- ypg
    
    ypi <- numeric( length(x) )
    for( i in seq_len(length(x)) )
    {
        ypi[i] <- ypg[groups[i]]
    }
    antirank <- function(x) 
    {
        return( seq(length(x),1,by=-1 ))
    }
    ypi <- ypi - unlist(sapply(split(x, groups),antirank))
    names(ypi) <- labels
    result$ypi <- ypi
    
    return( invisible(result) ) 
}