[Seqinr-commits] r2024 - pkg/R

[noreply at r-forge.r-project.org]

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) ) 
-}
-
-
-