R_Language 板


LINE

供你參考: factorizePrime <- function(num){ isPrime <-function(num){ return(sum(num %% 1:floor(sqrt(num)) == 0) <= 1) } FindMidTwo <- function(num){ left <- max(which(num %% 1:floor(sqrt(num)) == 0)) return(c(left, num/left)) } primeGroup <- FindMidTwo(num) repeat{ if(all(sapply(primeGroup, isPrime))) break keep <- sapply(primeGroup, isPrime) primeGroup <- c(primeGroup[keep], as.vector(sapply(primeGroup[!keep], FindMidTwo))) } return(table(primeGroup)) } ※ 引述《celestialgod (天)》之銘言: : PS: 希望你這個不是作業,作業要自己做XD : primefactor <- function(num){ : p <- which(num %% 1:num == 0) : isPrime <- function(num){ : return(sum(num %% 1:num == 0) == 2) : } : p <- p[sapply(p, isPrime)] : e <- vector('numeric', length(p)) : for (i in 1:length(p)) : { : repeat{ : if (num %% p[i]^e[i] != 0) : break : e[i] = e[i] + 1 : } : } : return(list('pfactor'=p, 'multi'=e - 1)) : } : st = proc.time() : primefactor(12345678) : # $pfactor : # [1] 2 3 47 14593 : # : # $multi : # [1] 1 2 1 1 : proc.time() - st : # user system elapsed : # 20.53 5.54 26.29 : env: [email protected] machine with RRO-3.2.2 in windows 7 SP1 : 在p <- which(num %% 1:num == 0)跟isPrime這兩步時要小心記憶體會被用完 : 如果擔心的話可以拆分成repeat去做 : 例如: : num = 12345678 : p = vector('numeric', 1000) : k = 1 : step_p = 100000 : repeat{ : tmp = which(num %% k:(k+step_p) == 0) : if (length(tmp) > 0) : p[(sum(p!=0)+1):(sum(p!=0)+length(tmp))] = tmp + k - 1 : if (k > num) break : k = k + step_p : } : p = p[p!=0] : # 1 2 3 6 9 18 47 : # 94 141 282 423 846 14593 29186 : # 43779 87558 131337 262674 685871 1371742 2057613 : # 4115226 6172839 12345678 : 給一個更快的方法(直接用向量化去做): : primefactorFast <- function(num){ : p <- which(num %% 1:num == 0) : isPrime <- function(num){ : return(sum(num %% 1:num == 0) == 2) : } : p <- p[sapply(p, isPrime)] : e <- vector('numeric', length(p)) : e_basic <- 1 : step_e <- 3 : subset_e <- 1:length(p) : repeat{ : m = num %% sweep(matrix(replicate(step_e, p[subset_e]), : length(p[subset_e])), 2, e_basic:(e_basic + step_e - 1), '^') == 0 : e[subset_e] = e[subset_e] + rowSums(m) : e_basic = e_basic + step_e : subset_e = which(apply(m,1,all)) : if (is.null(subset_e) || length(subset_e) == 0) : break : } : return(list('pfactor'=p, 'multi'=e)) : } : st = proc.time() : primefactorFast(12345678) : # $pfactor : # [1] 2 3 47 14593 : # : # $multi : # [1] 1 2 1 1 : proc.time() - st : # user system elapsed : # 0.06 0.00 0.06 : PS: 更動step_e可以得到更好的效能 : final version: http://pastebin.com/zkD3N2kp : test 2^11*3^6*47 (10^7.8) 只需要6.5秒 : ※ 引述《haolihy (好厲害)》之銘言: : : [問題類型]: : : 效能諮詢(我想讓R 跑更快) : : [軟體熟悉度]: : : 入門(寫過其他程式,只是對語法不熟悉) : : [問題敘述]: : : 質因數分解 : : [程式範例]: : : 想寫一個程式對正整數n作質因數分解 : : 目標是n<10^8 可以1min跑完 : : 我的程式大概要6~7min 改進空間應該很大 : : 而太慢的主因應該是列出<n質數表的程式太慢 : : 請大家賜教 : : 質數表的程式: : : primeY <- function(num){ : : sqnum <- floor(sqrt(num)) : : x <- c(2:num) : : y <- c() : : repeat{ : : if(x[1] > sqnum) break : : y <- c(y, x[1]) : : x <- x[x %% x[1] != 0] : : } : : return(c(y,x)) : : } : : 質因數分解的程式: : : primefactor <- function(num){ : : p <- primeY(num)[which(num %% primeY(num) == 0)] : : q <- c() : : e <- c() : : for(i in 1:length(p)){ : : e[i] <- 1 : : q[i] <- num / p[i] : : repeat{ : : if(q[i] %% p[i] != 0) break : : e[i] <- e[i] + 1 : : q[i] <- q[i] / p[i] : : } : : } : : return(list('pfactor'=p, : : 'multi'=e)) : : } : : [環境敘述]: : : R 3.2.2 --



※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 1.163.29.247
※ 文章網址: https://webptt.com/m.aspx?n=bbs/R_Language/M.1446660699.A.794.html
1F:→ haolihy: 謝謝! 11/05 13:32







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燈, 水草

請輸入看板名稱,例如:Gossiping站內搜尋

TOP