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

... ...
@@ -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
 
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
+
... ...
@@ -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
... ...
@@ -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
 }
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
... ...
@@ -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.
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
+}
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
... ...
@@ -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
+
... ...
@@ -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
... ...
@@ -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);
... ...
@@ -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
+
... ...
@@ -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
... ...
@@ -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){
... ...
@@ -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);
... ...
@@ -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
+
... ...
@@ -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