[Seqinr-commits] r2024 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Oct 14 18:12:36 CEST 2016
Author: jeanlobry
Date: 2016-10-14 18:12:35 +0200 (Fri, 14 Oct 2016)
New Revision: 2024
Added:
pkg/R/dotchart.uco.R
Modified:
pkg/R/uco.R
Log:
fixing a bug in dotchart.uco
Added: pkg/R/dotchart.uco.R
===================================================================
--- pkg/R/dotchart.uco.R (rev 0)
+++ pkg/R/dotchart.uco.R 2016-10-14 16:12:35 UTC (rev 2024)
@@ -0,0 +1,75 @@
+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, ...)
+{
+ 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))
+
+ 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, ...)
+#
+# Return invisibly for further plots
+#
+ result <- list(0)
+ 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) )
+}
Modified: pkg/R/uco.R
===================================================================
--- pkg/R/uco.R 2016-10-14 16:11:19 UTC (rev 2023)
+++ pkg/R/uco.R 2016-10-14 16:12:35 UTC (rev 2024)
@@ -41,81 +41,3 @@
}
}
-
-dotchart.uco <- function(x, numcode = 1, aa3 = TRUE, cex = 0.7,
- alphabet = s2c("tcag"), pch = 21, gpch = 20, bg = par("bg"),
- color = par("fg"), gcolor = par("fg"), lcolor = "gray", xlim, ...)
-{
- if( is.null(names(x)) ) names(x) <- words( alphabet = alphabet )
-#
-# 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))
- }
- dotchart(x = x, labels = labels, groups = groups, gdata = gdata,
- cex = cex, pch = pch, gpch = gpch, bg = bg, color = color,
- gcolor = gcolor, lcolor = lcolor, xlim, ...)
-#
-# Return invisibly for further plots
-#
- result <- list(0)
- 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) )
-}
-
-
-
More information about the Seqinr-commits
mailing list