root/galaxy-central/tools/stats/lda_analy.xml @ 3

リビジョン 2, 9.3 KB (コミッタ: hatakeyama, 14 年 前)

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