1. preprocessCore
  2. R
  3. normalize.quantiles.R
Browse code

fixed small bug in 'normalize.quantiles.robust'

Christophe Vanderaa authored on 02/07/2021 10:42:02
Showing 1 changed files
R/normalize.quantiles.R
History View file @ 20323f0
... ... 
@@ -114,4 +114,5 @@ normalize.quantiles.robust <- function(x,copy=TRUE,weights=NULL,remove.extreme=c
114 114 
     rownames(mat) <- rownames(x)
115 115 
     colnames(mat) <- colnames(x)
116 116 
   }
117 
+  mat
117 118 
 }
Browse code

Adding option to preserve row and column names during quantile normalization

wkumler authored on 29/06/2021 21:47:12
Showing 1 changed files
R/normalize.quantiles.R
History View file @ e6ff3f7
... ... 
@@ -28,7 +28,7 @@
28 28 
 ##
29 29 
 ##################################################################
30 30
31 
-normalize.quantiles <- function(x,copy=TRUE){
31 
+normalize.quantiles <- function(x,copy=TRUE,keep.names=FALSE){
32 32
33 33 
   rows <- dim(x)[1]
34 34 
   cols <- dim(x)[2]
... ... 
@@ -45,11 +45,16 @@ normalize.quantiles <- function(x,copy=TRUE){
45 45 
   #matrix(.C("qnorm_c", as.double(as.vector(x)), as.integer(rows), as.integer(cols))[[1]], rows, cols)
46 46
47 47 
 ##  .Call("R_qnorm_c",x,copy, PACKAGE="preprocessCore");
48 
-  .Call("R_qnorm_c_handleNA",x,copy, PACKAGE="preprocessCore");
48 
+  mat <- .Call("R_qnorm_c_handleNA",x,copy, PACKAGE="preprocessCore");
49 
+  if(keep.names){
50 
+    rownames(mat) <- rownames(x)
51 
+    colnames(mat) <- colnames(x)
52 
+  }
53 
+  mat
49 54 
 }
50 55
51 56
52 
-normalize.quantiles.robust <- function(x,copy=TRUE,weights=NULL,remove.extreme=c("variance","mean","both","none"),n.remove=1,use.median=FALSE,use.log2=FALSE){
57 
+normalize.quantiles.robust <- function(x,copy=TRUE,weights=NULL,remove.extreme=c("variance","mean","both","none"),n.remove=1,use.median=FALSE,use.log2=FALSE,keep.names=FALSE){
53 58
54 59 
   calc.var.ratios <- function(x){
55 60 
     cols <- dim(x)[2]
... ... 
@@ -104,5 +109,9 @@ normalize.quantiles.robust <- function(x,copy=TRUE,weights=NULL,remove.extreme=c
104 109 
     }
105 110 
   }
106 111
107 
-  .Call("R_qnorm_robust_c",x,copy,weights,as.integer(use.median),as.integer(use.log2),as.integer(use.huber),PACKAGE="preprocessCore")
112 
+  mat <- .Call("R_qnorm_robust_c",x,copy,weights,as.integer(use.median),as.integer(use.log2),as.integer(use.huber),PACKAGE="preprocessCore")
113 
+  if(keep.names){
114 
+    rownames(mat) <- rownames(x)
115 
+    colnames(mat) <- colnames(x)
116 
+  }
108 117 
 }
Browse code

setting up git-svn bridge

Bioconductor Git-SVN Bridge authored on 31/08/2014 21:28:19
Showing 1 changed files
R/normalize.quantiles.R
History View file @ 5617e01
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,108 @@
1 
+##################################################################
2 
+##
3 
+## file: normalize.quantiles.R
4 
+##
5 
+## For a description of quantile normalization method see
6 
+##
7 
+##  Bolstad, B. M., Irizarry R. A., Astrand, M, and Speed, T. P. (2003)(2003)
8 
+##  A Comparison of Normalization Methods for High
9 
+##  Density Oligonucleotide Array Data Based on Bias and Variance.
10 
+##  Bioinformatics 19,2,pp 185-193
11 
+##
12 
+## History
13 
+## Pre Aug 23, 2003 Two years worth of stuff
14 
+## Aug 23, 2003 - Added use.log2 to "robust",
15 
+##                added ability to pass additional parameters
16 
+##                to normalize.AffyBatch.Quantiles.robust
17 
+##                changed pmonly parameters on functions
18 
+##                so that it is now a string argument "type"
19 
+##                the options are pmonly, mmonly, together, separate
20 
+## Jan 31, 2004 - put a check for an integer matrix and force coercision to
21 
+##                doubles if required in normalize.quantiles
22 
+## Mar 13, 2005 - Modifications to normalize.quantiles.robust including removing
23 
+##                approx.method which never got implemented. Making it a use a .Call()
24 
+##                rather than a .C()
25 
+##
26 
+## Sep 20, 2006 - fix .Call in normalize.quantiles.robust
27 
+## May 20, 2007 - port to preprocessCore. Remove anything to do with AffyBatch Objects
28 
+##
29 
+##################################################################
30 
+
31 
+normalize.quantiles <- function(x,copy=TRUE){
32 
+
33 
+  rows <- dim(x)[1]
34 
+  cols <- dim(x)[2]
35 
+
36 
+  if (!is.matrix(x)){
37 
+    stop("Matrix expected in normalize.quantiles")
38 
+  }
39 
+
40 
+  if (is.integer(x)){
41 
+    x <- matrix(as.double(x),rows,cols)
42 
+    copy <- FALSE
43 
+  }
44 
+
45 
+  #matrix(.C("qnorm_c", as.double(as.vector(x)), as.integer(rows), as.integer(cols))[[1]], rows, cols)
46 
+
47 
+##  .Call("R_qnorm_c",x,copy, PACKAGE="preprocessCore");
48 
+  .Call("R_qnorm_c_handleNA",x,copy, PACKAGE="preprocessCore");
49 
+}
50 
+
51 
+
52 
+normalize.quantiles.robust <- function(x,copy=TRUE,weights=NULL,remove.extreme=c("variance","mean","both","none"),n.remove=1,use.median=FALSE,use.log2=FALSE){
53 
+
54 
+  calc.var.ratios <- function(x){
55 
+    cols <- dim(x)[2]
56 
+    vars <- apply(x,2,var)
57 
+    results <- matrix(0,cols,cols)
58 
+    for (i in 1:cols-1)
59 
+      for (j in (i+1):cols){
60 
+        results[i,j] <- vars[i]/vars[j]
61 
+        results[j,i] <- vars[j]/vars[i]
62 
+      }
63 
+    results
64 
+  }
65 
+
66 
+  calc.mean.dists <- function(x){
67 
+    cols <- dim(x)[2]
68 
+    means <- colMeans(x)
69 
+    results <- matrix(0,cols,cols)
70 
+    for (i in 1:cols-1)
71 
+      for (j in (i+1):cols){
72 
+        results[i,j] <- means[i] - means[j]
73 
+        results[j,i] <- means[j] - means[i]
74 
+      }
75 
+    results
76 
+  }
77 
+
78 
+  use.huber <- FALSE
79 
+  remove.extreme <- match.arg(remove.extreme)
80 
+
81 
+  rows <- dim(x)[1]
82 
+  cols <- dim(x)[2]
83 
+
84 
+  if (is.null(weights)){
85 
+    weights <- .Call("R_qnorm_robust_weights",x,remove.extreme,as.integer(n.remove),PACKAGE="preprocessCore")
86 
+  } else {
87 
+    if (is.numeric(weights)){
88 
+      if (length(weights) != cols){
89 
+        stop("Weights vector incorrect length\n")
90 
+      }
91 
+      if (sum(weights > 0) < 1){
92 
+        stop("Need at least one non negative weights\n")
93 
+      }
94 
+      if (any(weights < 0)){
95 
+        stop("Can't have negative weights")
96 
+      }
97 
+    } else {
98 
+      if (weights =="huber"){
99 
+        use.huber <- TRUE
100 
+        weights <- rep(1,cols)
101 
+      } else {
102 
+        stop("Don't recognise weights argument as valid.")
103 
+      }
104 
+    }
105 
+  }
106 
+
107 
+  .Call("R_qnorm_robust_c",x,copy,weights,as.integer(use.median),as.integer(use.log2),as.integer(use.huber),PACKAGE="preprocessCore")
108 
+}