如何在 R 中进行循环计算？答案

【问题标题】：How to do loop calculations in R?如何在 R 中进行循环计算？
【发布时间】：2021-09-06 16:02:23
【问题描述】：

我的情况是每个商品都有一个数据文件，我把这样的数据文件写入R：

price_data <- read.table("commodityA.txt", sep="\t", header=TRUE, dec=",")

然后我得到下表作为数据框：

TIME                  return 
...                   ...
2005-01-05 10:15:00   0.5  
2005-01-05 10:16:00   0.6  
2005-01-05 10:17:00   0.3 
2005-01-05 10:18:00   0.1
2005-01-05 10:19:00   0.5
2005-01-05 10:20:00   0.5  
2005-01-05 10:21:00   0.2  
2005-01-05 10:22:00   0.5 
2005-01-05 10:23:00   0.2
2005-01-05 10:24:00   0.5

以上是一种商品的数据。除此之外，我还有如下所示的数据框：

TIME                 Event Type                 
2004-12-15 12:45:00  A
2005-01-05 10:20:00  B
2005-10-31 11:05:00  C

我正在尝试找到一种将 Excel 事件与财务数据联系起来的方法。例如，对于2005-01-05 10:20:00 的第二个事件。此事件将是t=0，返回0.5。事件前一分钟为t=-1，事件后一分钟为t=1。

我想将这里三个t 的三个给定回报与预期回报进行比较以检查异常情况......因此我需要之前日期的回报平均值。让我们在这里取一个四分钟的时间范围，例如t=-5 to t=-2，所以我们有：

2005-01-05 10:15:00   0.5  
2005-01-05 10:16:00   0.6  
2005-01-05 10:17:00   0.3 
2005-01-05 10:18:00   0.1

平均计算：(0.5+0.6+0.3+0.1)/4 = 0.375。然后检查这三个t是否有异常

t=-1:  0.5 - 0.375 =  0.125
t= 0:  0.5 - 0.375 =  0.125
t= 1:  0.2 - 0.375 = -0.175

然后将结果写入数据框，然后写入excel，结构如下：最终得到如下列表：

TIME                 Event Type  t=-1   t= 0  t= 1
2004-12-15 12:45:00  A           ...    ...   ...
2005-01-05 10:20:00  B           0.125  0.125 -0.175
2005-10-31 11:05:00  C           ...    ...   ...

是否有可能创建一个循环或其他东西来计算 excel 中给出的所有TIME，以便我有一个完整的事件时间、类型和异常列表？我的 Excel 列表中有 50 多个事件。

感谢每一个帮助。谢谢！

【问题讨论】：

标签： r loops calculation

【解决方案1】：

您想要做的事情非常简单。

在写入时从文件中读取数据

library(tidyverse)
library(lubridate)

price_data = tribble(
 ~TIME, ~return,
 "2005-01-05 10:15:00", 0.5,
 "2005-01-05 10:16:00", 0.6,
 "2005-01-05 10:17:00", 0.3,
 "2005-01-05 10:18:00", 0.1,
 "2005-01-05 10:19:00", 0.5,
 "2005-01-05 10:20:00", 0.5,
 "2005-01-05 10:21:00", 0.2,
 "2005-01-05 10:22:00", 0.5,
 "2005-01-05 10:23:00", 0.2,
 "2005-01-05 10:24:00", 0.5
) %>% mutate(TIME = ymd_hms(TIME))

event_data = tribble(
  ~TIME,                 ~Event.Type,
  "2004-12-15 12:45:00", "A",
  "2005-01-05 10:20:00", "B",
  "2005-01-05 10:21:00", "C",
  "2005-01-05 10:23:00", "A",
  "2005-10-31 11:05:00", "C"
) %>% mutate(TIME = ymd_hms(TIME))

准备一个函数，按照您编写的方法进行计算

f1 = function(event_time, price_data){
  out = tibble(`t-1` = NA, t0 = NA, `t+1`=NA)
  idx = which(price_data$TIME==event_time)
  if(length(idx)==0) return(out)
  if(idx<6) return(out)
  if(idx>(nrow(price_data)-1)) return(out) 
  mt2t5 = mean(price_data$return[(idx-5):(idx-2)])
  tibble(`t-1` = price_data$return[idx-1] - mt2t5, 
         t0 = price_data$return[idx] - mt2t5, 
         `t+1` = price_data$return[idx+1] - mt2t5) 
}

进行突变

event_data %>% 
  mutate(data = map(TIME, f1, price_data)) %>% 
  unnest(data)

输出

# A tibble: 5 x 5
  TIME                Event.Type  `t-1`     t0  `t+1`
  <dttm>              <chr>       <dbl>  <dbl>  <dbl>
1 2004-12-15 12:45:00 A          NA     NA     NA    
2 2005-01-05 10:20:00 B           0.125  0.125 -0.175
3 2005-01-05 10:21:00 C           0.125 -0.175  0.125
4 2005-01-05 10:23:00 A           0.175 -0.125  0.175    
5 2005-10-31 11:05:00 C          NA     NA     NA

它已经准备好了！

但是，不要错过f1 函数中的相应安全功能。这些是索引idx<6 和idx>(nrow(price_data)-1)

更新

好的，让我们尝试修改我们的函数f1，以便t1 和t2 是可以取任何值的参数。这是更正后的代码。

library(tidyverse)
library(lubridate)

price_data = tribble(
 ~TIME, ~return,
 "2005-01-05 10:10:00", 0.5,
 "2005-01-05 10:11:00", 0.6,
 "2005-01-05 10:12:00", 0.3,
 "2005-01-05 10:13:00", 0.1,
 "2005-01-05 10:14:00", 0.5,
 "2005-01-05 10:15:00", 0.5,
 "2005-01-05 10:16:00", 0.6,
 "2005-01-05 10:17:00", 0.3,
 "2005-01-05 10:18:00", 0.1,
 "2005-01-05 10:19:00", 0.5,
 "2005-01-05 10:20:00", 0.5,
 "2005-01-05 10:21:00", 0.2,
 "2005-01-05 10:22:00", 0.5,
 "2005-01-05 10:23:00", 0.2,
 "2005-01-05 10:24:00", 0.5
) %>% mutate(TIME = ymd_hms(TIME))

event_data = tribble(
  ~TIME,                 ~Event.Type,
  "2004-12-15 12:45:00", "A",
  "2005-01-05 10:20:00", "B",
  "2005-01-05 10:21:00", "C",
  "2005-01-05 10:23:00", "A",
  "2005-10-31 11:05:00", "C"
) %>% mutate(TIME = ymd_hms(TIME))


f1 = function(event_time, price_data, t1=2, t2=-2){
  out = tibble(`t-1` = NA, t0 = NA, `t+1`=NA)
  idx = which(price_data$TIME==event_time)
  if(length(idx)==0) return(out)
  if((idx+t1)<1 | (idx+t2)<1 | 
     (idx+t1)>nrow(price_data) | (idx+t2)>nrow(price_data) | 
     idx==(nrow(price_data)-1) | idx==1) return(out)
  mt1t2 = mean(price_data$return[(idx+t1):(idx+t2)])
  tibble(`t-1` = price_data$return[idx-1] - mt1t2,
         t0 = price_data$return[idx] - mt1t2,
         `t+1` = price_data$return[idx+1] - mt1t2)
}

event_data %>%
  mutate(data = map(TIME, f1, price_data, 2, -8)) %>%
  unnest(data)

输出

# A tibble: 5 x 5
  TIME                Event.Type  `t-1`     t0  `t+1`
  <dttm>              <chr>       <dbl>  <dbl>  <dbl>
1 2004-12-15 12:45:00 A          NA     NA     NA    
2 2005-01-05 10:20:00 B           0.127  0.127 -0.173
3 2005-01-05 10:21:00 C           0.136 -0.164  0.136
4 2005-01-05 10:23:00 A          NA     NA     NA    
5 2005-10-31 11:05:00 C          NA     NA     NA

最后，说几句。在进行索引操作时，您必须始终小心不要超出向量或数据帧索引的允许范围。在这种情况下，我们必须确保索引始终在1: nrow (price_data) 范围内。所以我们必须控制参数t1 和t2，如果它们导致超出允许的索引，请做出相应的反应。在这种情况下，NA 响应似乎是合适的 (if((idx+t1)<1 | ...idx==1) return(out))。

当然，索引不能是空值，当event_data tibble 中的TIME 值在price_data tibble (if(length(idx)==0) return(out)) 中找不到时会发生这种情况。

更新 2

f2 = function(event_time, price_data, t1=2, t2=-2){
  out = tibble(`t-2` = NA, `t-1` = NA, t0 = NA, `t+1`=NA, `t+2`=NA)
  idx = which(price_data$TIME==event_time)
  if(length(idx)==0) return(out)
  if((idx+t1)<1 | (idx+t2)<1 |
     (idx+t1)>nrow(price_data) | (idx+t2)>nrow(price_data) |
     idx==(nrow(price_data)-1) | idx==1 |
     idx==(nrow(price_data)-2) | idx==2) return(out)
  mt1t2 = mean(price_data$return[(idx+t1):(idx+t2)])
  tibble(`t-2` = price_data$return[idx-2] - mt1t2,
         `t-1` = price_data$return[idx-1] - mt1t2,
         t0 = price_data$return[idx] - mt1t2,
         `t+1` = price_data$return[idx+1] - mt1t2,
         `t+2` = price_data$return[idx+2] - mt1t2)
}

event_data %>%
  mutate(data = map(TIME, f2, price_data, 2, -8)) %>%
  unnest(data)

输出

# A tibble: 5 x 7
  TIME                Event.Type  `t-2`  `t-1`     t0  `t+1`  `t+2`
  <dttm>              <chr>       <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
1 2004-12-15 12:45:00 A          NA     NA     NA     NA     NA    
2 2005-01-05 10:20:00 B          -0.273  0.127  0.127 -0.173  0.127
3 2005-01-05 10:21:00 C           0.136  0.136 -0.164  0.136 -0.164
4 2005-01-05 10:23:00 A          NA     NA     NA     NA     NA    
5 2005-10-31 11:05:00 C          NA     NA     NA     NA     NA

【讨论】：

event_data 表的第 3 行和第 4 行中，我专门为此编写了事件 C 和 B，以便有更多数据来测试函数。没有别的了。
请不要忘记接受最终解决您问题的解决方案。
f1 函数在索引超过1: nrow (price_data) 无法返回有效结果时返回值tibble (" t-1 "= NA," t0 "= NA," t + 1 "= NA)。 price_data 包含 event_data 中的所有值这一事实并不那么明显。例如，它在您提供的示例数据中。为此，我控制length (idx) == 0
它必须是这样的，因为例如，如果event_data 在price_data 的第一个索引上会发生什么？如何计算t-1？如果event_data 在price_data 的最后一个索引上怎么办？我如何获得t+1？更不用说，您可以通过为t1 和t2 指定太多（或太少）来尝试自己交叉索引。以这样一种方式编写您的程序，以便您始终预测可能出现的问题。
我添加了更新 2，函数 f2 返回 t-2, t-1, t0, t1, t2

【解决方案2】：

假设您有两个数据帧 price_data 和 event_data 中的数据，并且都有一个名为 TIME 的列用于合并，这应该可以解决问题

all_data <- merge(price_data, event_data, all=TRUE)
all_data <- cbind(all_data,"t-1"=c(NA,all_data[,2][-nrow(all_data)]),"t"=all_data[,2],"t+1"=c(all_data[,2][-1],NA))
all_data[,2] <- round(rowMeans(all_data[,4:6]),2)
all_data[,4:6] <- all_data[,4:6]-all_data[,2]

【讨论】：