Re: [問題] 一維陣列相臨值取平均的實作

看板R_Language作者 (攸藍)時間9年前 (2015/07/24 09:14), 9年前編輯推噓0(001)
留言1則, 1人參與, 最新討論串2/2 (看更多)
nxply <- function(x, n, FUN, na.rm = FALSE, ...){ if (!is.vector(x)) stop("The input must be a vector.") if (na.rm) x = na.omit(x) if (length(n) == 1) n <- rep(n, 2) if (all(n == 0)) return(sapply(x, function(y) FUN(y, ...))) if (sum(n)+1 > length(x)) stop("The number of proximity number is more than the length of vector.") ns <- sum(n) out <- vector('numeric', length(x)) if (n[2] > 0) for (i in 1:n[2]) out[i] <- FUN(head(x,n[1]+i), ...) if (n[1] > 0) for (i in 1:n[1]) out[length(x)-i+1] <- FUN(tail(x,n[2]+i), ...) for (i in 1:(length(x)-ns)) out[n[2]+i] <- FUN(x[i:(ns+i)], ...) return(out) } nxply(1:5, 0, mean) nxply(1:5, 1, mean) nxply(1:5, 1, sum) nxply(1:5, 2, sum) nxply(1:5, 2, quantile, p = 0.05) nxply(1:5, 2, quantile, p = 0.05) nxply(1:5, 2, min) nxply(1:5, 2, max) nxply(1:5, 3, sum) nxply(1:5, c(0,1), sum) nxply(1:5, c(1,0), sum) locVec <- sample(c(TRUE, FALSE), 5, TRUE) nxply(locVec, c(1,0), any) nxply(locVec, 1, any) nxply(LETTERS[1:5], c(0,1), paste0, collapse = "") nxply(LETTERS[1:5], 1, paste0, collapse = "") 後來發現zoo:::rollapply有一樣的功能 ※ 引述《andrew43 (討厭有好心推文後刪文者)》之銘言: : [問題類型]: 程式諮詢 : [軟體熟悉度]: 使用者 : [問題敘述]: 想寫一個 function 自動求出相鄰元素之平均(或其它統計量) : 我想做出一個 funciton,可以做相鄰值的統計量或套用特定的 function。 : 目前想到的參數有 : 1. x: 來源 numeric vector : 2. n: 取幾個相鄰元素 : 3. FUN: 想套用的統計量或 function : 我的第一個困難是,在頭和在尾的元素在取相鄰元素會有例外。 : 例如 1:3 的第一個元素是 1,但它沒有上一個元素, : 所以就只能往之後的元素納入。 : 如果是用 for loop,裡頭做例外處理, : 我還辦得到,但不知道有沒有更好的寫法。 : 我的第二個困難是,我想寫成類似 R 中 *apply 系列的 FUN 的風格, : 但我不甚了解怎麼撰寫這類風格的 function。 : 我猜是建出一個 list 再用 lapply 來延伸,不知道好不好? : 舉一個例好了 : x <- 1:5 : newFun(x, n, FUN) <- function{...} : newFun(x, 0, sum) #回傳 1, 2, 3, 4, 5 : newFun(x, 1, sum) #回傳 3, 6, 9, 12, 9 : # =1+2 =1+2+3 =2+3+4 =3+4+5 =4+5 : newFun(x, 2, sum) #回傳 6, 10, 15, 14, 12 : newFun(x, 0, function(a){a+1}) #回傳 2,3,4,5,6 : 如果有什麼想法,歡迎請提供線索給我即可,不用全刻出來沒關係。 -- ※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 123.205.27.107 ※ 文章網址: https://www.ptt.cc/bbs/R_Language/M.1437700465.A.072.html

07/24 15:19, , 1F
太細心了~連輸入驗證都幫我寫了!
07/24 15:19, 1F
不客氣 ※ 編輯: celestialgod (123.205.27.107), 07/24/2015 15:58:21
文章代碼(AID): #1LiP5n1o (R_Language)
文章代碼(AID): #1LiP5n1o (R_Language)