Populate a variable instance once calculations in a previous row are finished - r

Question

I want to calculate the final number of unprocessed claims after each month. First, I calculate a total number of claims to process: it's a last month's backlog + any new_claims coming in the current month. Then, in order to calculate a number of close_claims I multiply that number by a closed_total_ratio and take that away from the total. My final variable is open_claims which should automatically feed into backlog as soon as it's calculated:
library(tidyverse)
set.seed(1)
df <- tibble(date = seq(from = lubridate::as_date('2018-01-01'), to = lubridate::as_date('2018-06-01'), by = 'months'),
backlog = c(120, rep(NA, 5)),
new_claims =sample(c(10,20,30), 6, replace = T),
closed_open_ratio = rep(0.2, 6),
open_claims = rep(NA, 6))
df
set.seed(1)
solution <- tibble(date = seq(from = lubridate::as_date('2018-01-01'), to = lubridate::as_date('2018-06-01'), by = 'months'),
backlog = c(120, 104, 99, 95, 100, 88),
new_claims =sample(c(10,20,30), 6, replace = T),
total = c(130, 124, 119, 125, 110, 118),
closed_total_ratio = rep(0.2, 6),
closed = c(26, 25, 24, 25,22,24),
open_claims = c(104, 99, 95, 100,88, 94)
)
solution
The thing is, if I apply something like this:
df %>%
mutate(total = backlog[1] +cumsum(new_claims),
closed = closed_open_ratio* total,
open_claims = total - cumsum(closed)) %>%
select(backlog, new_claims, total, closed_open_ratio, closed, open_claims)
I fail to move open_claims back to the backlog. What would be a better way of doing it?

Answer 1

Cześć Kasiu! I think we can't avoid iteration, if result in the next row depends on result from the previous one. You wrote "I'll be iterating over big data frames" so the best way to save some time is to use Rcpp. You need to create new "C++ File" (it's integrated with RStudio) with the following code:
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
DataFrame forKasia(DataFrame DF) {
IntegerVector backlog = DF["backlog"];
IntegerVector new_claims = DF["new_claims"];
NumericVector closed_open_ratio = DF["closed_open_ratio"];
IntegerVector open_claims = DF["open_claims"];
int n = backlog.size();
IntegerVector total = IntegerVector(n);
IntegerVector closed = IntegerVector(n);
for (int i = 0; i < n; i++) {
total[i] = backlog[i] + new_claims[i];
closed[i] = round(total[i] * closed_open_ratio[i]);
open_claims[i] = total[i] - closed[i];
if (i < n - 1) {
backlog[i + 1] = open_claims[i];
}
}
return DataFrame::create(
_["date"] = DF["date"],
_["backlog"] = backlog,
_["new_claims"] = new_claims,
_["total"] = total,
_["closed_open_ratio"] = closed_open_ratio,
_["closed"] = closed,
_["open_claims"] = open_claims
);
}
Then source it and run:
Rcpp::sourceCpp('forKasia.cpp')
forKasia(df)

Answer 2

Not very elegant, but I think it works. There are some differences with your solution, but also the new_claims column is different:
df <- tibble(date = seq(from = lubridate::as_date('2018-01-01'), to = lubridate::as_date('2018-06-01'), by = 'months'),
backlog = c(120, rep(NA, 5)),
new_claims =sample(c(10,20,30), 6, replace = T),
closed_open_ratio = rep(0.2, 6),
open_claims = rep(NA, 6))
df <- data.frame(df)
for (i in 1:nrow(df)) {
df$open_claims[i] <- (df$backlog[i] + df$new_claims[i]) - ((df$backlog[i] df$new_claims[i]) * df$closed_open_ratio[i])
if (i < nrow(df)) {
df$backlog[i + 1] <- (df$backlog[i] + df$new_claims[i]) - ((df$backlog[i] + df$new_claims[i]) * df$closed_open_ratio[i])
}
}
df
date backlog new_claims closed_open_ratio open_claims
1 2018-01-01 120.0000 10 0.2 104.00000
2 2018-02-01 104.0000 20 0.2 99.20000
3 2018-03-01 99.2000 10 0.2 87.36000
4 2018-04-01 87.3600 20 0.2 85.88800
5 2018-05-01 85.8880 30 0.2 92.71040
6 2018-06-01 92.7104 20 0.2 90.16832
Hope it helps.

Answer 3

You can use purrr::accumulate to carry forward the still opened claims starting from the backlog on Day 1. cumsum and cumprod are the most common examples of this type of computation but in this case we need something more complex than cumsum because a proportion of the claims get closed every day.
Let p be the probability of closing (a constant). Let q=1-p be the probability of not closing.
For Day 1 we have backlog + new_claims claims. Let's call the
total x1. Then at the end of Day 1 we have q*x1 claims still
open.
Then for Day 2 we have the previously open claims, q*x1,
plus some new ones, x2, and at the end of Day 2 we have q*(q*x1 + x2) claims still open. Let's look at one more day to make it clear.
For Day 3 we have the previously open claims plus those received
that day and at the end of Day 3 we have q*(q*(q*x1 + x2) + x3) claims still open.
This is the kind of sequential computation we can perform with purrr::accumulate.
p_close <- 0.2
df %>%
# Not very elegant but need to add backlog to the first-day claims
mutate(new_claims = if_else(row_number() == 1,
new_claims + backlog, new_claims)) %>%
# This function computes p*(p*(p*(p*x1 + x2) + x3) + x4) .....
mutate(tot_claims = accumulate(new_claims, function(x, y) (1-p_close)*x + y)) %>%
# Simple vectorized product to split the total claims into open and closed
mutate(open_claims = (1-p_close) * tot_claims,
closed_claims = p_close * tot_claims) %>%
# The backlog is the previous days opened claims
mutate(backlog = if_else(row_number() == 1,
backlog, lag(open_claims)))
The above computation assumes that the probability p_close of closing a claim is the same every day. But you can work with purrr::accumulate2 to provide both a vector of claims and a vector of closing probabilities.
This accumulation is a little more complex so let's define it separately.
accumulate_claims <- function(new_claims, closed_open_ratio) {
f <- function(x, y, p) (1-p)*x + y
# head(p, -1) drops the last probability. We actually don't need it here
# as right now we are computing the sequential sums of previously opened
# claims + the new claims for the day
x <- accumulate2(new_claims, head(closed_open_ratio, -1), f)
unlist(x)
}
df %>%
# Not very elegant but need to add backlog to the first-day claims
mutate(new_claims = if_else(row_number() == 1, new_claims + backlog, new_claims)) %>%
# This function computes p4*(p3*(p2*(p1*x1 + x2) + x3) + x4) .....
mutate(tot_claims = accumulate_claims(new_claims, closed_open_ratio)) %>%
# Simple vectorized product to split the total claims into open and closed
mutate(open_claims = (1-closed_open_ratio) * tot_claims,
closed_claims = closed_open_ratio * tot_claims) %>%
# The backlog is the previous days opened claims
mutate(backlog = if_else(row_number() == 1, backlog, lag(open_claims)))

Answer 4

One way to tackle the sequential nature of the computation is with recursion, calculating the inital open claims using the first row of the dataset, and then repeating the call using the remaining rows.
calc_open_claims <- function(current_backlog, new_claims, closed_open_ratio) {
(current_backlog + new_claims) * (1 - closed_open_ratio)
}
open_claims <- function(weekly_changes, accumulator) {
if (nrow(weekly_changes) == 0) return(accumulator)
new_backlog <- calc_open_claims(last(accumulator),
weekly_changes$new_claims[1],
weekly_changes$closed_open_ratio[1])
accumulator = c(accumulator, new_backlog)
open_claims(weekly_changes[-1, ], accumulator)
}
open_claims(df, 120)
# Wrapper to kick it off and align result
open_claims_wrapper = function(df) {
starting_backlog <- df$backlog[1]
oc <- open_claims(df, starting_backlog) # starting_backlog seeds the accumulator
oc <- oc[-1] # lop off the starting backlog
mutate(df, open_claims = oc)
}
open_claims_wrapper(df)