質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
R

R言語は、「S言語」をオープンソースとして実装なおした、統計解析向けのプログラミング言語です。 計算がとても速くグラフィックも充実しているため、数値計算に向いています。 文法的には、統計解析部分はS言語を参考にしており、データ処理部分はSchemeの影響を受けています。 世界中の専門家が開発に関わり、日々新しい手法やアルゴリズムが追加されています。

Q&A

解決済

1回答

696閲覧

irisデータのsetosaとversicolorにAUCのブースティングを適用させたときの判別結果を表示させるプログラムを作成したい

wagashi_157

総合スコア51

R

R言語は、「S言語」をオープンソースとして実装なおした、統計解析向けのプログラミング言語です。 計算がとても速くグラフィックも充実しているため、数値計算に向いています。 文法的には、統計解析部分はS言語を参考にしており、データ処理部分はSchemeの影響を受けています。 世界中の専門家が開発に関わり、日々新しい手法やアルゴリズムが追加されています。

0グッド

0クリップ

投稿2022/05/28 15:50

編集2022/06/02 15:26

前提・実現したいこと

AUCのブースティングをirisデータのsetosaとversicolorに適用させたときの判別結果を表示させる(グラフ)プログラムを作成したいです。
次のように表示させることが目標です。
setosa と versicolor の出力結果 (誤判別率= 0)
誤判別率=0と出力されることも目標です。

発生している問題・エラーメッセージ

上の図で示したような結果にならず, dat.setover関数をコマンドに打ち込んだのですが, グラフは表示されるものの正しく表示されません。dat.sin関数からsetosaとversicolorを適用させたときのものに変えるためにどのようにすれば良いか分からないので教えていただきたいです。
誤判別率=1のグラフ

該当のソースコード

R

1auc.b <- 2function(x=dat.sin,T=50,lambda=0.001){ 3 N=T 4 probs=1:30/30 5 y=x[,dim(x)[2]]==1 6 x=x[,1:(dim(x)[2]-1)] 7 8 n0=sum(y==F) # y=Fのサンプル数 9 n1=sum(y==TRUE) #y=Tのサンプル数   10 n = dim(x)[1]  #n=n0+n1 11 m = dim(x)[2] #マーカーの数(3つ) 12 sd.n=1 13 14 T.auc=0 15 F0=rep(0,n0) 16 F1=rep(0,n1) 17 18 B=list() 19 Z=list() 20 Fz=list() 21 for(i in 1:m){ 22 B[[i]]=quantile(x[,i],probs=probs) 23 Z[[i]]=c(min(x[,i]),min(x[,i]),B[[i]],max(x[,i])) 24 Fz[[i]]=rep(0,length(Z[[i]])) 25 } 26 nb=unlist(lapply(B,length)) 27 M=NULL 28 for(i in 1:m){ 29 Md=matrix(x[,i],n,nb[i]) 30 Md=t(t(Md)>=B[[i]]) 31 M=cbind(M,Md) 32 } 33 M0=M[y==F,] 34 M1=M[y==TRUE,] 35 a=numeric(0) 36 b=numeric(0) 37 p=numeric(0) 38 alpha=numeric(0) 39 40 41 ff=function(x){ 42 nb=length(x)-3 43 2*(x[1:nb]-3*x[2:(nb+1)]+3*x[3:(nb+2)]-x[4:(nb+3)]) 44 } 45 46 nn=100 47 eps=0.1 48 grid1=seq(min(x[,1])-eps,max(x[,1])+eps,length=nn) 49 grid2=seq(min(x[,2])-eps,max(x[,2])+eps,length=nn) 50 Grid=expand.grid(grid1,grid2) 51 52windows(width=12,height=8) 53 54 xx=-100:800/100 55 for(k in 1:N){#N:ブースティングの繰り返し数 56 T.auc=T.auc+1 57 w1=unlist(lapply(Fz,ff)) 58 d=0 59 for(i in 1:n0) # 弱判別機f_tの選択のための計算(p969のstep a.) 60 d=d+apply(1/(n0*n1)*dnorm(F1-F0[i],sd=sd.n)*(t(t(M1)-M0[i,])),2,sum) 61 d=d-lambda*w1 62 63 maxd=d[order(d)[length(d)]] 64 mind=d[order(d)[1]] 65 if(maxd>=-mind){ 66 a[k]=1 67 l=order(d)[length(d)] 68 } 69 else{ 70 a[k]=-1 71 l=order(d)[1] 72 } 73 ii=0 74 ld=l 75 while(ld>0){ 76 ii=ii+1 77 ld=ld-nb[ii] 78 } 79 p[k]=ii #選ばれたf_tに対応するマーカーのid 80 ld=ld+nb[ii] 81 b[k]=B[[p[k]]][ld] #選ばれたf_t(stump) 82 if(k<4) 83 al=1/sd.n 84 else 85 al=median(alpha[(k-3):(k-1)])/sd.n 86 al0=0 87 nz=length(Fz[[p[k]]]) 88 89 AA=0 90 while(abs(al-al0)>0.000001&AA<5){#弱判別機の係数\alphaの更新 91 AA=AA+1 92 al0=al 93 d1=0 94 d2=0 95 for(i in 1:n0){ 96 d1=d1+sum(1/(n0*n1)*dnorm(F1-F0[i]+al0*a[k]*(M1[,l]-M0[i,l]),sd=sd.n)*a[k]*(M1[,l]-M0[i,l])) 97 d2=d2-sum(1/(n0*n1)*(F1-F0[i]+al0*a[k]*(M1[,l]-M0[i,l]))*dnorm(F1-F0[i]+al0*a[k]*(M1[,l]-M0[i,l]),sd=sd.n)/sd.n^2*(M1[,l]-M0[i,l])^2) 98 } 99 100 dw1=2*(a[k]*(Fz[[p[k]]][ld]-3*Fz[[p[k]]][ld+1]+3*Fz[[p[k]]][ld+2] 101 -Fz[[p[k]]][ld+3])+2*al0) 102 dw2=4 103 al=al0-(d1-lambda*dw1)/(d2-lambda*dw2) 104 } 105 106 alpha[k]=al 107 108 if(a[k]==1){ 109 F0=F0+al*M0[,l] 110 F1=F1+al*M1[,l] 111 Fz[[p[k]]][(ld+2):nz]=Fz[[p[k]]][(ld+2):nz]+al 112 } 113 else{ 114 F0=F0+al*(!M0[,l]) 115 F1=F1+al*(!M1[,l]) 116 Fz[[p[k]]][1:(ld+1)]=Fz[[p[k]]][1:(ld+1)]+al 117 } 118 max.fz=0 119 for(i in 1:m){ 120 if(max.fz<max(Fz[[i]]-min(Fz[[i]]))) 121 max.fz=max(Fz[[i]]-min(Fz[[i]])) 122 } 123 124 n.p=length(unique(p)) 125 n.row=round(sqrt(n.p)) 126 n.col=ceiling(n.p/n.row) 127 par(mfcol=c(n.row,n.col+1)) 128 for(i in sort(unique(p))){ 129 plot(Z[[i]],Fz[[i]]-min(Fz[[i]]),xlab=names(x)[i],ylab="score",type="s",ylim=c(0,max.fz)) 130 rug(x[y==F,i],side=1) 131 rug(x[y==T,i],side=3,col=2) 132 title(paste("T=",T.auc)) 133 } 134 135 Fs=data.frame(a,b,p,alpha) 136 137 val=apply(x[,1:m],1,F.v.auc,Fs=Fs) 138 139 140 q=quantile(val,probs=1:100/100) 141 err=apply(y!=t(t(matrix(val,n,length(q)))>=q),2,mean) 142 ord=order(err)[1] 143 thres=q[ord] 144 145 plot(x[,1:2]) 146 points(x[y,1:2],col="red") 147 valG=apply(Grid,1,F.v.auc,Fs=Fs) 148 A=matrix(valG,nn,nn) 149 contour(grid1,grid2,A,add=T,lty=1,drawlabels=F,levels=thres,lwd=2,col="blue") 150 title(paste("T=",T.auc)) 151 points(xx,sin(xx),type="l",col="gray") 152 153 } 154 print(paste("T=",k,", 誤判別率=",min(err))) 155 156} 157F.v.auc <- 158function (x, Fs) 159{ 160 a = Fs[, 1] 161 b = Fs[, 2] 162 p = Fs[, 3] 163 alpha = Fs[, 4] 164 return((a * ((x[p] - b) >= 0)) %*% alpha) 165} 166dat.sin <- 167structure(list(x1 = c(1.19925745746754,・・・・・・, 1680.224633387143907), x2 = c(0.381306261755526, ・・・・・・, 169-0.364164637215435), lab = c(0, 0, 1, 1, 1, 1, 0, 1, 0, 1, 1, 1700, 1, 0, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 1, 0, 1, 0, 1710, 0, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 0, 1720, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 0, 1730, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 0, 1, 0, 1, 0, 0, 1, 1, 0, 1, 1741, 0, 0, 1, 0, 1, 0, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1751, 1, 0, 1, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 0, 0, 1, 1760, 0, 1, 1, 1, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 0, 0, 1770, 1, 0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1781, 0, 1, 1, 0, 1, 0, 0, 1, 1, 1, 1, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1790, 1, 0, 0, 1, 1, 1, 0, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 1800, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 1, 0, 0, 1, 0, 1, 1811, 0, 1, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 0, 0, 1, 0, 1, 0, 0, 0, 1821, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 1831, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 0, 1, 1, 1, 1, 0, 1840, 0, 1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 1851, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1861, 0, 1, 0, 1, 1, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 0, 1, 1, 1871, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 1, 1, 1, 0, 1, 0, 1, 0, 0, 1880, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0)), row.names = c(NA, -400L), class = "data.frame")

コマンドに打ち込んだ内容
dat.setover<-cbind(iris[1:50,c(1:2)],iris[51:100,c(1,2)])

試したこと

出力結果の見本でSepal.LengthとSepal.Widthが軸になっていることから列を抽出して連結させると判断してc()を用いて試してみました。しかし, warnings()を実行するとzの値が出てこないという表示が出ます。labが何を示していて何を計算すれば良いか分からないので教えていただきたいです。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

ベストアンサー

dat.sinの構造を理解すれば、簡単に解けると思います。

投稿2022/05/29 09:44

Hinata

総合スコア15

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

wagashi_157

2022/05/30 15:37 編集

すみません, dat.sinの構造が調べてもどのようになっているのかが分かりません。 お手数ですが, 丁寧に教えてくださるとありがたいです。 具体的にsetosaとversicolorを適用させた場合はどうなるのでしょうか。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問