如何从同一订单的多个价格和付款金额创建运行余额？

Question

我有以下包含以下列的输入数据集：

1. OrderID：每个订单的唯一 ID
2. ItemID：每个订单中每个商品的唯一 ID
3. Amount：每件商品对应价格
4. ActualPayment：每个订单的实际付款。无论购买的商品数量如何，单个订单都可能有多次付款，因此Price 和ActualPayment 是多对多关系。单个ActualPayment 可能会少付、多付或完全支付所请求的Amount。多余的ActualPayment会结转，部分支付则要靠下一次支付才能全额支付。

输入数据：

  OrderID ItemID Amount ActualPayment
1       1      1   1000           500
2       1      2   1000           600
3       1     NA     NA           800
4       2      1   2000          1000
5       2      2   2000          1000
6       2     NA     NA          1000
7       2     NA     NA          1000
8       3      1    500           600
9       3      2    300           200

根据输入数据，我想为每个 item 创建一个运行中的Balance，因为当有一个多余的。

1. ActualPaymentID：每个订单中每个 ActualPayment 的唯一性
2. Payable:Amount尚未付款
3. Payment：为每件商品支付的确切金额。例如，在第 2-3 行，ActualPayment == 600 被拆分为 ItemID 1-2，因为 600 中的 500 正好覆盖了剩余的 Payable。
4. Balance：每个ItemID 的第一行始终是余数（即Amount - Payment）。以下条目应为-Payment

输出数据：

   OrderID ItemID Amount ActualPayment ActualPaymentID Payable Payment Balance
1        1      1   1000           500               1    1000     500     500
2        1      1   1000           600               2     500     500    -500
3        1      2   1000           600               2    1000     100     900
4        1      2   1000           800               3     900     800    -800
5        2      1   2000          1000               1    2000    1000    1000
6        2      1   2000          1000               2    1000    1000   -1000
7        2      2   2000          1000               3    2000    1000    1000
8        2      2   2000          1000               4    1000    1000   -1000
9        3      1    500           600               1     500     500       0
10       3      2    300           600               1     300     100     200
11       3      2    300           200               2     200     200    -200

问题：

我主要纠结于如何创建Payment 列并在需要将ActualPayment 分成两部分时插入一行。我还需要将ItemID 和Amount 分散到Payments，这取决于付款的项目。

数据：

input <- data.frame(OrderID = c(rep(1, 3), rep(2, 4), rep(3, 2)),
                    ItemID = c(1, 2, NA, 1, 2, NA, NA, 1, 2),
                    Amount = c(1000, 1000, NA, 2000, 2000, NA, NA, 500, 300),
                    ActualPayment = c(500, 600, 800, 1000, 1000, 1000, 1000, 600, 200))

output <- data.frame(OrderID = c(rep(1, 4), rep(2, 4), rep(3, 3)),
                     ItemID = c(rep(1, 2), rep(2, 2), rep(1, 2), rep(2, 2), 1, 2, 2),
                     Amount = c(1000, 1000, 1000, 1000, 2000, 2000, 2000, 2000, 500, 300, 300),
                     ActualPayment = c(500, 600, 600, 800, 1000, 1000, 1000, 1000, 600, 600, 200),
                     ActualPaymentID = c(1, 2, 2, 3, 1, 2, 3, 4, 1, 1, 2),
                     Payable = c(1000, 500, 1000, 900, 2000, 1000, 2000, 1000, 500, 300, 200),
                     Payment = c(500, 500, 100, 800, 1000, 1000, 1000, 1000, 500, 100, 200),
                     Balance = c(500, -500, 900, -800, 1000, -1000, 1000, -1000, 0, 200, -200))

Answer 1

让我们首先将项目和付款分解为单独的数据框。 这将使它们更易于使用：

library(tidyverse)

items <- input %>% 
  filter(!is.na(ItemID)) %>% 
  distinct(OrderID, ItemID, Amount)

items
#>   OrderID ItemID Amount
#> 1       1      1   1000
#> 2       1      2   1000
#> 3       2      1   2000
#> 4       2      2   2000
#> 5       3      1    500
#> 6       3      2    300

payments <- input %>% 
  group_by(OrderID) %>% 
  mutate(ActualPaymentID = row_number()) %>% 
  ungroup() %>% 
  select(OrderID, ActualPaymentID, ActualPayment)  

payments
#> # A tibble: 9 x 3
#>   OrderID ActualPaymentID ActualPayment
#>     <dbl>           <int>         <dbl>
#> 1       1               1           500
#> 2       1               2           600
#> 3       1               3           800
#> 4       2               1          1000
#> 5       2               2          1000
#> 6       2               3          1000
#> 7       2               4          1000
#> 8       3               1           600
#> 9       3               2           200

这也有助于只关注一个订单来构建一个解决方案，然后我们可以将其应用于所有订单：

order1_payments <- payments %>% filter(OrderID == 1) %>% select(-OrderID)
order1_items <- items %>% filter(OrderID == 1) %>% select(-OrderID)

为了获得流动余额，我们需要将付款金额相加，直到项目的全部成本被填满，反之亦然。这意味着我们需要找到付款更改或商品更改的金额。然后，付款和项目的每个组合将在结果中形成一个新行。我们可以通过获取两个向量的唯一累积和来做到这一点：

p <- order1_payments$ActualPayment
i <- order1_items$Amount

( p_csum <- cumsum(p) )
#> [1]  500 1100 1900
( i_csum <- cumsum(i) )
#> [1] 1000 2000
( r_csum <- sort(unique(c(p_csum, i_csum))) )
#> [1]  500 1000 1100 1900 2000

然后我们可以使用match() 找出物品和付款的结束位置，然后获取每个物品的行数和付款跨度：

( p_rows <- diff(c(0, match(p_csum, r_csum))) )
#> [1] 1 2 1
( i_rows <- diff(c(0, match(i_csum, r_csum))) )
#> [1] 2 3

有了这个，我们可以创建可用于索引数据的向量，以创建我们想要的组合，确保它们具有相同的长度。

na_pad <- function(x, length) {
  replace(rep(NA, length), seq_along(x), x)
}

n_rows <- length(r_csum)
( row_p <- na_pad(rep(seq_along(p), p_rows), n_rows) )
#> [1]  1  2  2  3 NA
( row_i <- na_pad(rep(seq_along(i), i_rows), n_rows) )
#> [1] 1 1 2 2 2

每行的应付金额可以通过从累计项目总数中减去每行的付款来确定：

( payable <- i_csum[row_i] - lag(r_csum, default = 0) )
#> [1] 1000  500 1000  900  100

剩下的就是构建结果数据框：

combs <- cbind(
  order1_items[row_i, ],
  order1_payments[row_p, ],
  Payable = payable,
  Payment = diff(c(0, r_csum))
)

combs
#>     ItemID Amount ActualPaymentID ActualPayment Payable Payment
#> 1        1   1000               1           500    1000     500
#> 1.1      1   1000               2           600     500     500
#> 2        2   1000               2           600    1000     100
#> 2.1      2   1000               3           800     900     800
#> 2.2      2   1000              NA            NA     100     100

要将结果应用于每个订单，我们将流程放在一个函数中：

resolve_payments <- function(payments, items) {
  p <- payments$ActualPayment
  i <- items$Amount

  p_csum <- cumsum(p)
  i_csum <- cumsum(i)
  r_csum <- sort(unique(c(p_csum, i_csum)))

  ( p_rows <- diff(c(0, match(p_csum, r_csum))) )
  ( i_rows <- diff(c(0, match(i_csum, r_csum))) )

  na_pad <- function(x, length) {
    replace(rep(NA, length), seq_along(x), x)
  }

  n_rows <- length(r_csum)
  ( row_p <- na_pad(rep(seq_along(p), p_rows), n_rows) )
  ( row_i <- na_pad(rep(seq_along(i), i_rows), n_rows) )
  ( payable <- i_csum[row_i] - lag(r_csum, default = 0) )

  combs <- cbind(
    items[row_i, ],
    payments[row_p, ],
    Payable = payable,
    Payment = diff(c(0, r_csum))
  )

  combs
}

现在，我们可以创建一个数据框，其中每个订单有一行，列表列包含每个订单中包含的项目和付款：

orders <- items %>% 
  distinct(OrderID) %>% 
  as_tibble() %>% 
  nest_join(items) %>% 
  nest_join(payments)
#> Joining, by = "OrderID"
#> Joining, by = "OrderID"

orders
#> # A tibble: 3 x 3
#>   OrderID items            payments        
#> *   <dbl> <list>           <list>          
#> 1       1 <df[,2] [2 x 2]> <tibble [3 x 2]>
#> 2       2 <df[,2] [2 x 2]> <tibble [4 x 2]>
#> 3       3 <df[,2] [2 x 2]> <tibble [2 x 2]>

最后，我们将函数应用于每个订单以获得最终结果：

orders %>% 
  group_by(OrderID) %>% 
  group_modify(~ resolve_payments(.x$payments[[1]], .x$items[[1]]))
#> # A tibble: 12 x 7
#> # Groups:   OrderID [3]
#>    OrderID ItemID Amount ActualPaymentID ActualPayment Payable Payment
#>      <dbl>  <dbl>  <dbl>           <int>         <dbl>   <dbl>   <dbl>
#>  1       1      1   1000               1           500    1000     500
#>  2       1      1   1000               2           600     500     500
#>  3       1      2   1000               2           600    1000     100
#>  4       1      2   1000               3           800     900     800
#>  5       1      2   1000              NA            NA     100     100
#>  6       2      1   2000               1          1000    2000    1000
#>  7       2      1   2000               2          1000    1000    1000
#>  8       2      2   2000               3          1000    2000    1000
#>  9       2      2   2000               4          1000    1000    1000
#> 10       3      1    500               1           600     500     500
#> 11       3      2    300               1           600     300     100
#> 12       3      2    300               2           200     200     200

删除无法支付的行和计算Balance 的修饰留给“读者练习”。

^{由reprex package (v0.3.0) 于 2019 年 9 月 25 日创建}