R_Language 板


LINE

我本身使用R大概一兩年 目前想要寫出一個小function可以計算出以下的公式 https://imgur.com/supH7mE d 是要計算出來的向量 長度是m A 是一個矩陣維度是n*m,裡面的元素都是正的 alpha是A矩陣的元素 p 是一個向量長度為m 其為機率向量 裡面的元素相加等於1 以下是我的程式碼,雖然檢查過很多次,但不確定有沒有算錯 或是有沒有辦法用矩陣的方式去計算之,因為這樣算太慢了 set.seed(1) m=10 n=7 A <- matrix( rexp(m*n),ncol=m ,nrow=n ) p <- c( 0.05,0.1,0.3,0.05,0.05,0.05,0.07,0.03,0.2,0.1) sum(p ) length(p ) den <- rep(0,n) densum <- rep(0,n) d<- rep(0,m) for(j in 1:m){ for(i in 1:n){ den[i]<- sum(A[i,]*p) densum[i]<- A[i,j]*p[j]/den[i] d[j]<- sum( densum ) } } 下面是我算出來的 [1] 0.336093550 0.855872710 2.158927311 0.233847299 0.282627585 [6] 0.253739688 0.517757929 0.312419250 0.760612933 1.288101743 --



※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 219.91.75.186 (臺灣)
※ 文章網址: https://webptt.com/m.aspx?n=bbs/R_Language/M.1574656447.A.C05.html ※ 編輯: empireisme (219.91.75.186 臺灣), 11/25/2019 12:39:29
1F:→ andrew43: sum(densum)不應該和for(i)同層11/25 13:44
2F:→ andrew43: 你先想一下j=1;i=1時densum是什麼就能明白有問題11/25 13:44
3F:→ celestialgod: https://pastebin.com/TsASfKP411/25 14:09
4F:→ celestialgod: 其實它就只是每個i都取代一個d[j] 但是最後一個i11/25 14:11
5F:→ celestialgod: 才會填一次正確值XD 是不影響結果拉...11/25 14:11
6F:→ celestialgod: 這個問題用sweep / colSums / rowSums就能解決了11/25 14:12
7F:→ celestialgod: 原po再自己看一下我上面貼的程式~ 有問題再發問11/25 14:12
謝謝各位回答,我是沒用過sweep,只覺得這種迴圈寫的很煩,現在沒電腦,回家再試試 看
8F:→ andrew43: 嗯後來發現了謝謝11/25 14:15
所以我程式應該是沒寫錯的? 因為計算量太大也不好手算qq ※ 編輯: empireisme (101.12.41.101 臺灣), 11/25/2019 14:17:10 ※ 編輯: empireisme (101.12.41.101 臺灣), 11/25/2019 14:19:47
9F:→ celestialgod: 不算寫錯 但是就多了不少操作 是可以省掉的11/25 14:27
10F:→ celestialgod: 這種情況建議拿 2 x 2的矩陣來驗算會好一點11/25 14:28
11F:→ celestialgod: sweep正如它字面上的意思就掃過去... 11/25 14:29
12F:→ celestialgod: 自己玩玩看吧11/25 14:29
我算過小矩陣 但就是怕有萬一qq 比如說是不是對數學公式的理解錯誤 ※ 編輯: empireisme (101.12.41.101 臺灣), 11/25/2019 14:34:45
13F:→ andrew43: 只看式子,確實多算很多。rowSums colSums先練練看11/25 14:39
ok 看了c大的程式,看起來確實我沒有算錯但多算很多了 ※ 編輯: empireisme (101.12.41.101 臺灣), 11/26/2019 10:09:21
14F:→ a78998042a: temp = t(A)*p 12/01 09:32
15F:→ a78998042a: den = colSums(temp) 12/01 09:32
16F:→ a78998042a: r2 = t(temp)/den 12/01 09:32
17F:→ a78998042a: d = colSums(r2) 12/01 09:33
18F:→ a78998042a: 快一點,記憶體用量少一些 12/01 09:33
19F:推 asdiy: 我的寫法是 simple=function(A,p){t=p/apply(A,1,function 01/01 00:04
20F:→ asdiy: (x)x%*%p);apply(A,2,function(x)x%*%t} 做 10000*10000矩 01/01 00:04
21F:→ asdiy: 陣是4秒 01/01 00:04







like.gif 您可能會有興趣的文章
icon.png[問題/行為] 貓晚上進房間會不會有憋尿問題
icon.pngRe: [閒聊] 選了錯誤的女孩成為魔法少女 XDDDDDDDDDD
icon.png[正妹] 瑞典 一張
icon.png[心得] EMS高領長版毛衣.墨小樓MC1002
icon.png[分享] 丹龍隔熱紙GE55+33+22
icon.png[問題] 清洗洗衣機
icon.png[尋物] 窗台下的空間
icon.png[閒聊] 双極の女神1 木魔爵
icon.png[售車] 新竹 1997 march 1297cc 白色 四門
icon.png[討論] 能從照片感受到攝影者心情嗎
icon.png[狂賀] 賀賀賀賀 賀!島村卯月!總選舉NO.1
icon.png[難過] 羨慕白皮膚的女生
icon.png閱讀文章
icon.png[黑特]
icon.png[問題] SBK S1安裝於安全帽位置
icon.png[分享] 舊woo100絕版開箱!!
icon.pngRe: [無言] 關於小包衛生紙
icon.png[開箱] E5-2683V3 RX480Strix 快睿C1 簡單測試
icon.png[心得] 蒼の海賊龍 地獄 執行者16PT
icon.png[售車] 1999年Virage iO 1.8EXi
icon.png[心得] 挑戰33 LV10 獅子座pt solo
icon.png[閒聊] 手把手教你不被桶之新手主購教學
icon.png[分享] Civic Type R 量產版官方照無預警流出
icon.png[售車] Golf 4 2.0 銀色 自排
icon.png[出售] Graco提籃汽座(有底座)2000元誠可議
icon.png[問題] 請問補牙材質掉了還能再補嗎?(台中半年內
icon.png[問題] 44th 單曲 生寫竟然都給重複的啊啊!
icon.png[心得] 華南紅卡/icash 核卡
icon.png[問題] 拔牙矯正這樣正常嗎
icon.png[贈送] 老莫高業 初業 102年版
icon.png[情報] 三大行動支付 本季掀戰火
icon.png[寶寶] 博客來Amos水蠟筆5/1特價五折
icon.pngRe: [心得] 新鮮人一些面試分享
icon.png[心得] 蒼の海賊龍 地獄 麒麟25PT
icon.pngRe: [閒聊] (君の名は。雷慎入) 君名二創漫畫翻譯
icon.pngRe: [閒聊] OGN中場影片:失蹤人口局 (英文字幕)
icon.png[問題] 台灣大哥大4G訊號差
icon.png[出售] [全國]全新千尋侘草LED燈, 水草

請輸入看板名稱,例如:e-shopping站內搜尋

TOP