root/galaxy-central/tools/stats/plot_from_lda.xml

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

import galaxy-central
行番号 
1<tool id="plot_for_lda_output1" name="Draw ROC" version="1.0.1">
2        <description>Receiver Operating Characteristic plot</description>
3        <command interpreter="sh">r_wrapper.sh $script_file</command>
4
5        <inputs>
6                <param format="text" name="input" type="data" label="Source file"> </param>
7                <param name="my_title" size="30" type="text" value="My Figure" label="Title of your plot" help="See syntax below"> </param>
8                <param name="X_axis" size="30" type="text" value="Text for X axis" label="Legend of X axis in your plot" help="See syntax below"> </param>
9                <param name="Y_axis" size="30" type="text" value="Text for Y axis" label="Legend of Y axis in your plot" help="See syntax below"> </param>
10        </inputs>
11        <outputs>
12                <data format="pdf" name="pdf_output" />
13        </outputs>
14
15        <tests>
16                <test>
17                        <param name="input" value="lda_analy_output.txt"/>
18                        <param name="my_title" value="Test Plot1"/>
19                        <param name="X_axis" value="Test Plot2"/>
20                        <param name="Y_axis" value="Test Plot3"/>
21                        <output name="pdf_output" file="plot_for_lda_output.pdf"/>
22                </test>
23        </tests>
24
25    <configfiles>
26            <configfile name="script_file">
27
28        rm(list = objects() )
29
30        ############# FORMAT X DATA #########################
31        format&lt;-function(data) {
32            ind=NULL
33            for(i in 1 : ncol(data)){
34                if (is.na(data[nrow(data),i])) {
35                    ind&lt;-c(ind,i)
36                }
37            }
38            #print(is.null(ind))
39            if (!is.null(ind)) {
40                data&lt;-data[,-c(ind)]
41            }
42
43            data
44        }
45
46        ########GET RESPONSES ###############################
47        get_resp&lt;- function(data) {
48            resp1&lt;-as.vector(data[,ncol(data)])
49                resp=numeric(length(resp1))
50            for (i in 1:length(resp1)) {
51                if (resp1[i]=="Control ") {
52                    resp[i] = 0
53                }
54                if (resp1[i]=="XLMR ") {
55                    resp[i] = 1
56                }
57            }
58                return(resp)
59        }
60
61        ######## CHARS TO NUMBERS ###########################
62        f_to_numbers&lt;- function(F) {
63            ind&lt;-NULL
64            G&lt;-matrix(0,nrow(F), ncol(F))
65            for (i in 1:nrow(F)) {
66                for (j in 1:ncol(F)) {
67                    G[i,j]&lt;-as.integer(F[i,j])
68                }
69            }
70            return(G)
71        }
72
73        ###################NORMALIZING#########################
74        norm &lt;- function(M, a=NULL, b=NULL) {
75            C&lt;-NULL
76            ind&lt;-NULL
77
78            for (i in 1: ncol(M)) {
79                if (sd(M[,i])!=0) {
80                    M[,i]&lt;-(M[,i]-mean(M[,i]))/sd(M[,i])
81                }
82                #   else {print(mean(M[,i]))}   
83            }
84            return(M)
85        }
86
87        ##### LDA DIRECTIONS #################################
88        lda_dec &lt;- function(data, k){
89            priors=numeric(k)
90            grandmean&lt;-numeric(ncol(data)-1)
91            means=matrix(0,k,ncol(data)-1)
92            B = matrix(0, ncol(data)-1, ncol(data)-1)
93            N=nrow(data)
94            for (i in 1:k){
95                priors[i]=sum(data[,1]==i)/N
96                grp=subset(data,data\$group==i)
97                means[i,]=mean(grp[,2:ncol(data)])
98                #print(means[i,])
99                #print(priors[i])
100                #print(priors[i]*means[i,])
101                grandmean = priors[i]*means[i,] + grandmean           
102            }
103
104            for (i in 1:k) {
105                B= B + priors[i]*((means[i,]-grandmean)%*%t(means[i,]-grandmean))
106            }
107   
108            W = var(data[,2:ncol(data)])
109            svdW = svd(W)
110            inv_sqrtW =solve(svdW\$v %*% diag(sqrt(svdW\$d)) %*% t(svdW\$v))
111            B_star= t(inv_sqrtW)%*%B%*%inv_sqrtW
112            B_star_decomp = svd(B_star)
113            directions  = inv_sqrtW%*%B_star_decomp\$v
114            return( list(directions, B_star_decomp\$d) )                         
115        }
116
117        ################ NAIVE BAYES FOR 1D SIR OR LDA ##############
118        naive_bayes_classifier &lt;- function(resp, tr_data, test_data, k=2, tau) {
119            tr_data=data.frame(resp=resp, dir=tr_data)
120            means=numeric(k)
121            #print(k)
122            cl=numeric(k)
123            predclass=numeric(length(test_data))
124            for (i in 1:k) {
125                grp = subset(tr_data, resp==i)
126                means[i] = mean(grp\$dir)
127            #print(i, means[i]) 
128            }
129            cutoff = tau*means[1]+(1-tau)*means[2]
130            #print(tau)
131            #print(means)
132            #print(cutoff)
133            if (cutoff&gt;means[1]) {
134               cl[1]=1
135               cl[2]=2
136            }
137            else {
138               cl[1]=2
139               cl[2]=1
140            }
141
142            for (i in 1:length(test_data)) {
143
144                if (test_data[i] &lt;= cutoff) {
145                    predclass[i] = cl[1]
146            }
147                else {
148                    predclass[i] = cl[2]
149            } 
150                }
151            #print(means)
152            #print(mean(means))
153            #X11()
154            #plot(test_data,pch=predclass, col=resp)
155            predclass
156        }
157
158        ################# EXTENDED ERROR RATES #################
159        ext_error_rate &lt;- function(predclass, actualclass,msg=c("you forgot the message"), pr=1) {
160                 er=sum(predclass != actualclass)/length(predclass)
161
162                 matr&lt;-data.frame(predclass=predclass,actualclass=actualclass)
163                 escapes = subset(matr, actualclass==1)
164                 subjects = subset(matr, actualclass==2)     
165                 er_esc=sum(escapes\$predclass != escapes\$actualclass)/length(escapes\$predclass)
166                 er_subj=sum(subjects\$predclass != subjects\$actualclass)/length(subjects\$predclass)   
167
168                 if (pr==1) {
169        #             print(paste(c(msg, 'overall : ', (1-er)*100, "%."),collapse=" "))
170        #             print(paste(c(msg, 'within escapes : ', (1-er_esc)*100, "%."),collapse=" "))
171        #             print(paste(c(msg, 'within subjects: ', (1-er_subj)*100, "%."),collapse=" "))
172            }
173            return(c((1-er)*100, (1-er_esc)*100, (1-er_subj)*100))                                                                                   
174        }
175
176        ## Main Function ##
177
178        files_alias&lt;-c("${my_title}")
179        tau=seq(0,1,by=0.005)
180        nfiles=1
181        f = c("${input}")
182
183        rez_ext&lt;-list()
184        for (i in 1:nfiles) {
185                rez_ext[[i]]&lt;-dget(paste(f[i], sep="",collapse=""))
186        }
187
188        tau&lt;-tau[1:(length(tau)-1)]
189        for (i in 1:nfiles) {
190                rez_ext[[i]]&lt;-rez_ext[[i]][,1:(length(tau)-1)]
191        }
192
193        ######## OPTIMAIL TAU ###########################
194
195        #rez_ext
196
197        rate&lt;-c("Optimal tau","Tr total", "Tr Y", "Tr X")
198
199        m_tr&lt;-numeric(nfiles)
200        m_xp22&lt;-numeric(nfiles)
201        m_x&lt;-numeric(nfiles)
202
203        for (i in 1:nfiles) {
204                r&lt;-rez_ext[[i]]
205                #tr
206        #       rate&lt;-rbind(rate, c(files_alias[i]," "," "," ") )
207                mm&lt;-which((r[3,])==max(r[3,]))
208
209                m_tr[i]&lt;-mm[1]
210                rate&lt;-rbind(rate,c(tau[m_tr[i]],r[,m_tr[i]]))
211        }
212        print(rate)
213
214        pdf(file= paste("${pdf_output}"))
215
216        plot(rez_ext[[i]][2,]~rez_ext[[i]][3,], xlim=c(0,100), ylim=c(0,100), xlab="${X_axis}   [1-FP(False Positive)]", ylab="${Y_axis}   [1-FP(False Positive)]", type="l", lty=1, col="blue", xaxt='n', yaxt='n')
217        for (i in 1:nfiles) {
218                lines(rez_ext[[i]][2,]~rez_ext[[i]][3,], xlab="${X_axis}   [1-FP(False Positive)]", ylab="${Y_axis}   [1-FP(False Positive)]", type="l", lty=1, col=i)   
219                # pt=c(r,)
220                points(x=rez_ext[[i]][3,m_tr[i]],y=rez_ext[[i]][2,m_tr[i]], pch=16, col=i) 
221        }
222
223
224        title(main="${my_title}", adj=0, cex.main=1.1)
225        axis(2, at=c(0,20,40,60,80,100), labels=c('0','20','40','60','80','100%'))
226        axis(1, at=c(0,20,40,60,80,100), labels=c('0','20','40','60','80','100%'))
227
228        #leg=c("10 kb","50 kb","100 kb")
229        #legend("bottomleft",legend=leg , col=c(1,2,3), lty=c(1,1,1))
230
231        #dev.off()
232
233                </configfile>
234        </configfiles>
235
236
237        <help>
238
239
240</help>
241
242
243
244</tool>
Note: リポジトリブラウザについてのヘルプは TracBrowser を参照してください。