Заполните экземпляр переменной после завершения вычислений в предыдущей строке

Question

Я хочу рассчитать окончательное количество необработанных претензий после каждого месяца.Сначала я вычисляю total количество заявок на обработку: это backlog + любое new_claims за последний месяц, поступающее в текущем месяце.Затем, чтобы вычислить число close_claims, я умножаю это число на closed_total_ratio и убираю его из total.Моя последняя переменная - open_claims, которая должна автоматически вводиться в backlog, как только она будет рассчитана:

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   

Дело в том, что если я применю что-то вроде этого:

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)

Я не могу переместиться open_claims обратно на backlog.Что было бы лучшим способом сделать это?

Answer 1

Чесч Касю!Я думаю, что мы не можем избежать итерации, если результат в следующей строке зависит от результата из предыдущей.Вы написали «Я буду перебирать большие фреймы данных», поэтому лучший способ сэкономить время - использовать Rcpp.Вам нужно создать новый «C ++ файл» (он интегрирован с RStudio) со следующим кодом:

#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
  );

}

Затем создайте его и запустите:

Rcpp::sourceCpp('forKasia.cpp')
forKasia(df)

Answer 2

Вы можете использовать purrr::accumulate, чтобы перенести все еще открытые заявки, начиная с невыполненной работы в День 1. cumsum и cumprod являются наиболее распространенными примерами такого типа вычислений, но в этом случае нам нужно что-то более сложноечем cumsum, потому что часть требований закрывается каждый день.

Пусть p будет вероятностью закрытия (константа).Пусть q=1-p будет вероятностью не закрытия.

1. Для первого дня у нас есть backlog + new_claims претензий.Давайте назовем сумму x1.Затем, в конце первого дня, у нас есть еще q*x1 претензий.

2. Тогда для Дня 2 у нас есть ранее открытые заявки q*x1, плюс некоторые новые, x2, и в конце Дня 2 у нас еще q*(q*x1 + x2) претензии все еще открыты.Давайте рассмотрим еще один день, чтобы прояснить ситуацию.

3. Для Дня 3 у нас есть ранее открытые претензии плюс те, которые были получены в тот день, и в конце Дня 3 у нас есть q*(q*(q*x1 + x2) + x3) претензийвсе еще открыт.

Это вид последовательных вычислений, которые мы можем выполнить с 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)))

Вышеприведенные вычисления предполагают, что вероятность p_closeзакрытие претензии одинаково каждый день.Но вы можете работать с purrr::accumulate2, чтобы обеспечить как вектор заявок, так и вектор вероятностей закрытия.

Это накопление немного сложнее, поэтому давайте определим его отдельно.

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 3

Одним из способов решения последовательного характера вычислений является рекурсия, вычисление начальных открытых заявок с использованием первой строки набора данных, а затем повторение вызова с использованием оставшихся строк.

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)

Answer 4

Не очень элегантно, но я думаю, что это работает.В вашем решении есть некоторые различия, но столбец new_claims отличается:

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

Надеюсь, это поможет.