1. preprocessCore
  2. Commit b8e8c2d1d4528618f31e4ba64a56c5ef345dbb61
Browse code

add subColSummarize* functions

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/preprocessCore@27306 bc3139a8-67e5-0310-9ffc-ced21a209358

Ben Bolstad authored on 20/09/2007 02:58:55
Showing17 changed files
DESCRIPTION
History View file @b8e8c2d
... ... 
@@ -1,12 +1,12 @@
1 1 
 Package: preprocessCore
2 
-Version: 0.99.19
2 
+Version: 0.99.20
3 3 
 Title: A collection of pre-processing functions
4 4 
 Author: Benjamin Milo Bolstad <bmb@bmbolstad.com>
5 5 
 Maintainer: Benjamin Milo Bolstad <bmb@bmbolstad.com>
6 6 
 Depends: methods
7 7 
 Description: A library of core preprocessing routines
8 8 
 License: LGPL version 2 or newer
9 
-Collate:  normalize.quantiles.R quantile_extensions.R rcModel.R colSummarize.R init.R
9 
+Collate:  normalize.quantiles.R quantile_extensions.R rcModel.R colSummarize.R subColSummarize.R init.R
10 10 
 LazyLoad: yes
11 11 
 biocViews: Infrastructure
12 12
R/subColSummarize.R
History View file @b8e8c2d
13 13 
new file mode 100644
... ... 
@@ -0,0 +1,193 @@
1 
+##
2 
+## file: subColSummarize.R
3 
+##
4 
+## Author: B. M. Bolstad <bmb@bmbolstad.com>
5 
+##
6 
+## History
7 
+## Sept 18, 2007 - Initial verison
8 
+##
9 
+
10 
+
11 
+convert.group.labels <- function(group.labels){
12 
+
13 
+  if (!is.factor(group.labels))
14 
+    group.labels <- as.factor(group.labels)
15 
+
16 
+  split(0:(length(group.labels) -1),group.labels)
17 
+
18 
+}
19 
+
20 
+
21 
+
22 
+
23 
+subColSummarizeAvgLog <- function(y, group.labels){
24 
+  if (!is.matrix(y))
25 
+    stop("argument should be matrix")
26 
+
27 
+  if (!is.double(y) & is.numeric(y))
28 
+    y <- matrix(as.double(y),dim(y)[1],dim(y)[2])
29 
+  else if (!is.numeric(y))
30 
+    stop("argument should be numeric matrix")
31 
+
32 
+  rowIndexList <- convert.group.labels(group.labels)
33 
+
34 
+  .Call("R_subColSummarize_avg_log", y, rowIndexList, PACKAGE="preprocessCore")
35 
+}
36 
+
37 
+
38 
+
39 
+
40 
+
41 
+subColSummarizeLogAvg <- function(y, group.labels){
42 
+  if (!is.matrix(y))
43 
+    stop("argument should be matrix")
44 
+
45 
+  if (!is.double(y) & is.numeric(y))
46 
+    y <- matrix(as.double(y),dim(y)[1],dim(y)[2])
47 
+  else if (!is.numeric(y))
48 
+    stop("argument should be numeric matrix")
49 
+
50 
+  rowIndexList <- convert.group.labels(group.labels)
51 
+
52 
+  .Call("R_subColSummarize_log_avg", y, rowIndexList, PACKAGE="preprocessCore")
53 
+}
54 
+
55 
+
56 
+
57 
+
58 
+subColSummarizeAvg <- function(y, group.labels){
59 
+  if (!is.matrix(y))
60 
+    stop("argument should be matrix")
61 
+
62 
+  if (!is.double(y) & is.numeric(y))
63 
+    y <- matrix(as.double(y),dim(y)[1],dim(y)[2])
64 
+  else if (!is.numeric(y))
65 
+    stop("argument should be numeric matrix")
66 
+
67 
+  rowIndexList <- convert.group.labels(group.labels)
68 
+
69 
+  .Call("R_subColSummarize_avg", y, rowIndexList, PACKAGE="preprocessCore")
70 
+}
71 
+
72 
+
73 
+
74 
+
75 
+subColSummarizeBiweightLog <- function(y, group.labels){
76 
+  if (!is.matrix(y))
77 
+    stop("argument should be matrix")
78 
+
79 
+  if (!is.double(y) & is.numeric(y))
80 
+    y <- matrix(as.double(y),dim(y)[1],dim(y)[2])
81 
+  else if (!is.numeric(y))
82 
+    stop("argument should be numeric matrix")
83 
+
84 
+  rowIndexList <- convert.group.labels(group.labels)
85 
+
86 
+  .Call("R_subColSummarize_biweight_log", y, rowIndexList, PACKAGE="preprocessCore")
87 
+}
88 
+
89 
+
90 
+
91 
+
92 
+subColSummarizeBiweight <- function(y, group.labels){
93 
+  if (!is.matrix(y))
94 
+    stop("argument should be matrix")
95 
+
96 
+  if (!is.double(y) & is.numeric(y))
97 
+    y <- matrix(as.double(y),dim(y)[1],dim(y)[2])
98 
+  else if (!is.numeric(y))
99 
+    stop("argument should be numeric matrix")
100 
+
101 
+  rowIndexList <- convert.group.labels(group.labels)
102 
+
103 
+  .Call("R_subColSummarize_biweight", y, rowIndexList, PACKAGE="preprocessCore")
104 
+}
105 
+
106 
+
107 
+
108 
+
109 
+
110 
+subColSummarizeMedianLog <- function(y, group.labels){
111 
+  if (!is.matrix(y))
112 
+    stop("argument should be matrix")
113 
+
114 
+  if (!is.double(y) & is.numeric(y))
115 
+    y <- matrix(as.double(y),dim(y)[1],dim(y)[2])
116 
+  else if (!is.numeric(y))
117 
+    stop("argument should be numeric matrix")
118 
+
119 
+  rowIndexList <- convert.group.labels(group.labels)
120 
+
121 
+  .Call("R_subColSummarize_median_log", y, rowIndexList, PACKAGE="preprocessCore")
122 
+}
123 
+
124 
+
125 
+
126 
+
127 
+
128 
+subColSummarizeLogMedian <- function(y, group.labels){
129 
+  if (!is.matrix(y))
130 
+    stop("argument should be matrix")
131 
+
132 
+  if (!is.double(y) & is.numeric(y))
133 
+    y <- matrix(as.double(y),dim(y)[1],dim(y)[2])
134 
+  else if (!is.numeric(y))
135 
+    stop("argument should be numeric matrix")
136 
+
137 
+  rowIndexList <- convert.group.labels(group.labels)
138 
+
139 
+  .Call("R_subColSummarize_log_median", y, rowIndexList, PACKAGE="preprocessCore")
140 
+}
141 
+
142 
+
143 
+
144 
+
145 
+subColSummarizeMedian <- function(y, group.labels){
146 
+  if (!is.matrix(y))
147 
+    stop("argument should be matrix")
148 
+
149 
+  if (!is.double(y) & is.numeric(y))
150 
+    y <- matrix(as.double(y),dim(y)[1],dim(y)[2])
151 
+  else if (!is.numeric(y))
152 
+    stop("argument should be numeric matrix")
153 
+
154 
+  rowIndexList <- convert.group.labels(group.labels)
155 
+
156 
+  .Call("R_subColSummarize_median", y, rowIndexList, PACKAGE="preprocessCore")
157 
+}
158 
+
159 
+
160 
+
161 
+
162 
+
163 
+
164 
+
165 
+subColSummarizeMedianpolishLog <- function(y, group.labels){
166 
+  if (!is.matrix(y))
167 
+    stop("argument should be matrix")
168 
+
169 
+  if (!is.double(y) & is.numeric(y))
170 
+    y <- matrix(as.double(y),dim(y)[1],dim(y)[2])
171 
+  else if (!is.numeric(y))
172 
+    stop("argument should be numeric matrix")
173 
+
174 
+  rowIndexList <- convert.group.labels(group.labels)
175 
+
176 
+  .Call("R_subColSummarize_medianpolish_log", y, rowIndexList, PACKAGE="preprocessCore")
177 
+}
178 
+
179 
+
180 
+subColSummarizeMedianpolish <- function(y, group.labels){
181 
+  if (!is.matrix(y))
182 
+    stop("argument should be matrix")
183 
+
184 
+  if (!is.double(y) & is.numeric(y))
185 
+    y <- matrix(as.double(y),dim(y)[1],dim(y)[2])
186 
+  else if (!is.numeric(y))
187 
+    stop("argument should be numeric matrix")
188 
+
189 
+  rowIndexList <- convert.group.labels(group.labels)
190 
+
191 
+  .Call("R_subColSummarize_medianpolish", y, rowIndexList, PACKAGE="preprocessCore")
192 
+}
193 
+
inst/include/log_avg.h
History View file @b8e8c2d
... ... 
@@ -3,5 +3,6 @@
3 3
4 4 
 void logaverage(double *data, int rows, int cols, double *results, double *resultsSE);
5 5 
 void LogAverage(double *data, int rows, int cols, int *cur_rows, double *results, int nprobes, double *resultsSE);
6 
+void LogAverage_noSE(double *data, int rows, int cols, int *cur_rows, double *results, int nprobes);
6 7
7 8 
 #endif
man/colSummarize.Rd
History View file @b8e8c2d
... ... 
@@ -9,7 +9,7 @@
9 9 
 \alias{colSummarizeMedianLog}
10 10 
 \alias{colSummarizeMedianpolish}
11 11 
 \alias{colSummarizeMedianpolishLog}
12 
-}
12 
+
13 13 
 \title{Summarize the column of matrices}
14 14 
 \description{Compute column wise summary values of a matrix.
15 15 
 }
man/subColSummarize.Rd
History View file @b8e8c2d
16 16 
new file mode 100644
... ... 
@@ -0,0 +1,94 @@
1 
+\name{subColSummarize}
2 
+\alias{subColSummarizeAvg}
3 
+\alias{subColSummarizeAvgLog}
4 
+\alias{subColSummarizeBiweight}
5 
+\alias{subColSummarizeBiweightLog}
6 
+\alias{subColSummarizeLogAvg}
7 
+\alias{subColSummarizeLogMedian}
8 
+\alias{subColSummarizeMedian}
9 
+\alias{subColSummarizeMedianLog}
10 
+\alias{subColSummarizeMedianpolish}
11 
+\alias{subColSummarizeMedianpolishLog}
12 
+\alias{convert.group.labels}
13 
+\title{Summarize columns when divided into groups of rows}
14 
+\description{These functions summarize columns of a matrix when the rows
15 
+  of the matrix are classified into different groups
16 
+}
17 
+\usage{subColSummarizeAvg(y, group.labels)
18 
+       subColSummarizeAvgLog(y, group.labels)
19 
+       subColSummarizeBiweight(y, group.labels)
20 
+       subColSummarizeBiweightLog(y, group.labels)
21 
+       subColSummarizeLogAvg(y, group.labels)
22 
+       subColSummarizeLogMedian(y, group.labels)
23 
+       subColSummarizeMedian(y, group.labels)
24 
+       subColSummarizeMedianLog(y, group.labels)
25 
+       subColSummarizeMedianpolish(y, group.labels)
26 
+       subColSummarizeMedianpolishLog(y, group.labels)
27 
+       convert.group.labels(group.labels)
28 
+}
29 
+\arguments{
30 
+  \item{y}{A numeric \code{\link{matrix}}}
31 
+  \item{group.labels}{A vector to be treated as a factor variable. This
32 
+    is used to assign each row to a group. NA values should be used to
33 
+    exclude rows from consideration}
34 
+}
35 
+\value{
36 
+  A \code{\link{matrix}} containing column summarized data. Each row
37 
+  corresponds to data column summarized over a group of rows.
38 
+}
39 
+\details{
40 
+  These functions are designed to summarize the columns of a matrix
41 
+  where the rows of the matrix are assigned to groups. The summarization
42 
+  is by column across all rows in each group.
43 
+  \itemize{
44 
+    \item{subColSummarizeAvg}{Summarize by taking mean}
45 
+    \item{subColSummarizeAvgLog}{\code{log2} transform the data and
46 
+      then take means in column-wise manner}
47 
+    \item{subColSummarizeBiweight}{Use a one-step Tukey Biweight to
48 
+      summarize columns}
49 
+    \item{subColSummarizeBiweightLog}{\code{log2} transform the data and
50 
+      then use a one-step Tukey Biweight to
51 
+      summarize columns}
52 
+    \item{subColSummarizeLogAvg}{Summarize by taking mean and then
53 
+      taking \code{log2}}
54 
+    \item{subColSummarizeLogMedian}{Summarize by taking median and then
55 
+      taking \code{log2}}
56 
+    \item{subColSummarizeMedian}{Summarize by taking median}
57 
+    \item{subColSummarizeMedianLog}{\code{log2} transform the data and
58 
+      then summarize by taking median}
59 
+    \item{subColSummarizeMedianpolish}{Use the median polish to
60 
+      summarize each column, by also using a row effect (not returned)}
61 
+    \item{subColSummarizeMedianpolishLog}{\code{log2} transform the
62 
+      data and then use the median polish to summarize each column, by
63 
+      also using a row effect (not returned)}
64 
+  }
65 
+
66 
+}
67 
+\examples{
68 
+### Assign the first 10 rows to one group and
69 
+### the second 10 rows to the second group
70 
+###
71 
+y <- matrix(c(10+rnorm(50),20+rnorm(50)),20,5,byrow=TRUE)
72 
+
73 
+subColSummarizeAvgLog(y,c(rep(1,10),rep(2,10)))
74 
+subColSummarizeLogAvg(y,c(rep(1,10),rep(2,10)))
75 
+subColSummarizeAvg(y,c(rep(1,10),rep(2,10)))
76 
+
77 
+subColSummarizeBiweight(y,c(rep(1,10),rep(2,10)))
78 
+subColSummarizeBiweightLog(y,c(rep(1,10),rep(2,10)))
79 
+
80 
+subColSummarizeMedianLog(y,c(rep(1,10),rep(2,10)))
81 
+subColSummarizeLogMedian(y,c(rep(1,10),rep(2,10)))
82 
+subColSummarizeMedian(y,c(rep(1,10),rep(2,10)))
83 
+
84 
+
85 
+
86 
+subColSummarizeMedianpolishLog(y,c(rep(1,10),rep(2,10)))
87 
+subColSummarizeMedianpolish(y,c(rep(1,10),rep(2,10)))
88 
+
89 
+
90 
+
91 
+
92 
+}
93 
+\author{B. M. Bolstad <bmb@bmbolstad.com>}
94 
+\keyword{univar}
0 95 
\ No newline at end of file
src/R_colSummarize.c
History View file @b8e8c2d
... ... 
@@ -1,6 +1,6 @@
1 1 
 /*********************************************************************
2 2 
  **
3 
- ** file: R_rlm_interfaces.c
3 
+ ** file: R_colSummarize.c
4 4 
  **
5 5 
  ** Aim: Code which provides .Call() interfaces to the column
6 6 
  ** summarization code.
src/R_subColSummarize.c
History View file @b8e8c2d
7 7 
new file mode 100644
... ... 
@@ -0,0 +1,489 @@
1 
+/*********************************************************************
2 
+ **
3 
+ ** file: R_subColSummarize.c
4 
+ **
5 
+ ** Aim: Code which provides .Call() interfaces to the subcolumn
6 
+ ** summarization code.
7 
+ **
8 
+ ** Copyright (C) 2007 Ben Bolstad
9 
+ **
10 
+ ** created by: B. M. Bolstad <bmb@bmbolstad.com>
11 
+ **
12 
+ ** created on: Sep 15, 2007
13 
+ **
14 
+ ** History
15 
+ ** Sep 18, 2007 - Initial version
16 
+ **
17 
+ **
18 
+ *********************************************************************/
19 
+
20 
+#include <R.h>
21 
+#include <Rdefines.h>
22 
+#include <Rmath.h>
23 
+#include <Rinternals.h>
24 
+
25 
+
26 
+#include "avg_log.h"
27 
+#include "log_avg.h"
28 
+#include "avg.h"
29 
+
30 
+#include "biweight.h"
31 
+
32 
+#include "median_log.h"
33 
+#include "log_median.h"
34 
+#include "median.h"
35 
+
36 
+#include "medianpolish.h"
37 
+
38 
+
39 
+
40 
+SEXP R_subColSummarize_avg_log(SEXP RMatrix, SEXP R_rowIndexList){
41 
+
42 
+  SEXP R_summaries;
43 
+  SEXP dim1;
44 
+
45 
+  double *matrix=NUMERIC_POINTER(RMatrix);
46 
+  double *results, *buffer;
47 
+
48 
+  int *cur_rows;
49 
+
50 
+  int rows, cols;
51 
+  int length_rowIndexList = LENGTH(R_rowIndexList);
52 
+  int ncur_rows;
53 
+
54 
+  int i,j;
55 
+
56 
+  PROTECT(dim1 = getAttrib(RMatrix,R_DimSymbol));
57 
+  rows = INTEGER(dim1)[0];
58 
+  cols = INTEGER(dim1)[1];
59 
+  UNPROTECT(1);
60 
+
61 
+  PROTECT(R_summaries = allocMatrix(REALSXP,length_rowIndexList,cols));
62 
+
63 
+  results = NUMERIC_POINTER(R_summaries);
64 
+
65 
+  buffer = Calloc(cols,double);
66 
+
67 
+  for (j =0; j < length_rowIndexList; j++){
68 
+    ncur_rows = LENGTH(VECTOR_ELT(R_rowIndexList,j));
69 
+    cur_rows = INTEGER_POINTER(VECTOR_ELT(R_rowIndexList,j));
70 
+    AverageLog_noSE(matrix, rows, cols, cur_rows, buffer, ncur_rows);
71 
+
72 
+    for (i = 0; i < cols; i++){
73 
+      results[i*length_rowIndexList + j] = buffer[i];
74 
+    }
75 
+  }
76 
+
77 
+  Free(buffer);
78 
+  UNPROTECT(1);
79 
+  return R_summaries;
80 
+}
81 
+
82 
+
83 
+SEXP R_subColSummarize_log_avg(SEXP RMatrix, SEXP R_rowIndexList){
84 
+
85 
+  SEXP R_summaries;
86 
+  SEXP dim1;
87 
+
88 
+  double *matrix=NUMERIC_POINTER(RMatrix);
89 
+  double *results, *buffer;
90 
+
91 
+  int *cur_rows;
92 
+
93 
+  int rows, cols;
94 
+  int length_rowIndexList = LENGTH(R_rowIndexList);
95 
+  int ncur_rows;
96 
+
97 
+  int i,j;
98 
+
99 
+  PROTECT(dim1 = getAttrib(RMatrix,R_DimSymbol));
100 
+  rows = INTEGER(dim1)[0];
101 
+  cols = INTEGER(dim1)[1];
102 
+  UNPROTECT(1);
103 
+
104 
+  PROTECT(R_summaries = allocMatrix(REALSXP,length_rowIndexList,cols));
105 
+
106 
+  results = NUMERIC_POINTER(R_summaries);
107 
+
108 
+  buffer = Calloc(cols,double);
109 
+
110 
+  for (j =0; j < length_rowIndexList; j++){
111 
+    ncur_rows = LENGTH(VECTOR_ELT(R_rowIndexList,j));
112 
+    cur_rows = INTEGER_POINTER(VECTOR_ELT(R_rowIndexList,j));
113 
+    LogAverage_noSE(matrix, rows, cols, cur_rows, buffer, ncur_rows);
114 
+
115 
+    for (i = 0; i < cols; i++){
116 
+      results[i*length_rowIndexList + j] = buffer[i];
117 
+    }
118 
+  }
119 
+
120 
+  Free(buffer);
121 
+  UNPROTECT(1);
122 
+  return R_summaries;
123 
+}
124 
+
125 
+
126 
+SEXP R_subColSummarize_avg(SEXP RMatrix, SEXP R_rowIndexList){
127 
+
128 
+  SEXP R_summaries;
129 
+  SEXP dim1;
130 
+
131 
+  double *matrix=NUMERIC_POINTER(RMatrix);
132 
+  double *results, *buffer;
133 
+
134 
+  int *cur_rows;
135 
+
136 
+  int rows, cols;
137 
+  int length_rowIndexList = LENGTH(R_rowIndexList);
138 
+  int ncur_rows;
139 
+
140 
+  int i,j;
141 
+
142 
+  PROTECT(dim1 = getAttrib(RMatrix,R_DimSymbol));
143 
+  rows = INTEGER(dim1)[0];
144 
+  cols = INTEGER(dim1)[1];
145 
+  UNPROTECT(1);
146 
+
147 
+  PROTECT(R_summaries = allocMatrix(REALSXP,length_rowIndexList,cols));
148 
+
149 
+  results = NUMERIC_POINTER(R_summaries);
150 
+
151 
+  buffer = Calloc(cols,double);
152 
+
153 
+  for (j =0; j < length_rowIndexList; j++){
154 
+    ncur_rows = LENGTH(VECTOR_ELT(R_rowIndexList,j));
155 
+    cur_rows = INTEGER_POINTER(VECTOR_ELT(R_rowIndexList,j));
156 
+    ColAverage_noSE(matrix, rows, cols, cur_rows, buffer, ncur_rows);
157 
+
158 
+    for (i = 0; i < cols; i++){
159 
+      results[i*length_rowIndexList + j] = buffer[i];
160 
+    }
161 
+  }
162 
+
163 
+  Free(buffer);
164 
+  UNPROTECT(1);
165 
+  return R_summaries;
166 
+}
167 
+
168 
+
169 
+
170 
+
171 
+
172 
+
173 
+SEXP R_subColSummarize_biweight_log(SEXP RMatrix, SEXP R_rowIndexList){
174 
+
175 
+  SEXP R_summaries;
176 
+  SEXP dim1;
177 
+
178 
+  double *matrix=NUMERIC_POINTER(RMatrix);
179 
+  double *results, *buffer;
180 
+
181 
+  int *cur_rows;
182 
+
183 
+  int rows, cols;
184 
+  int length_rowIndexList = LENGTH(R_rowIndexList);
185 
+  int ncur_rows;
186 
+
187 
+  int i,j;
188 
+
189 
+  PROTECT(dim1 = getAttrib(RMatrix,R_DimSymbol));
190 
+  rows = INTEGER(dim1)[0];
191 
+  cols = INTEGER(dim1)[1];
192 
+  UNPROTECT(1);
193 
+
194 
+  PROTECT(R_summaries = allocMatrix(REALSXP,length_rowIndexList,cols));
195 
+
196 
+  results = NUMERIC_POINTER(R_summaries);
197 
+
198 
+  buffer = Calloc(cols,double);
199 
+
200 
+  for (j =0; j < length_rowIndexList; j++){
201 
+    ncur_rows = LENGTH(VECTOR_ELT(R_rowIndexList,j));
202 
+    cur_rows = INTEGER_POINTER(VECTOR_ELT(R_rowIndexList,j));
203 
+    TukeyBiweight_noSE(matrix, rows, cols, cur_rows, buffer, ncur_rows);
204 
+
205 
+    for (i = 0; i < cols; i++){
206 
+      results[i*length_rowIndexList + j] = buffer[i];
207 
+    }
208 
+  }
209 
+
210 
+  Free(buffer);
211 
+  UNPROTECT(1);
212 
+  return R_summaries;
213 
+}
214 
+
215 
+
216 
+
217 
+
218 
+SEXP R_subColSummarize_biweight(SEXP RMatrix, SEXP R_rowIndexList){
219 
+
220 
+  SEXP R_summaries;
221 
+  SEXP dim1;
222 
+
223 
+  double *matrix=NUMERIC_POINTER(RMatrix);
224 
+  double *results, *buffer;
225 
+
226 
+  int *cur_rows;
227 
+
228 
+  int rows, cols;
229 
+  int length_rowIndexList = LENGTH(R_rowIndexList);
230 
+  int ncur_rows;
231 
+
232 
+  int i,j;
233 
+
234 
+  PROTECT(dim1 = getAttrib(RMatrix,R_DimSymbol));
235 
+  rows = INTEGER(dim1)[0];
236 
+  cols = INTEGER(dim1)[1];
237 
+  UNPROTECT(1);
238 
+
239 
+  PROTECT(R_summaries = allocMatrix(REALSXP,length_rowIndexList,cols));
240 
+
241 
+  results = NUMERIC_POINTER(R_summaries);
242 
+
243 
+  buffer = Calloc(cols,double);
244 
+
245 
+  for (j =0; j < length_rowIndexList; j++){
246 
+    ncur_rows = LENGTH(VECTOR_ELT(R_rowIndexList,j));
247 
+    cur_rows = INTEGER_POINTER(VECTOR_ELT(R_rowIndexList,j));
248 
+    TukeyBiweight_no_log_noSE(matrix, rows, cols, cur_rows, buffer, ncur_rows);
249 
+
250 
+    for (i = 0; i < cols; i++){
251 
+      results[i*length_rowIndexList + j] = buffer[i];
252 
+    }
253 
+  }
254 
+
255 
+  Free(buffer);
256 
+  UNPROTECT(1);
257 
+  return R_summaries;
258 
+}
259 
+
260 
+
261 
+
262 
+
263 
+
264 
+
265 
+SEXP R_subColSummarize_median_log(SEXP RMatrix, SEXP R_rowIndexList){
266 
+
267 
+  SEXP R_summaries;
268 
+  SEXP dim1;
269 
+
270 
+  double *matrix=NUMERIC_POINTER(RMatrix);
271 
+  double *results, *buffer;
272 
+
273 
+  int *cur_rows;
274 
+
275 
+  int rows, cols;
276 
+  int length_rowIndexList = LENGTH(R_rowIndexList);
277 
+  int ncur_rows;
278 
+
279 
+  int i,j;
280 
+
281 
+  PROTECT(dim1 = getAttrib(RMatrix,R_DimSymbol));
282 
+  rows = INTEGER(dim1)[0];
283 
+  cols = INTEGER(dim1)[1];
284 
+  UNPROTECT(1);
285 
+
286 
+  PROTECT(R_summaries = allocMatrix(REALSXP,length_rowIndexList,cols));
287 
+
288 
+  results = NUMERIC_POINTER(R_summaries);
289 
+
290 
+  buffer = Calloc(cols,double);
291 
+
292 
+  for (j =0; j < length_rowIndexList; j++){
293 
+    ncur_rows = LENGTH(VECTOR_ELT(R_rowIndexList,j));
294 
+    cur_rows = INTEGER_POINTER(VECTOR_ELT(R_rowIndexList,j));
295 
+    MedianLog_noSE(matrix, rows, cols, cur_rows, buffer, ncur_rows);
296 
+
297 
+    for (i = 0; i < cols; i++){
298 
+      results[i*length_rowIndexList + j] = buffer[i];
299 
+    }
300 
+  }
301 
+
302 
+  Free(buffer);
303 
+  UNPROTECT(1);
304 
+  return R_summaries;
305 
+}
306 
+
307 
+
308 
+
309 
+
310 
+
311 
+SEXP R_subColSummarize_log_median(SEXP RMatrix, SEXP R_rowIndexList){
312 
+
313 
+  SEXP R_summaries;
314 
+  SEXP dim1;
315 
+
316 
+  double *matrix=NUMERIC_POINTER(RMatrix);
317 
+  double *results, *buffer;
318 
+
319 
+  int *cur_rows;
320 
+
321 
+  int rows, cols;
322 
+  int length_rowIndexList = LENGTH(R_rowIndexList);
323 
+  int ncur_rows;
324 
+
325 
+  int i,j;
326 
+
327 
+  PROTECT(dim1 = getAttrib(RMatrix,R_DimSymbol));
328 
+  rows = INTEGER(dim1)[0];
329 
+  cols = INTEGER(dim1)[1];
330 
+  UNPROTECT(1);
331 
+
332 
+  PROTECT(R_summaries = allocMatrix(REALSXP,length_rowIndexList,cols));
333 
+
334 
+  results = NUMERIC_POINTER(R_summaries);
335 
+
336 
+  buffer = Calloc(cols,double);
337 
+
338 
+  for (j =0; j < length_rowIndexList; j++){
339 
+    ncur_rows = LENGTH(VECTOR_ELT(R_rowIndexList,j));
340 
+    cur_rows = INTEGER_POINTER(VECTOR_ELT(R_rowIndexList,j));
341 
+    LogMedian_noSE(matrix, rows, cols, cur_rows, buffer, ncur_rows);
342 
+
343 
+    for (i = 0; i < cols; i++){
344 
+      results[i*length_rowIndexList + j] = buffer[i];
345 
+    }
346 
+  }
347 
+
348 
+  Free(buffer);
349 
+  UNPROTECT(1);
350 
+  return R_summaries;
351 
+}
352 
+
353 
+
354 
+
355 
+
356 
+SEXP R_subColSummarize_median(SEXP RMatrix, SEXP R_rowIndexList){
357 
+
358 
+  SEXP R_summaries;
359 
+  SEXP dim1;
360 
+
361 
+  double *matrix=NUMERIC_POINTER(RMatrix);
362 
+  double *results, *buffer;
363 
+
364 
+  int *cur_rows;
365 
+
366 
+  int rows, cols;
367 
+  int length_rowIndexList = LENGTH(R_rowIndexList);
368 
+  int ncur_rows;
369 
+
370 
+  int i,j;
371 
+
372 
+  PROTECT(dim1 = getAttrib(RMatrix,R_DimSymbol));
373 
+  rows = INTEGER(dim1)[0];
374 
+  cols = INTEGER(dim1)[1];
375 
+  UNPROTECT(1);
376 
+
377 
+  PROTECT(R_summaries = allocMatrix(REALSXP,length_rowIndexList,cols));
378 
+
379 
+  results = NUMERIC_POINTER(R_summaries);
380 
+
381 
+  buffer = Calloc(cols,double);
382 
+
383 
+  for (j =0; j < length_rowIndexList; j++){
384 
+    ncur_rows = LENGTH(VECTOR_ELT(R_rowIndexList,j));
385 
+    cur_rows = INTEGER_POINTER(VECTOR_ELT(R_rowIndexList,j));
386 
+    ColMedian_noSE(matrix, rows, cols, cur_rows, buffer, ncur_rows);
387 
+
388 
+    for (i = 0; i < cols; i++){
389 
+      results[i*length_rowIndexList + j] = buffer[i];
390 
+    }
391 
+  }
392 
+
393 
+  Free(buffer);
394 
+  UNPROTECT(1);
395 
+  return R_summaries;
396 
+}
397 
+
398 
+
399 
+
400 
+
401 
+SEXP R_subColSummarize_medianpolish_log(SEXP RMatrix, SEXP R_rowIndexList){
402 
+
403 
+  SEXP R_summaries;
404 
+  SEXP dim1;
405 
+
406 
+  double *matrix=NUMERIC_POINTER(RMatrix);
407 
+  double *results, *buffer, *buffer2;
408 
+
409 
+  int *cur_rows;
410 
+
411 
+  int rows, cols;
412 
+  int length_rowIndexList = LENGTH(R_rowIndexList);
413 
+  int ncur_rows;
414 
+
415 
+  int i,j;
416 
+
417 
+  PROTECT(dim1 = getAttrib(RMatrix,R_DimSymbol));
418 
+  rows = INTEGER(dim1)[0];
419 
+  cols = INTEGER(dim1)[1];
420 
+  UNPROTECT(1);
421 
+
422 
+  PROTECT(R_summaries = allocMatrix(REALSXP,length_rowIndexList,cols));
423 
+
424 
+  results = NUMERIC_POINTER(R_summaries);
425 
+
426 
+  buffer = Calloc(cols,double);
427 
+  buffer2 = Calloc(cols,double);
428 
+
429 
+  for (j =0; j < length_rowIndexList; j++){
430 
+    ncur_rows = LENGTH(VECTOR_ELT(R_rowIndexList,j));
431 
+    cur_rows = INTEGER_POINTER(VECTOR_ELT(R_rowIndexList,j));
432 
+    MedianPolish(matrix, rows, cols, cur_rows, buffer, ncur_rows, buffer2);
433 
+
434 
+    for (i = 0; i < cols; i++){
435 
+      results[i*length_rowIndexList + j] = buffer[i];
436 
+    }
437 
+  }
438 
+   Free(buffer2);
439 
+  Free(buffer);
440 
+  UNPROTECT(1);
441 
+  return R_summaries;
442 
+}
443 
+
444 
+
445 
+
446 
+
447 
+
448 
+SEXP R_subColSummarize_medianpolish(SEXP RMatrix, SEXP R_rowIndexList){
449 
+
450 
+  SEXP R_summaries;
451 
+  SEXP dim1;
452 
+
453 
+  double *matrix=NUMERIC_POINTER(RMatrix);
454 
+  double *results, *buffer, *buffer2;
455 
+
456 
+  int *cur_rows;
457 
+
458 
+  int rows, cols;
459 
+  int length_rowIndexList = LENGTH(R_rowIndexList);
460 
+  int ncur_rows;
461 
+
462 
+  int i,j;
463 
+
464 
+  PROTECT(dim1 = getAttrib(RMatrix,R_DimSymbol));
465 
+  rows = INTEGER(dim1)[0];
466 
+  cols = INTEGER(dim1)[1];
467 
+  UNPROTECT(1);
468 
+
469 
+  PROTECT(R_summaries = allocMatrix(REALSXP,length_rowIndexList,cols));
470 
+
471 
+  results = NUMERIC_POINTER(R_summaries);
472 
+
473 
+  buffer = Calloc(cols,double);
474 
+  buffer2 = Calloc(cols,double);
475 
+
476 
+  for (j =0; j < length_rowIndexList; j++){
477 
+    ncur_rows = LENGTH(VECTOR_ELT(R_rowIndexList,j));
478 
+    cur_rows = INTEGER_POINTER(VECTOR_ELT(R_rowIndexList,j));
479 
+    MedianPolish_no_log(matrix, rows, cols, cur_rows, buffer, ncur_rows, buffer2);
480 
+
481 
+    for (i = 0; i < cols; i++){
482 
+      results[i*length_rowIndexList + j] = buffer[i];
483 
+    }
484 
+  }
485 
+   Free(buffer2);
486 
+  Free(buffer);
487 
+  UNPROTECT(1);
488 
+  return R_summaries;
489 
+}
src/R_subColSummarize.h
History View file @b8e8c2d
0 490 
new file mode 100644
... ... 
@@ -0,0 +1,16 @@
1 
+#ifndef R_SUBCOLSUMMARIZE_H
2 
+#define R_SUBCOLSUMMARIZE_H
3 
+
4 
+SEXP R_subColSummarize_avg_log(SEXP RMatrix, SEXP R_rowIndexList);
5 
+SEXP R_subColSummarize_log_avg(SEXP RMatrix, SEXP R_rowIndexList);
6 
+SEXP R_subColSummarize_avg(SEXP RMatrix, SEXP R_rowIndexList);
7 
+SEXP R_subColSummarize_biweight_log(SEXP RMatrix, SEXP R_rowIndexList);
8 
+SEXP R_subColSummarize_biweight(SEXP RMatrix, SEXP R_rowIndexList);
9 
+SEXP R_subColSummarize_median_log(SEXP RMatrix, SEXP R_rowIndexList);
10 
+SEXP R_subColSummarize_log_median(SEXP RMatrix, SEXP R_rowIndexList);
11 
+SEXP R_subColSummarize_median(SEXP RMatrix, SEXP R_rowIndexList);
12 
+SEXP R_subColSummarize_medianpolish_log(SEXP RMatrix, SEXP R_rowIndexList);
13 
+SEXP R_subColSummarize_medianpolish(SEXP RMatrix, SEXP R_rowIndexList);
14 
+
15 
+
16 
+#endif
src/biweight.c
History View file @b8e8c2d
... ... 
@@ -27,6 +27,7 @@
27 27 
  ** Apr 5, 2004 - Change mallocs to Callocs
28 28 
  ** May 19, 2007 - branch out of affyPLM into a new package preprocessCore, then restructure the code. Add doxygen style documentation
29 29 
  ** Sep 16, 2007 - fix bug in tukeybiweight
30 
+ ** Sep 19, 2007 - add TukeyBiweight_noSE
30 31 
  **
31 32 
  ************************************************************************/
32 33
... ... 
@@ -286,3 +287,31 @@ void TukeyBiweight(double *data, int rows, int cols, int *cur_rows, double *resu
286 287 
 }
287 288
288 289
290 
+
291 
+void TukeyBiweight_noSE(double *data, int rows, int cols, int *cur_rows, double *results, int nprobes){
292 
+  int i,j;
293 
+  double *z = Calloc(nprobes,double);
294 
+
295 
+  for (j = 0; j < cols; j++){
296 
+    for (i =0; i < nprobes; i++){
297 
+      z[i] = log(data[j*rows + cur_rows[i]])/log(2.0);
298 
+    }
299 
+    results[j] = Tukey_Biweight(z,nprobes);
300 
+  }
301 
+  Free(z);
302 
+}
303 
+
304 
+
305 
+void TukeyBiweight_no_log_noSE(double *data, int rows, int cols, int *cur_rows, double *results, int nprobes){
306 
+  int i,j;
307 
+  double *z = Calloc(nprobes,double);
308 
+
309 
+  for (j = 0; j < cols; j++){
310 
+    for (i =0; i < nprobes; i++){
311 
+      z[i] = data[j*rows + cur_rows[i]];
312 
+    }
313 
+    results[j] = Tukey_Biweight(z,nprobes);
314 
+  }
315 
+  Free(z);
316 
+}
317 
+
src/biweight.h
History View file @b8e8c2d
... ... 
@@ -4,6 +4,9 @@
4 4 
 void tukeybiweight(double *data, int rows, int cols, double *results, double *resultsSE);
5 5 
 void tukeybiweight_no_log(double *data, int rows, int cols, double *results, double *resultsSE);
6 6 
 void TukeyBiweight(double *data, int rows, int cols, int *cur_rows, double *results, int nprobes, double *resultsSE);
7 
+void TukeyBiweight_noSE(double *data, int rows, int cols, int *cur_rows, double *results, int nprobes);
8 
+void TukeyBiweight_no_log_noSE(double *data, int rows, int cols, int *cur_rows, double *results, int nprobes);
9 
+
7 10 
 double Tukey_Biweight(double *x, int length);
8 11
9 12 
 #endif
src/init_package.c
History View file @b8e8c2d
... ... 
@@ -32,6 +32,7 @@
32 32
33 33 
 #include "R_rlm_interfaces.h"
34 34 
 #include "R_colSummarize.h"
35 
+#include "R_subColSummarize.h"
35 36
36 37 
 #include <R_ext/Rdynload.h>
37 38 
 #include <Rdefines.h>
... ... 
@@ -62,7 +63,19 @@ static const R_CallMethodDef callMethods[]  = {
62 63 
   {"R_colSummarize_avg",(DL_FUNC)&R_colSummarize_avg,1},
63 64 
   {"R_colSummarize_median",(DL_FUNC)&R_colSummarize_median,1},
64 65 
   {"R_colSummarize_biweight", (DL_FUNC)&R_colSummarize_biweight,1},
65 
-  {"R_colSummarize_medianpolish",(DL_FUNC)&R_colSummarize_medianpolish,1},{NULL, NULL, 0}
66 
+  {"R_colSummarize_medianpolish",(DL_FUNC)&R_colSummarize_medianpolish,1},
67 
+  {"R_subColSummarize_avg_log", (DL_FUNC)&R_subColSummarize_avg_log,2},
68 
+  {"R_subColSummarize_log_avg", (DL_FUNC)&R_subColSummarize_log_avg,2},
69 
+  {"R_subColSummarize_avg", (DL_FUNC)&R_subColSummarize_avg,2},
70 
+  {"R_subColSummarize_biweight_log", (DL_FUNC)&R_subColSummarize_biweight_log,2},
71 
+  {"R_subColSummarize_biweight", (DL_FUNC)&R_subColSummarize_biweight,2},
72 
+  {"R_subColSummarize_median_log", (DL_FUNC)&R_subColSummarize_median_log,2},
73 
+  {"R_subColSummarize_log_median", (DL_FUNC)&R_subColSummarize_log_median,2},
74 
+  {"R_subColSummarize_median",(DL_FUNC)&R_subColSummarize_median,2},
75 
+  {"R_subColSummarize_medianpolish_log",(DL_FUNC)&R_subColSummarize_medianpolish_log,2},
76 
+  {"R_subColSummarize_medianpolish",(DL_FUNC)&R_subColSummarize_medianpolish,2},
77 
+
78 
+  {NULL, NULL, 0}
66 79 
   };
67 80
68 81 
 void R_init_preprocessCore(DllInfo *info){
... ... 
@@ -114,6 +127,7 @@ void R_init_preprocessCore(DllInfo *info){
114 127
115 128 
   R_RegisterCCallable("preprocessCore","logaverage", (DL_FUNC)&logaverage);
116 129 
   R_RegisterCCallable("preprocessCore","LogAverage", (DL_FUNC)&LogAverage);
130 
+  R_RegisterCCallable("preprocessCore","LogAverage_noSE", (DL_FUNC)&LogAverage_noSE);
117 131
118 132 
   R_RegisterCCallable("preprocessCore","tukeybiweight", (DL_FUNC)&tukeybiweight);
119 133 
   R_RegisterCCallable("preprocessCore","TukeyBiweight", (DL_FUNC)&TukeyBiweight);
src/log_avg.c
History View file @b8e8c2d
... ... 
@@ -19,6 +19,7 @@
19 19 
  ** Jul 23, 2003 - parameter for storing SE added (not yet implemented)
20 20 
  ** Oct 5, 2003 - method of adding parameters.
21 21 
  ** May 19, 2007 - branch out of affyPLM into a new package preprocessCore, then restructure the code. Add doxygen style documentation
22 
+ ** Sep 19, 2007 - add LogAverage_noSE
22 23 
  **
23 24 
  ************************************************************************/
24 25
... ... 
@@ -144,3 +145,19 @@ void LogAverage(double *data, int rows, int cols, int *cur_rows, double *results
144 145 
 }
145 146
146 147
148 
+void LogAverage_noSE(double *data, int rows, int cols, int *cur_rows, double *results, int nprobes){
149 
+  int i,j;
150 
+  double *z = Calloc(nprobes*cols,double);
151 
+
152 
+  for (j = 0; j < cols; j++){
153 
+    for (i =0; i < nprobes; i++){
154 
+      z[j*nprobes + i] = data[j*rows + cur_rows[i]];
155 
+    }
156 
+  }
157 
+
158 
+  for (j=0; j < cols; j++){
159 
+    results[j] = LogAvg(&z[j*nprobes],nprobes);
160 
+  }
161 
+  Free(z);
162 
+}
163 
+
src/log_avg.h
History View file @b8e8c2d
... ... 
@@ -3,5 +3,6 @@
3 3
4 4 
 void logaverage(double *data, int rows, int cols, double *results, double *resultsSE);
5 5 
 void LogAverage(double *data, int rows, int cols, int *cur_rows, double *results, int nprobes, double *resultsSE);
6 
+void LogAverage_noSE(double *data, int rows, int cols, int *cur_rows, double *results, int nprobes);
6 7
7 8 
 #endif
src/log_median.c
History View file @b8e8c2d
... ... 
@@ -20,6 +20,7 @@
20 20 
  ** Jul 23, 2003 - add a parameter for storing SE (not yet implemented)
21 21 
  ** Oct 10, 2003 - PLM version of threestep
22 22 
  ** Sep 10, 2007 - move functionality out of affyPLM (and into preprocessCore)
23 
+ ** Sep 19, 2007 - add LogMedian_noSE
23 24 
  **
24 25 
  ************************************************************************/
25 26
... ... 
@@ -94,6 +95,26 @@ void LogMedian(double *data, int rows, int cols, int *cur_rows, double *results,
94 95
95 96
96 97
98 
+void LogMedian_noSE(double *data, int rows, int cols, int *cur_rows, double *results, int nprobes){
99 
+  int i,j;
100 
+  double *z = Calloc(nprobes*cols,double);
101 
+
102 
+  for (j = 0; j < cols; j++){
103 
+    for (i =0; i < nprobes; i++){
104 
+      z[j*nprobes + i] = data[j*rows + cur_rows[i]];
105 
+    }
106 
+  }
107 
+
108 
+  for (j=0; j < cols; j++){
109 
+    results[j] = log_median(&z[j*nprobes],nprobes);
110 
+  }
111 
+  Free(z);
112 
+}
113 
+
114 
+
115 
+
116 
+
117 
+
97 118
98 119
99 120 
 void logmedian(double *data, int rows, int cols, double *results, double *resultsSE){
src/log_median.h
History View file @b8e8c2d
... ... 
@@ -4,6 +4,7 @@
4 4
5 5
6 6 
 void LogMedian(double *data, int rows, int cols, int *cur_rows, double *results, int nprobes, double *resultsSE);
7 
+void LogMedian_noSE(double *data, int rows, int cols, int *cur_rows, double *results, int nprobes);
7 8
8 9 
 void logmedian(double *data, int rows, int cols, double *results, double *resultsSE);
9 10 
 void logmedian_no_copy(double *data, int rows, int cols, double *results, double *resultsSE);
src/medianpolish.c
History View file @b8e8c2d
... ... 
@@ -378,3 +378,25 @@ void MedianPolish(double *data, int rows, int cols, int *cur_rows, double *resul
378 378
379 379 
 }
380 380
381 
+
382 
+
383 
+void MedianPolish_no_log(double *data, int rows, int cols, int *cur_rows, double *results, int nprobes, double *resultsSE){
384 
+
385 
+  int i,j;
386 
+
387 
+  double *z = Calloc(nprobes*cols,double);
388 
+
389 
+  for (j = 0; j < cols; j++){
390 
+    for (i =0; i < nprobes; i++){
391 
+      z[j*nprobes + i] = data[j*rows + cur_rows[i]];
392 
+    }
393 
+  }
394 
+
395 
+
396 
+  median_polish_no_copy(z,nprobes,cols,results,resultsSE);
397 
+
398 
+  Free(z);
399 
+
400 
+}
401 
+
402 
+
src/medianpolish.h
History View file @b8e8c2d
... ... 
@@ -7,5 +7,7 @@ void median_polish_log2_no_copy(double *data, int rows, int cols, double *result
7 7 
 void median_polish_log2(double *data, int rows, int cols, double *results, double *resultsSE, double *residuals);
8 8 
 void median_polish(double *data, int rows, int cols, double *results, double *resultsSE, double *residuals);
9 9 
 void MedianPolish(double *data, int rows, int cols, int *cur_rows, double *results, int nprobes, double *resultsSE);
10 
+void MedianPolish_no_log(double *data, int rows, int cols, int *cur_rows, double *results, int nprobes, double *resultsSE);
11 
+
10 12
11 13 
 #endif