Mercurial > repos > devteam > lda_analysis

comparison lda_analy.xml @ 0:f38763b52f33 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Imported from capsule None
author devteam
date Mon, 28 Jul 2014 11:56:39 -0400
parents
children f0b6217f4a0c
comparison
equal deleted inserted replaced
-1:000000000000 0:f38763b52f33
1 <tool id="lda_analy1" name="Perform LDA" version="1.0.1">
2 <description>Linear Discriminant Analysis</description>
3 <requirements>
4 <requirement type="package" version="2.11.0">R</requirement>
5 </requirements>
6 <command interpreter="sh">r_wrapper.sh $script_file</command>
7 <inputs>
8 <param format="tabular" name="input" type="data" label="Source file"/>
9 <param name="cond" size="30" type="integer" value="3" label="Number of principal components" help="See TIP below">
10 <validator type="empty_field" message="Enter a valid number of principal components, see syntax below for examples"/>
11 </param>
12
13 </inputs>
14 <outputs>
15 <data format="txt" name="output" />
16 </outputs>
17
18 <tests>
19 <test>
20 <param name="input" value="matrix_generator_for_pc_and_lda_output.tabular"/>
21 <output name="output" file="lda_analy_output.txt"/>
22 <param name="cond" value="2"/>
23
24 </test>
25 </tests>
26
27 <configfiles>
28 <configfile name="script_file">
29
30 rm(list = objects() )
31
32 ############# FORMAT X DATA #########################
33 format&lt;-function(data) {
34 ind=NULL
35 for(i in 1 : ncol(data)){
36 if (is.na(data[nrow(data),i])) {
37 ind&lt;-c(ind,i)
38 }
39 }
40 #print(is.null(ind))
41 if (!is.null(ind)) {
42 data&lt;-data[,-c(ind)]
43 }
44
45 data
46 }
47
48 ########GET RESPONSES ###############################
49 get_resp&lt;- function(data) {
50 resp1&lt;-as.vector(data[,ncol(data)])
51 resp=numeric(length(resp1))
52 for (i in 1:length(resp1)) {
53 if (resp1[i]=="Y ") {
54 resp[i] = 0
55 }
56 if (resp1[i]=="X ") {
57 resp[i] = 1
58 }
59 }
60 return(resp)
61 }
62
63 ######## CHARS TO NUMBERS ###########################
64 f_to_numbers&lt;- function(F) {
65 ind&lt;-NULL
66 G&lt;-matrix(0,nrow(F), ncol(F))
67 for (i in 1:nrow(F)) {
68 for (j in 1:ncol(F)) {
69 G[i,j]&lt;-as.integer(F[i,j])
70 }
71 }
72 return(G)
73 }
74
75 ###################NORMALIZING#########################
76 norm &lt;- function(M, a=NULL, b=NULL) {
77 C&lt;-NULL
78 ind&lt;-NULL
79
80 for (i in 1: ncol(M)) {
81 if (sd(M[,i])!=0) {
82 M[,i]&lt;-(M[,i]-mean(M[,i]))/sd(M[,i])
83 }
84 # else {print(mean(M[,i]))}
85 }
86 return(M)
87 }
88
89 ##### LDA DIRECTIONS #################################
90 lda_dec &lt;- function(data, k){
91 priors=numeric(k)
92 grandmean&lt;-numeric(ncol(data)-1)
93 means=matrix(0,k,ncol(data)-1)
94 B = matrix(0, ncol(data)-1, ncol(data)-1)
95 N=nrow(data)
96 for (i in 1:k){
97 priors[i]=sum(data[,1]==i)/N
98 grp=subset(data,data\$group==i)
99 means[i,]=mean(grp[,2:ncol(data)])
100 #print(means[i,])
101 #print(priors[i])
102 #print(priors[i]*means[i,])
103 grandmean = priors[i]*means[i,] + grandmean
104 }
105
106 for (i in 1:k) {
107 B= B + priors[i]*((means[i,]-grandmean)%*%t(means[i,]-grandmean))
108 }
109
110 W = var(data[,2:ncol(data)])
111 svdW = svd(W)
112 inv_sqrtW =solve(svdW\$v %*% diag(sqrt(svdW\$d)) %*% t(svdW\$v))
113 B_star= t(inv_sqrtW)%*%B%*%inv_sqrtW
114 B_star_decomp = svd(B_star)
115 directions = inv_sqrtW%*%B_star_decomp\$v
116 return( list(directions, B_star_decomp\$d) )
117 }
118
119 ################ NAIVE BAYES FOR 1D SIR OR LDA ##############
120 naive_bayes_classifier &lt;- function(resp, tr_data, test_data, k=2, tau) {
121 tr_data=data.frame(resp=resp, dir=tr_data)
122 means=numeric(k)
123 #print(k)
124 cl=numeric(k)
125 predclass=numeric(length(test_data))
126 for (i in 1:k) {
127 grp = subset(tr_data, resp==i)
128 means[i] = mean(grp\$dir)
129 #print(i, means[i])
130 }
131 cutoff = tau*means[1]+(1-tau)*means[2]
132 #print(tau)
133 #print(means)
134 #print(cutoff)
135 if (cutoff&gt;means[1]) {
136 cl[1]=1
137 cl[2]=2
138 }
139 else {
140 cl[1]=2
141 cl[2]=1
142 }
143
144 for (i in 1:length(test_data)) {
145
146 if (test_data[i] &lt;= cutoff) {
147 predclass[i] = cl[1]
148 }
149 else {
150 predclass[i] = cl[2]
151 }
152 }
153 #print(means)
154 #print(mean(means))
155 #X11()
156 #plot(test_data,pch=predclass, col=resp)
157 predclass
158 }
159
160 ################# EXTENDED ERROR RATES #################
161 ext_error_rate &lt;- function(predclass, actualclass,msg=c("you forgot the message"), pr=1) {
162 er=sum(predclass != actualclass)/length(predclass)
163
164 matr&lt;-data.frame(predclass=predclass,actualclass=actualclass)
165 escapes = subset(matr, actualclass==1)
166 subjects = subset(matr, actualclass==2)
167 er_esc=sum(escapes\$predclass != escapes\$actualclass)/length(escapes\$predclass)
168 er_subj=sum(subjects\$predclass != subjects\$actualclass)/length(subjects\$predclass)
169
170 if (pr==1) {
171 # print(paste(c(msg, 'overall : ', (1-er)*100, "%."),collapse=" "))
172 # print(paste(c(msg, 'within escapes : ', (1-er_esc)*100, "%."),collapse=" "))
173 # print(paste(c(msg, 'within subjects: ', (1-er_subj)*100, "%."),collapse=" "))
174 }
175 return(c((1-er)*100, (1-er_esc)*100, (1-er_subj)*100))
176 }
177
178 ## Main Function ##
179
180 files&lt;-matrix("${input}", 1,1, byrow=T)
181
182 d&lt;-"${cond}" # Number of PC
183
184 tau&lt;-seq(0,1, by=0.005)
185 #tau&lt;-seq(0,1, by=0.1)
186 for_curve=matrix(-10, 3,length(tau))
187
188 ##############################################################
189
190 test_data_whole_X &lt;-read.delim(files[1,1], row.names=1)
191
192 #### FORMAT TRAINING DATA ####################################
193 # get only necessary columns
194
195 test_data_whole_X&lt;-format(test_data_whole_X)
196 oligo_labels&lt;-test_data_whole_X[1:(nrow(test_data_whole_X)-1),ncol(test_data_whole_X)]
197 test_data_whole_X&lt;-test_data_whole_X[,1:(ncol(test_data_whole_X)-1)]
198
199 X_names&lt;-colnames(test_data_whole_X)[1:ncol(test_data_whole_X)]
200 test_data_whole_X&lt;-t(test_data_whole_X)
201 resp&lt;-get_resp(test_data_whole_X)
202 ldaqda_resp = resp + 1
203 a&lt;-sum(resp) # Number of Subject
204 b&lt;-length(resp) - a # Number of Escape
205 ## FREQUENCIES #################################################
206 F&lt;-test_data_whole_X[,1:(ncol(test_data_whole_X)-1)]
207 F&lt;-f_to_numbers(F)
208 FN&lt;-norm(F, a, b)
209 ss&lt;-svd(FN)
210 eigvar&lt;-NULL
211 eig&lt;-ss\$d^2
212
213 for ( i in 1:length(ss\$d)) {
214 eigvar[i]&lt;-sum(eig[1:i])/sum(eig)
215 }
216
217 #print(paste(c("Variance explained : ", eigvar[d]*100, "%"), collapse=""))
218
219 Z&lt;-F%*%ss\$v
220
221 ldaqda_data &lt;- data.frame(group=ldaqda_resp,Z[,1:d])
222 lda_dir&lt;-lda_dec(ldaqda_data,2)
223 train_lda_pred &lt;-Z[,1:d]%*%lda_dir[[1]]
224
225 ############# NAIVE BAYES CROSS-VALIDATION #############
226 ### LDA #####
227
228 y&lt;-ldaqda_resp
229 X&lt;-F
230 cv&lt;-matrix(c(rep('NA',nrow(test_data_whole_X))), nrow(test_data_whole_X), length(tau))
231 for (i in 1:nrow(test_data_whole_X)) {
232 # print(i)
233 resp&lt;-y[-i]
234 p&lt;-matrix(X[-i,], dim(X)[1]-1, dim(X)[2])
235 testdata&lt;-matrix(X[i,],1,dim(X)[2])
236 p1&lt;-norm(p)
237 sss&lt;-svd(p1)
238 pred&lt;-(p%*%sss\$v)[,1:d]
239 test&lt;- (testdata%*%sss\$v)[,1:d]
240 lda &lt;- lda_dec(data.frame(group=resp,pred),2)
241 pred &lt;- pred[,1:d]%*%lda[[1]][,1]
242 test &lt;- test%*%lda[[1]][,1]
243 test&lt;-matrix(test, 1, length(test))
244 for (t in 1:length(tau)) {
245 cv[i, t] &lt;- naive_bayes_classifier (resp, pred, test,k=2, tau[t])
246 }
247 }
248
249 for (t in 1:length(tau)) {
250 tr_err&lt;-ext_error_rate(cv[,t], ldaqda_resp , c("CV"), 1)
251 for_curve[1:3,t]&lt;-tr_err
252 }
253
254 dput(for_curve, file="${output}")
255
256
257 </configfile>
258 </configfiles>
259
260 <help>
261
262 .. class:: infomark
263
264 **TIP:** If you want to perform Principal Component Analysis (PCA) on the give numeric input data (which corresponds to the "Source file First in "Generate A Matrix" tool), please use *Multivariate Analysis/Principal Component Analysis*
265
266 -----
267
268 .. class:: infomark
269
270 **What it does**
271
272 This tool consists of the module to perform the Linear Discriminant Analysis as described in Carrel et al., 2006 (PMID: 17009873)
273
274 *Carrel L, Park C, Tyekucheva S, Dunn J, Chiaromonte F, et al. (2006) Genomic Environment Predicts Expression Patterns on the Human Inactive X Chromosome. PLoS Genet 2(9): e151. doi:10.1371/journal.pgen.0020151*
275
276 -----
277
278 .. class:: warningmark
279
280 **Note**
281
282 - Output from "Generate A Matrix" tool is used as input file for this tool
283 - Output of this tool contains LDA classification success rates for different values of the turning parameter tau (from 0 to 1 with 0.005 interval). This output file will be used to establish the ROC plot, and you can obtain more detail information from this plot.
284
285
286 </help>
287
288 </tool>