ускорить R применить к кадру данных - PullRequest
Новая
       4

ускорить R применить к кадру данных

0 голосов
/ 04 октября 2019

У меня есть набор данных о скачках. Для каждого рекорда скачек, если значение трассы не пропущено, я хочу посчитать количество побед лошадей за последние два года на одном и том же месте, трассе и схожей дистанции. Я использую «Применить», чтобы зациклить каждую строку. Я только хочу добавить новый счетчик столбцов предыдущего выигрыша к исходному набору данных, поэтому выходные данные должны иметь еще один столбец и ту же длину строки, что и входные данные. Но скорость очень низкая. Как я могу ускорить цикл?

rdate: скачки год-месяц-дата. место проведения: ST, HV. трек: TURF, All WEATHER TRACK. дистанция: 1200, 1400, 1600, 1800 и т. д. ind_win: 0 (лошадь не заняла 1-е место), 1 (лошадь заняла 1-е место). 

structure(list(rdate = structure(c(17450, 17475, 17481, 17496, 
17510, 17517, 17532, 17566, 17593, 17615, 17629, 17657, 17667, 
17796, 17817, 17839, 17856, 17860, 17881, 17881, 17902, 17902
), class = "Date"), venue = c("HV", "ST", "ST", "ST", "ST", "ST", 
"ST", "ST", "ST", "ST", "ST", "ST", "HV", "ST", "ST", "ST", "HV", 
"ST", "ST", "ST", "ST", "ST"), track = c("TURF", "TURF", "TURF", 
"TURF", "TURF", "TURF", "TURF", "TURF", "TURF", "TURF", "TURF", 
"TURF", "TURF", "TURF", "TURF", "TURF", "TURF", "TURF", "TURF", 
"TURF", "TURF", "TURF"), horsenum = c("A366", "A366", "A366", 
"A366", "A366", "A366", "A366", "A366", "A366", "A366", "A366", 
"A366", "A366", "B440", "B440", "B440", "A366", "B440", "A366", 
"B440", "A366", "B440"), distance = c(1800L, 1800L, 1600L, 1600L, 
1800L, 1600L, 1800L, 1800L, 1800L, 1600L, 1800L, 2000L, 1800L, 
1200L, 1400L, 1400L, 1650L, 1400L, 1600L, 1400L, 1800L, 1400L
), ind_win = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 1L)), row.names = c(NA, -22L
), class = "data.frame")

library(tidyverse)
library(lubridate)

HWinCountF <- function(df){
    if (!is.na(df["track"])) {
      tmp <- subset(jc.data, horsenum == df["horsenum"] & rdate < df["rdate"] & rdate > ymd(df["rdate"]) - years(2) &
                      venue == df["venue"] & track==df["track"] &  distance>=as.integer(df["distance"])-200 &
                      distance<=as.integer(df["distance"])+200)
      if (nrow(tmp) > 0) {
        return(nrow(tmp[tmp$ind_win == 1,]))
      } else {
        return(NA)
      }
    } else {
      return(NA)
    }
  }

  jc.data['h_win_count'] <- apply(jc.data, 1, HWinCountF)

1 Ответ

0 голосов
/ 04 октября 2019

По потребностям ОП

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

Как этоЭто простая агрегация, избегайте зацикливания и рассмотрите merge с subset фрейма данных на себе, так как вам, кажется, нужно сравнить наблюдения друг с другом. Затем запустите aggregate для победы лошади. Ниже приведены примеры размещенных данных. 

# MERGE BY COMMON VARIABLES AND SUBSET RESULTS BY DATE AND DISTANCE
compare_df <- subset(merge(jc.data, jc.data, by=c("horsenum", "venue", "track")),
                     rdate.x < rdate.y &
                     rdate.x > lubridate::ymd(rdate.y) - lubridate::years(2) &
                     distance.x >= as.integer(distance.y) - 200 &
                     distance.x <= as.integer(distance.y) + 200 
              )

# SUM ind_win GROUPED BY COMMON VARIABLES
agg_df <- aggregate(cbind(h_win_count = ind_win.x) ~ horsenum + venue + track, 
                    data = compare_df, FUN=sum)

agg_df
#   horsenum venue track h_win_count
# 1     A366    HV  TURF           0
# 2     A366    ST  TURF           0
# 3     B440    ST  TURF           2
...