Блог

Главная - Вопросы по программированию - Как выполнить вычисления цикла в R?

Как выполнить вычисления цикла в R?

#r #loops #calculation

Вопрос:

Мой случай заключается в том, что у меня есть файл данных для каждого товара, я записываю файл данных следующим образом в 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           ...    ...   ...

Есть ли возможность создать цикл или что-то, чтобы выполнить расчет для всех TIME данных в Excel, чтобы у меня был полный список времени, типа и аномалий события? У меня в списке Excel более 50 событий.

Мы ценим любую помощь. Спасибо!

Ответ №1:

What you want to do is trivially simple.

  1. Read data from files as you write
 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))
  1. Подготовьте функцию, которая будет выполнять вычисления так, как вы ее написали
 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) 
}
  1. Сделайте мутацию
 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) ).

Конечно, индекс не может быть пустым значением, и это то, что происходит, когда TIME значение из event_data tibble не найдено в 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

Комментарии:

1. В строках 3 и 4 event_data таблицы я написал события C и B только для этого, чтобы у меня было больше данных для тестирования функции. Ничего больше.

2. Пожалуйста, не забудьте принять решение, которое окончательно решит вашу проблему.

3. Значение tibble (" t-1 "= NA," t0 "= NA," t 1 "= NA) возвращается f1 функцией, когда эта функция не может возвращать допустимые результаты из-за превышения индексов 1: nrow (price_data) . Тот факт, что price_data содержит все значения, которые находятся в event_data, был не так очевиден. Например, это было в приведенных вами данных примера. Для этого я контролирую length (idx) == 0

4. Это должно быть так, потому что, например, что произойдет, если значение event_data находится в первом индексе price_data ? Как рассчитать t-1 ? Что, если event_data находится в последнем индексе price_data ? Как мне добраться t 1 ? Не говоря уже о том, что вы можете попытаться пересечь индексы самостоятельно, указав слишком много (или слишком мало) для t1 и t2 . Напишите свою программу таким образом, чтобы вы всегда предвидели возможные проблемы.

5. Я добавил обновление 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]
Метки: