0

2 つの列を持つ data.frame があります。

category quantity
a          20
b          30
c          100
d          10
e          1
f          23
g          3
h          200

2 つのパラメーターを持つ関数を作成する必要があります。dataframeは、数量列を超えて実行され、超過した場合は後続の行を分割しbin_size、実行中のビン番号を追加の列として追加します。cumsumcumsumbin_size

次のように入力します。

function(dataframe, 50)

上記の例では、次のようになります。

category    quantity    cumsum  bin_nbr
a            20        20         1
b            30        50         1
c            50        50         2
c            50        50         3
d            10        10         4
e            1         11         4
f           23         34         4
g            3         37         4
h            13        50         4
h            50        50         5
h            50        50         6
h            50        50         7
h            37        37         8

説明：

row a + b sum up to 50 --> bin_nbr 1
row c is 100 -> split into 2 rows @ 50 -> bin nbr 2, bin_nbr 3
row d,e,f,g sum up to 37 -> bin_nbr 4
I need another 13 from row h to fill in bin_nbr 4 to 50
The rest of the remaining quantity from h will be spitted into 4 bins -> bin_nbr 5, 6, 7, 8
4

3 に答える 3

1

行間の依存関係とサイズの変化するデータ フレームがあるため、apply/data.table などを使用してこれを行うクリーンな方法は考えられませんでした。おそらく反復/再帰的な方法でそれを行うことができますが、ループを書くだけで理解する方が速いと感じました. 課題の 1 つは、オブジェクトの最終的なサイズを知るのが難しいため、処理が遅くなる可能性があることです。このアプリケーションでパフォーマンスが問題になる場合は、df からマトリックスに切り替えることで、問題をいくらか軽減できます (変換ビットを除いて、コードは正常に動作するはずです)。

fun <- function(df, binsize){
  df$cumsum <- cumsum(df$quantity)
  df$bin <- 1
  i <- 1
  repeat {
    if((extra <- (df[i, "cumsum"] - binsize)) > 0) { # Bin finished halfway through
      top <- if(i > 1L) df[1L:(i - 1L), ] else df[0L, ]
      mid <- transform(df[i, ], quantity=quantity-extra, cumsum=cumsum-extra)
      bot <- transform(df[i, ], quantity=extra, cumsum=extra, bin=bin + 1L)
      end <- if(i >= nrow(df)) df[0L, ] else df[(i + 1L):nrow(df), ]
      end <- transform(end, cumsum=cumsum(end$quantity) + extra, bin=bin + 1L)
      df <- rbind(top, mid, bot, end)
    } else if (extra == 0 && nrow(df) > i) {  # Bin finished cleanly
      df[(i + 1L):nrow(df), ]$cumsum <- df[(i + 1L):nrow(df), ]$cumsum - binsize
      df[(i + 1L):nrow(df), ]$bin <- df[(i + 1L):nrow(df), ]$bin + 1L
    }
    if(nrow(df) < (i <- i + 1)) break
  }
  rownames(df) <- seq(len=nrow(df))
  df
}
fun(df, binsize) 

#    category quantity cumsum bin
# 1         a       20     20   1
# 2         b       30     50   1
# 3         c       50     50   2
# 4         c       50     50   3
# 5         d       10     10   4
# 6         e        1     11   4
# 7         f       23     34   4
# 8         g        3     37   4
# 9         h       13     50   4
# 10        h       50     50   5
# 11        h       50     50   6
# 12        h       50     50   7
# 13        h       37     37   8
于 2014-01-10T15:05:30.410 に答える
0

ループを使用した別のソリューション:

DF <- read.table(text="category quantity
a          20
b          30
c          100
d          10
e          1
f          23
g          3
h          200", header=TRUE)

bin_size <- 50
n_bin <- ceiling(sum(DF$quantity)/bin_size)

DF$bin <- findInterval(cumsum(DF$quantity)-1, c(0, seq_len(n_bin)*50))
DF$cumsum <- cumsum(DF$quantity)

result <- lapply(seq_along(DF[,1]), function(i, df) {
  if (i==1) {
    d <- df[i, "bin"]
  } else {
    d <- df[i, "bin"]-df[i-1, "bin"]
  }
  if (d > 1) {    
    res <- data.frame(
      category = df[i, "category"],
      bin_nbr = df[i, "bin"]-seq_len(d+1)+1
    )        
    res[,"quantity"] <- bin_size
    if (i!=1) {
      res[nrow(res),"quantity"] <- df[i-1, "bin"]*bin_size-df[i-1, "cumsum"]
    }  else {
      res[nrow(res),"quantity"] <- 0
    }
    res[1,"quantity"] <- df[i, "quantity"]-sum(res[-1,"quantity"])
    return(res[res$quantity > 0,])
  } else {
    return(data.frame(
      category = df[i, "category"],
      quantity = df[i, "quantity"],
      bin_nbr = df[i, "bin"]
    ))
  }
}, df=DF)

res <- do.call(rbind, result)
res <- res[order(res$category, res$bin_nbr),]
library(plyr)
res <- ddply(res, .(bin_nbr), transform, cumsum=cumsum(quantity))
res

#    category quantity bin_nbr cumsum
# 1         a       20       1     20
# 2         b       30       1     50
# 3         c       50       2     50
# 4         c       50       3     50
# 5         d       10       4     10
# 6         e        1       4     11
# 7         f       23       4     34
# 8         g        3       4     37
# 9         h       13       4     50
# 10        h       50       5     50
# 11        h       50       6     50
# 12        h       50       7     50
# 13        h       37       8     37
于 2014-01-10T15:16:00.407 に答える
0

これは、このループのないソリューションを提供するデータとビンの境界をマージすることになります。

library(zoo)

fun <- function(DF, binsize = 50) {
  nr <- nrow(DF)
  DF2 <- data.frame(cumsum = seq(0, sum(DF$quantity), binsize) + binsize, bin_nbr = 1:nr)
  DF.cs <- transform(DF, cumsum = cumsum(DF$quantity))
  m <- na.locf(merge(DF.cs, DF2, all = TRUE), fromLast = TRUE)
  m$bin_nbr <- as.numeric(m$bin_nbr)
  cs <- as.numeric(m$cumsum)
  m$quantity <- c(cs[1], diff(cs))
  m$cumsum <- ave(m$quantity, m$bin_nbr, FUN = cumsum)
  na.omit(m)[c("category", "quantity", "cumsum", "bin_nbr")]
}

与える:

> fun(DF)
   category quantity cumsum bin_nbr
1         a       20     20       1
2         b       30     50       1
3         c       50     50       2
4         c       50     50       3
5         d       10     10       4
6         e        1     11       4
7         f       23     34       4
8         g        3     37       4
9         h       13     50       4
10        h       50     50       5
11        h       50     50       6
12        h       50     50       7
13        h       37     37       8

注: 上記の結果を再現する目的で、これは使用した入力です。

Lines <- "category quantity
a          20
b          30
c          100
d          10
e          1
f          23
g          3
h          200
"
DF <- read.table(text = Lines, header = TRUE, as.is = TRUE)

REVISIONコードのエラーが修正されました。

于 2014-01-11T01:21:04.040 に答える