列循环通过用户函数并将输出存储在新创建的列 (R)

Column looping through a user function and storing output in a newly created column (R)

我有一些包含 oscillatory-like 模式的数据,想对峰值进行一些测量。我有几块代码,其中大部分都可以完全按照我的意愿工作。我遇到的主要问题是我不知道如何将它们集成在一起以在功能上协同工作。

本质上,我想使用我在数据帧上编写的 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 = 数据,to.add = 要添加到 df 的数据,new.name = 新列的名称

我想要的另一件事是 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 数据框中,而不是从单个向量创建它)。

几天来我一直在为这个问题苦思冥想,到目前为止已经取得了进展,但就是无法完全理解。

此外,请随时编辑标题以帮助它找到合适的人!

好的,首先,你的函数打印两次输出的原因是因为本质上发生的是:

  • instfreq 得到计算并 returned
  • instfreq 被打印出来
  • instfreq 正在分配给输出
  • 再次打印输出

此外,我想你不希望你的函数尝试为计数参数(returns 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

您问题的第二部分想要 return 变量的名称以将其用作新列的名称。为此我们可以使用 deparse(substitute(variable)) 所以你的函数变成:

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)

编辑添加循环 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
#...

这可能不是最有效的方法,但它可以完成工作