我有一些数据包含类似振荡的模式,并希望对峰值进行一些测量。我有几个代码块,其中大部分都可以完成我想要的工作。我遇到的主要问题是我不知道如何将它们集成到功能上。
基本上,我想使用我在数据帧上编写的freq函数,以便它遍历每一列(a,b和c)并给出函数的结果。然后我想将每列的输出存储在一个新的数据框中,列名与源名称匹配。
我已经阅读了很多关于循环遍历列并在数据框中创建新列的答案,这就是我到目前为止的方法。一些单件需要稍微调整,但我在任何地方都找不到的是一个很好的解释,我怎么能把它们放在一起。我试着无济于事;我只是看不出正确的订单。
(对于可重复的数据)
library(zoo)
count = 1:20
a = c(-0.802776, -0.748272, 0.187434, 1.23577, 1.00677, 0.874122, 0.232802, -0.279368, -1.57815, -1.76652, -0.958916, -0.316385, 0.831575, 1.19312, 1.45508, 0.848923, 0.257728, -0.318474, -1.14129, -1.42576)
b = c(-2.23512, -1.36572, -0.0357366, 0.925563, 1.53282, 0.171045, -0.438714, -1.38769, -0.696898, 1.37184, 2.01038, 2.6302, 2.53296, 1.8788, 0.100366, -1.34726, -1.4309, -1.37271, -0.750669, 0.100656)
c = c(0.749062, 0.0690315, -0.750494, -1.04069, -0.654432, 0.0186072, 0.710011, 0.920915, 1.13075, 0.227108, -0.195086, -0.68333, -0.607532, -0.485424, 0.495913, 0.655385, 0.468796, 0.274053, -0.906834 , 0.321526)
test = data.frame(count, a, b, c)
d = 20:40
这是我编写的代码块,用于遍历我指定的任何数据并识别局部峰值,然后根据识别的峰值计算一系列事物。它的效果非常好,并且这个功能没有问题(不过,欢迎提出更好的建议),只需将其与其他功能放在一起即可。 我想循环遍历数据帧的列(在下一节中使用for循环来实现)并获取每列的freq函数的结果
freq = function(x, y, data, w=1, span = 0.05, ...) {
require(zoo)
n = length(y)
y.smooth = loess(y ~ x, span = span)$fitted
y.max = rollapply(zoo(y.smooth), 2*w+1, max, align = "center")
delta = y.max - y.smooth[-c(1:w, n+1-1:w)]
i.max = which(delta <= 0) + w #identifies peaks
list(x = x[i.max], i = i.max, y.hat = y.smooth)
dist = diff(i.max) #calculates distance between peaks
instfreq = (25/dist) #calculates the rate of each peak occurence
print(instfreq) #output I ultimately want
}
#example
freq(count, a, span = 0.5)
这就是我在指定数据框中循环遍历列的方式。另外,我不确定我做了什么,但最终打印输出两次......(我想避免)。
for(i in test){
output <- freq(test$count, y = i, span = 0.5)
print(output)
}
这可能是让我头疼的部分。这应该将新列添加到现有数据框中。它到目前为止工作,但我还没有弄清楚如何将它集成到上面的东西。另外,我真的希望它将输出存储在新的数据帧中,而不是源数据帧。
供参考,这里df = data,to.add =要添加到df的数据,new.name =新col的名称
我想要的另一件事是new.name来自源(to.add)。例如,如果我尝试将d(从上面)添加到测试结束,我希望列名(new.name)读取d而不必指定它。当我循环遍历多个列并希望保留计算输出的源名称时,这将非常有用。
add.col = function(df, to.add, new.name){
if (nrow(df) < length(to.add)){
df = # pads rows if needed
rbind(df, matrix(NA, length(to.add)-nrow(df), ncol(df),
dimnames = list(NULL, names(df))))
}
length(to.add) = nrow(df) # pads with NA's
df[, new.name] = to.add; # names new col whatever was placed in new.name arg
return(head(df)) #shortened output so I can verify it worked
#when I was testing it for myself, this would
#need to be changed so that it adds the column
#to a dataframe and stores the results, which
#I believe would require I use print() and a store
#like Results = print(df)
}
#example
addcol(test, d, "d") #would like the code to grab the name d just from the to.add
#argument, without having to specify "d" as the new.name
任何帮助,建议或改进(使其不那么笨重,更有效率等)将不胜感激。 只要我能弄清楚如何将所有输出存储在一个地方,我就可以使用for循环(如果复制得到修复)。我的实际数据与上面的可重复集的格式类似,它只有更多的行和列(并且已经在.csv数据帧中,而不是从单个向量创建它。)
我已经在这几天打过头了,已经到目前为止但是却无法完全实现这一目标。
此外,您可以随时修改标题,以帮助它找到合适的人!
答案 0 :(得分:0)
好的,首先,你的功能打印输出两次的原因是因为基本上发生的是:
此外,我想你不希望你的函数尝试计算count参数(返回numeric(0)),所以最好只为其他列运行它。 最后,这种简单的for循环很容易被r中的apply函数替换。这将问题的第一部分带到:
freq = function(x, y, data, w=1, span = 0.05, ...) {
require(zoo)
n = length(y)
y.smooth = loess(y ~ x, span = span)$fitted
y.max = rollapply(zoo(y.smooth), 2*w+1, max, align = "center")
delta = y.max - y.smooth[-c(1:w, n+1-1:w)]
i.max = which(delta <= 0) + w #identifies peaks
list(x = x[i.max], i = i.max, y.hat = y.smooth)
dist = diff(i.max) #calculates distance between peaks
instfreq = (25/dist) #calculates the rate of each peak occurence
return(instfreq) #output I ultimately want
}
output <- apply(test[,2:length(test[1,])],2, function(v) freq(test$count, y=v, span=0.5))
output
# a b c
#2.500000 3.571429 2.777778
问题的第二部分想要返回变量的名称,以将其用作新列的名称。为此,我们可以使用deparse(替换(变量)),因此您的函数变为:
add.col = function(df, to.add){
new.name <- deparse(substitute(to.add))
if (nrow(df) < length(to.add)){
df = # pads rows if needed
rbind(df, matrix(NA, length(to.add)-nrow(df), ncol(df),
dimnames = list(NULL, names(df))))
}
length(to.add) = nrow(df) # pads with NA's
df[, new.name] = to.add; # names new col whatever was placed in new.name arg
return(df)
}
#example
dnametest = 20:40
add.col(test, dnametest)
# count a b c dnametest
#1 1 -0.802776 -2.2351200 0.7490620 20
#2 2 -0.748272 -1.3657200 0.0690315 21
#etc.
此功能将不覆盖原始数据框,因此您只需将其分配给新的数据框:
newframe <- add.col(test, dnametest)
EDIT增加了循环x数量的可能性:
您尝试循环时遇到的第一个问题是您正在使用不同长度的数组。这使得很难使用数据框,因此您必须使用列表。在这种情况下,编写一个可以接收任意数量数组的新函数会更容易,并自动为它们循环。因为在此函数中捕获并添加名称更容易,所以我重新调整了函数add.col以再次获取new.name:
add.col = function(df, to.add, new.name){
if (nrow(df) < length(to.add)){
df = # pads rows if needed
rbind(df, matrix(NA, length(to.add)-nrow(df), ncol(df),
dimnames = list(NULL, names(df))))
}
length(to.add) = nrow(df) # pads with NA's
df[, new.name] = to.add;
return((df))
}
然后我可以像这样编写第二个函数add.multicol:
#this function takes in an unspecfied number of arguments
add.multicol <- function(df, ...){
#convert this number of arguments to a list
to.add.cols <- list(...)
#add the variable names to this list
names(to.add.cols) <- as.list(substitute(list(...)))[-1]
#find number of columns to add
number.cols.to.add <- length(to.add.cols)
#loop add.col
newframe <- df
for(i in 1:number.cols.to.add){
to.add.col <- array(unlist(to.add.cols[i]))
to.add.col.name <- names(to.add.cols[i])
newframe <- add.col(newframe,to.add.col,to.add.col.name)
}
return(newframe)
}
这将允许您做任何您想要的。例如:
dnametest <- 20:40
test1 <- 1:15
test2 <- 25:56
argumentsake <- seq(0,1,length=21)
#run function
newframe <- add.multicol(test,dnametest,test1,test2,argumentsake)
newframe
# count a b c dnametest test1 test2 argumentsake
#1 1 -0.802776 -2.2351200 0.7490620 20 1 25 0.00
#2 2 -0.748272 -1.3657200 0.0690315 21 2 26 0.05
#3 3 0.187434 -0.0357366 -0.7504940 22 3 27 0.10
#4 4 1.235770 0.9255630 -1.0406900 23 4 28 0.15
#5 5 1.006770 1.5328200 -0.6544320 24 5 29 0.20
#6 6 0.874122 0.1710450 0.0186072 25 6 30 0.25
#7 7 0.232802 -0.4387140 0.7100110 26 7 31 0.30
#8 8 -0.279368 -1.3876900 0.9209150 27 8 32 0.35
#9 9 -1.578150 -0.6968980 1.1307500 28 9 33 0.40
#10 10 -1.766520 1.3718400 0.2271080 29 10 34 0.45
#11 11 -0.958916 2.0103800 -0.1950860 30 11 35 0.50
#12 12 -0.316385 2.6302000 -0.6833300 31 12 36 0.55
#13 13 0.831575 2.5329600 -0.6075320 32 13 37 0.60
#14 14 1.193120 1.8788000 -0.4854240 33 14 38 0.65
#15 15 1.455080 0.1003660 0.4959130 34 15 39 0.70
#16 16 0.848923 -1.3472600 0.6553850 35 NA 40 0.75
#17 17 0.257728 -1.4309000 0.4687960 36 NA 41 0.80
#18 18 -0.318474 -1.3727100 0.2740530 37 NA 42 0.85
#19 19 -1.141290 -0.7506690 -0.9068340 38 NA 43 0.90
#20 20 -1.425760 0.1006560 0.3215260 39 NA 44 0.95
#21 NA NA NA NA 40 NA 45 1.00
#22 NA NA NA NA NA NA 46 NA
#23 NA NA NA NA NA NA 47 NA
#24 NA NA NA NA NA NA 48 NA
#25 NA NA NA NA NA NA 49 NA
#26 NA NA NA NA NA NA 50 NA
#27 NA NA NA NA NA NA 51 NA
#28 NA NA NA NA NA NA 52 NA
#29 NA NA NA NA NA NA 53 NA
#30 NA NA NA NA NA NA 54 NA
#31 NA NA NA NA NA NA 55 NA
#32 NA NA NA NA NA NA 56 NA
编辑2:扩展循环以接收任何形式的数据帧
现在它变得非常混乱,您还需要重命名输出元素,以便它们不匹配已存在的任何列名。
add.multicol <- function(df, ...){
#convert this number of arguments to a list
to.add.cols <- list(...)
#find number of columns to add
number.args <- length(to.add.cols)
#number of elements per list entry
hierarch.cols.to.add <- array(0,length(number.args))
for(i in 1:number.args){
#if this list element has only one name, treat it as an array, else treat it as a data frame
if(is.null(names(to.add.cols[[i]]))){
#get variable names from input of normal arrays
names(to.add.cols[[i]]) <- as.list(substitute(list(...)))[i+1]
hierarch.cols.to.add[i] <- 1
} else {
#find the number of columns in the data frame
number <- length(names(to.add.cols[[i]]))
hierarch.cols.to.add[i] <- number
}
}
#loop add.col
newframe <- df
for(i in 1:number.args){
#if array
if(hierarch.cols.to.add[i]==1){
to.add.col <- array(unlist(to.add.cols[[i]]))
to.add.col.name <- names(to.add.cols[[i]][1])
newframe <- add.col(newframe,to.add.col,to.add.col.name)
} else { #if data.frame
#foreach column in the data frame
for(j in 1:hierarch.cols.to.add[i]){
#if only one element per column
if(is.null(dim(to.add.cols[[i]]))){
to.add.col <- to.add.cols[[i]][j]
} else { #if multiple elements per column
to.add.col <- to.add.cols[[i]][,j]
}
to.add.col.name <- names(to.add.cols[[i]])[j]
newframe <- add.col(newframe,to.add.col,to.add.col.name)
}
}
}
return(newframe)
}
testdf <- data.frame(cbind(test1,test2))
dnametest <- 20:40
output <- apply(test[,2:length(test[1,])],2, function(v) freq(test$count, y=v, span=0.5))
#edit output names because we can't have a dataframe with the same name for multiple columns
names(output) <- c("output_a","output_b","output_c")
newframe <- test
#function now takes dataframes of single elements, normal data frames and single arrays
newframe <- add.multicol(newframe,output,dnametest,testdf)
# count a b c output_a output_b output_c dnametest test1 test2
#1 1 -0.802776 -2.2351200 0.7490620 2.5 3.571429 2.777778 20 0 25
#2 2 -0.748272 -1.3657200 0.0690315 NA NA NA 21 1 26
#3 3 0.187434 -0.0357366 -0.7504940 NA NA NA 22 2 27
#4 4 1.235770 0.9255630 -1.0406900 NA NA NA 23 3 28
#...
这可能不是最有效的方式,但它可以完成工作