將數據分配給不均勻間隔事件的日期向量

Question

對於隱藏的標題，我很抱歉，但我不知道如何充分總結我的問題。所以這是我的問題。我有日期的幾個實體數據幀和一個名字：

df <- data.frame(
     time=rep(as.Date(seq(as.Date("2004/1/1"), as.Date("2005/12/1"), by = "1 month ")),2), 
     name=c(rep("a",24),rep("b",24)) 
) 
    str(df) 

    'data.frame': 48 obs. of 2 variables: 
    $ time: Date, format: "2004-01-01" "2004-02-01" ... 
    $ name: Factor w/ 2 levels "a","b": 1 1 1 1 1 1 1 1 1 1 ... 

而且我還有一個dataframe幾個間隔不均勻事件：

events <- data.frame(
      time = c("2004-12-1", "2005-8-1", "2005-6-1", "2004-4-1"), 
      event = c("normal", "extraordinary", "normal", "extraordinary"), 
      name = c("a", "a", "b", "b") 
    ) 

我想要的方式合併這兩個數據幀即event分配自數據集至事件的開始或開始於最後一個事件直至下一個事件或數據集結束。這看起來是這樣的：

date  name event 
    2004-01-01 a  normal 
    2004-01-02 a  normal 
     ... 
    2004-12-01 a  extraordinary 
    2005-01-01 a  extraordinary 

是否有R一個簡單的方法這樣做，我沒有看到或者我用手合併這些？非常感謝您的幫助！

Answer 1

我不知道有什麼功能，要做到這一點，但這裏是一些R代碼裏面做自己：

# Needed type coercions (Date for comparisons, characters to avoid 'factor' problems) 
events$time <- as.Date(events$time) 
events$event <- as.character(events$event) 
events$name <- as.character(events$name) 
df$name <- as.character(df$name) 

# Events ordering (needed to detect previous events as non NA) 
events <- events[ order(events$time) ,] 

# Updates 
df$event = NA 
for(i in 1:nrow(events)) { 
    # Update where time is lesser than the limit, if names correspond and if an event was not already assigned to the row 
    df[ df$time <= events[i,"time"] & df$name == events[i,"name"] & is.na(df$event) , "event" ] = events[i,"event"] 
} 

Answer 2

這裏是一個函數來完成你想要什麼：

event.aligning <- function(time.dataframe, events){ 
    if(!class(events[["time"]]) == 'Date'){ 
    events[["time"]] <- as.Date(events[["time"]]) 
    } 
    ## lets sort on time 
    events <- events[order(events[["time"]]),] 

    ## setup event column 
    time.dataframe$event <- NA 
    time.dataframe$event <- as.factor(time.dataframe$event) 
    levels(time.dataframe$event) <- event.types 
    rownames.tdf <- rownames(time.dataframe) 

    res.time.dataframe <- NULL 
    for(i in 1:length(levels(events$name))){ 
    i.name <- levels(events$name)[i] 

    i.name.events <- subset(events, name == i.name) 

    first.time <- time.dataframe$time[time.dataframe$name == i.name][1] 
    first.event <- i.name.events$time[1] 

    ## assume 2 events 
    first.event.type <- i.name.events$event[1] 
    second.event.type <- unique(i.name.events$event[i.name.events$event !=  first.event.type]) 

    event.types <- levels(i.name.events$event) 

    sub.time.df <- time.dataframe[time.dataframe$name == i.name,] 
    rownames(sub.time.df) <- 1:length(sub.time.df[,1]) 

    sub.time.df[1:(as.numeric(rownames(sub.time.df[sub.time.df$time == first.event,])) - 1),]$event <- second.event.type 

    cur.event <- first.event 
    for(j in 2:length(i.name.events[,1])){ 
     next.event <- i.name.events$time[j] 
     sub.time.df[rownames(sub.time.df[ sub.time.df[["time"]] == cur.event,]) : 
     (as.numeric(rownames(sub.time.df[sub.time.df[["time"]] == next.event,])) - 1),]$event <- i.name.events$event[j-1] 
     cur.event <- next.event 
     next.event.type = i.name.events$event[j] 
    }  
    last.time <- sub.time.df$time[length(sub.time.df$time)] 
    last.event <- i.name.events$time[length(i.name.events$time)] 
    sub.time.df[rownames(sub.time.df[sub.time.df$time == last.event,]):length(sub.time.df$time),]$event <- next.event.type 
    res.time.dataframe <- rbind(res.time.dataframe, sub.time.df) 
    } 
    rownames(res.time.dataframe) <- rownames.tdf 
    return(res.time.dataframe) 
} 


df2 <- event.aligning(df, events)