作者celestialgod (攸蓝)
看板R_Language
标题Re: [问题] 一维阵列相临值取平均的实作
时间Fri Jul 24 09:14:22 2015
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://webptt.com/cn.aspx?n=bbs/R_Language/M.1437700465.A.072.html
1F：→ andrew43: 太细心了～连输入验证都帮我写了！ 07/24 15:19
不客气
※ 编辑: celestialgod (123.205.27.107), 07/24/2015 15:58:21