Давайте сначала разделим позиции и платежи на отдельные фреймы данных.Это облегчит работу с ними:
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()
, чтобы узнать, где заканчиваются товары и платежи, а затем получить количество строк для каждого товара и платежа.spans:
( 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
оставлен «как упражнение для читателя».
Создан в 2019-09-25 пакетом представлением (v0.3.0)