我具有以下具有以下列的输入数据集：
OrderID：每个下单的唯一ID ItemID：每个订单中每个商品的唯一ID Amount：每件商品的相应价格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
根据输入数据，我想为每个项目创建一个运行中的Balance，因为上一个项目中的ActualPayment可以结转到下一个项目当有多余的时候。
ActualPaymentID：每个订单中每个ActualPayment的唯一身份Payable：Amount尚未支付Payment：为每个项目支付的确切金额。例如，在第2-3行上，ActualPayment == 600被划分为ItemID 1-2，因为600中的500恰好覆盖了其余的Payable。 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分散到Payment上。
数据：
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))
答案 0 :(得分：2)
首先让我们将项目和付款分解为单独的数据框。 这将使它们更易于使用：
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-09-25创建