2

次の形式のデータセットがあります。

df <- data.frame(var1 = c("1976-07-04" , "1980-07-04" , "1984-07-04" ), 
                   var2 = c('d', 'e', 'f'), 
                   freq = 1:3)

次の方法でインデックスを作成することにより、この data.frame を非常に迅速に拡張できます。

df.expanded <- df[rep(seq_len(nrow(df)), df$freq), ]

ただし、日付の複製ではなくシーケンスを作成し、freq にこれの長さを教えてもらいたいです。つまり、行 3 の場合、展開された data.frame を次のように埋めるエントリを作成できます。

seq(as.Date('1984-7-4'), by = 'days', length = 3)

誰でもこれを行うための高速な方法を提案できますか? 私の方法は、これを行うためにさまざまなlapply関数を使用することです

Gavin Simpson の回答と以前のアイデアを組み合わせてソリューションを使用しました。

ExtendedSeq <- function(df, freq.col, date.col, period = 'month') {
  #' An R function to take a data fame that has a frequency col and explode the 
  #' the dataframe to have that number of rows and based on a sequence.
  #'  Args:
  #'   df: A data.frame to be exploded.
  #'   freq.col: A column variable indicating the number of replicates in the 
  #'             new dataset to make.
  #'   date.col: A column variable indicating the name or position of the date
  #'             variable.
  #'   period: The periodicity to apply to the date.

  # Replicate expanded data form
  df.expanded <- df[rep(seq_len(nrow(df)), df[[freq.col]]), ]

  DateExpand <- function(row, df.ex, freq, col.date, period) {
    #' An inner functions to explode a data set and build out days sequence
    #'  Args:
    #'    row: Each row of a data set 
    #'    df.ex: A data.frame, to expand
    #'    freq: Column indicating the number of replicates to make.
    #'    date: Column indicating the date variable
    #'  Output:
    #'    An exploded data set based on a sequence expansion of a date.
    times <- df.ex[row, freq]
    # period <- can edit in the future if row / data driven.
    date.ex <- seq(df.ex[row, col.date], by = "days", length = times)
    return(date.ex)
  }

dates <- lapply(seq_len(nrow(df)), 
                FUN = DateExpand, 
                df.ex = df,
                freq = freq.col,
                col.date = date.col,
                period = period)

df.expanded[[date.col]] <- as.Date(unlist(dates), origin = '1970-01-01')
row.names(df.expanded) <- NULL
return(df.expanded)
}

個人的には、リストから日付を元に戻して、将来これが変更された場合に備えて、この変換に基づいて起源を提供する必要がある方法は好きではありませんが、アイデアと助けに本当に感謝しています

4

3 に答える 3

3

1 つの方法を次に示します。

extendDF <- function(x) {
    foo <- function(i, z) {
        times <- z[i, "freq"]
        out <- data.frame(seq(z[i, 1], by = "days", length = times),
                          rep(z[i, 2], times),
                          rep(z[i, 3], times))
        names(out) <- names(z)
        out
    }
    out <- lapply(seq_len(nrow(x)), FUN = foo, z = x)
    do.call("rbind", out)
}

これは、 の各行にインライン関数を適用して、インデックス1:nrow(df)(つまり の行インデックス) を反復処理します。基本的には拡張するだけで、何回も呼び出しを使用して拡張します。関数は、列の順序、名前などについていくつかの仮定を行いますが、必要に応じて変更できます。dffoodffoo()var2freqfreqseq()var1

他の唯一のビットは、 で各行を順番に変換するよりも、すべてを 1 つvar1のオブジェクトに変換する方がはるかに効率的であるため、ここでは を使用して最初に単一の変換を行うことです。"Date"extendDF()transform()

df <- transform(df, var1 = as.Date(var1))

それから電話するextendDF()

extendDF(df)

これは与える：

R> df <- transform(df, var1 = as.Date(var1))
R> extendDF(df)
        var1 var2 freq
1 1976-07-04    d    1
2 1980-07-04    e    2
3 1980-07-05    e    2
4 1984-07-04    f    3
5 1984-07-05    f    3
6 1984-07-06    f    3
于 2012-09-03T10:43:24.363 に答える
1

短い、必ずしも速いとは限らない：

library(plyr)
adply(df, 1, summarize, var3 = seq(as.Date(var1), by = "days", length = freq)) 
#         var1 var2 freq       var3
# 1 1976-07-04    d    1 1976-07-04
# 2 1980-07-04    e    2 1980-07-04
# 3 1980-07-04    e    2 1980-07-05
# 4 1984-07-04    f    3 1984-07-04
# 5 1984-07-04    f    3 1984-07-05
# 6 1984-07-04    f    3 1984-07-06
于 2012-09-03T10:54:38.893 に答える
0

別のもの：

df <- data.frame(var1 = c("1976-07-04" , "1980-07-04" , "1984-07-04" ),  var2 = c('d', 'e', 'f'),  freq = 1:3) 
df$id <- seq_len(nrow(df))
expanded <- apply(df[c("id","var1","freq")], MARGIN=1, FUN=function(x) {
  result <- seq.Date(as.Date(x["var1"]), length.out = as.integer(x["freq"]), by = "day")
  data.frame(id = rep(as.integer(x["id"]), length(result)), result=result)
})
expanded <- do.call(rbind, expanded)
expanded <- plyr:::join(x = expanded, y = df, by="id", type = "left", match = "first")
head(expanded)
于 2012-09-03T12:02:05.263 に答える