不均等な間隔のイベントのベクトルにデータを割り当てる

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持っている：私は方法でこれらの2つのデータフレームをマージしたい

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)