2015-09-11 1 views
2

У меня есть большой data.table, который выглядит как:Использование adply в data.table

dt<-data.table(start=c("2012-07-13 23:45:00", "2012-07-14 15:30:00", 
         "2012-07-14 23:57:00"), 
       end=c("2012-07-14 00:02:00", "2012-07-14 15:35:00", 
        "2012-07-15 00:05:00"), id=c(1,2,1),cat=c("a","b","a")) 
dt 
       start     end id cat 
1: 2012-07-13 23:45:00 2012-07-14 00:02:00 1 a 
2: 2012-07-14 15:30:00 2012-07-14 15:35:00 2 b 
3: 2012-07-14 23:57:00 2012-07-15 00:05:00 1 a 

Мне нужно, чтобы получить выходной сигнал, который показывает общее количество минут события на каждый календарный день от ид и категории. Используя приведенный выше пример вывода должен быть:

  day id cat V1 
1: 13.07.2012 1 a 15 
2: 14.07.2012 1 a 5 
3: 14.07.2012 2 b 5 
4: 15.07.2012 1 a 5 

Я использовал adply функции из пакета plyr разделить продолжительность в интервалах по минуту:

fn<-function(x){ 
    s<-seq(from = as.POSIXct(x$start), 
     to = as.POSIXct(x$end)-1,by = "mins") 
# here s is a sequence of all minutes in the given interval 
    df<-data.table(x$id,x$cat,s) 

# return new data.table that contains each calendar minute for each id 
# and categoryy of the original data 
    df 
} 
# run the function above for each row in the data.table 
dd<-adply(dt,1,fn) 

# extract the date from calendar minutes 
dd[,day:=format(as.POSIXct(s,"%d.%m.%Y %H:%M%:%S"), "%d.%m.%Y")] 

#calculate sum of all minutes of event for each day, id and category 
dd[,.N,by=c("day","id","cat")][order(day,id,cat)] 

Решение выше идеально подходит моим потребностям, за исключением времени, необходимого для расчета. Когда adply запускается с очень большими данными и несколькими категориями, определенными в функции fn, кажется, что процессор работает навсегда.

Я высоко ценю любой намек на то, как использовать чистую функцию data.table в этой проблеме.

+0

Я полностью согласен с этим, но я не мог придумать лучшее решение :( – Asayat

+0

Могу ли я читать это неправильно, но вы просто не нашли разницы двух столбцов даты и времени? – Parfait

+0

Для начала, все ваше prcedure будет работать намного быстрее, если вы будете конвертировать 'start' и' end' в класс 'POSIXct' только один раз, используя' '' dt [, ': =' (start = as.POSIXct (start), end = as.POSIXct (end))] '' 'вместо того, чтобы делать это для каждой строки. Тогда' s' будет просто 's <- seq (start, end, by =" min ")'. Я предполагаю, что это ваша основная бутылка шея –

ответ

3

Я хотел бы предложить несколько вещей

  1. Преобразовать в as.POSIXct только один раз, а не в каждой строке.
  2. вместо adply, который создает целую data.table на каждой итерации, просто используйте by в пределах области data.table.
  3. Для того, чтобы сделать это, просто создать индекс строки, используя .I

Вот быстрая попытка (я использовал substr, потому что это будет, вероятно, быстрее, чем as.Date или as.POSIXct. Если вы хотите, чтобы это было Date класс снова, используйте res[, Date := as.IDate(Date)] на результат istead, сделав это по группе).

dt[, `:=`(start = as.POSIXct(start), end = as.POSIXct(end), indx = .I)] 
dt[, seq(start, end - 1L, by = "mins"), by = .(indx, id, cat) 
    ][, .N, by = .(Date = substr(V1, 1L, 10L), id, cat)] 
#   Date id cat N 
# 1: 2012-07-13 1 a 15 
# 2: 2012-07-14 1 a 5 
# 3: 2012-07-14 2 b 5 
# 4: 2012-07-15 1 a 5 
0

Постарайтесь, чтобы увидеть это быстрее. В фоновом режиме все еще data.table, но я использую синтаксис dplyr для процесса.

library(data.table) 

dt<-data.table(start=c("2012-07-13 23:45:00", "2012-07-14 15:30:00", 
         "2012-07-14 23:57:00"), 
       end=c("2012-07-14 00:02:00", "2012-07-14 15:35:00", 
        "2012-07-15 00:05:00"), id=c(1,2,1),cat=c("a","b","a")) 

fn<-function(x){ 
    s<-seq(from = as.POSIXct(x$start), 
     to = as.POSIXct(x$end)-1,by = "mins") 
    # here s is a sequence of all minutes in the given interval 
    df<-data.table(x$id,x$cat,s) 

    # return new data.table that contains each calendar minute for each id 
    # and categoryy of the original data 
    df 
} 


library(dplyr) 

dt %>% 
    rowwise() %>%      # for each row 
    do(fn(.)) %>%      # apply your function 
    select(day=s, id=V1, cat=V2) %>%  # rename columns 
    mutate(day = substr(day,1,10)) %>% # keep only the day 
    ungroup %>% 
    group_by(day,id,cat) %>%   
    summarise(N=n()) %>% 
    ungroup 


# Source: local data frame [4 x 4] 
# 
#   day id cat  N 
#   (chr) (dbl) (chr) (int) 
# 1 2012-07-13  1  a 15 
# 2 2012-07-14  1  a  5 
# 3 2012-07-14  2  b  5 
# 4 2012-07-15  1  a  5