Search code examples
rdplyr

Calculate series of repayments based on simple dates and amounts

I have the following data, which are payments required by a given date.

data <- tribble(
  ~Date, ~Amount,
  "26/11/2024", 387,
  "04/01/2025", 879,
  "08/02/2025", 954,
  "22/02/2025", 1849,
  "25/02/2025", 103,
  "05/03/2025", 2400
)

I would like to create a zero interest payment plan, for each amount, on every preceding Friday before the amount is due. For example, for the 387 due on 26/11/2024, there are 3 Fridays between now (05/11/2024) and then. So I would expect to have 387/3 for each Friday before the payment is due.

I have tried the following code:

library(tidyverse)
library(lubridate)

# calculate a sequence of dates from now until latest payment date
all_dates <- seq(as.Date("2024-11-05"),as.Date('2025-03-05'),by = 1) %>% 
  tibble() %>%
  rename("list_of_dates" = ".") %>% 
  mutate(dummy_amt = 0)

# create Friday payment plan
data2 <- data %>% 
  mutate(Date = strptime(as.character(Date), "%d/%m/%Y")) %>% 
  mutate(Date = format(Date, "%Y-%m-%d")) %>% 
  mutate(Date = as.Date(Date)) %>% 
  right_join(all_dates, by = c("Date" = "list_of_dates")) %>% 
  select(-dummy_amt) %>% 
  mutate(Amount = replace_na(Amount, 0)) %>% 
  arrange(Date) %>% 
  mutate(Day = wday(Date, label = TRUE, abbr = FALSE)) %>% 
  filter(Day == "Friday" | Amount != 0) %>% 
  mutate(no_fridays = if_else(Day == "Friday", 1, 0)) %>% 
  mutate(cum_fridays = cumsum(no_fridays))

...and have reached a point where I can calculate the amount of cumulative Fridays up to a certain payment date. But I am struggling with the next step i.e. assigning a payment to each preceding Friday.

Something like this would be ideal (e.g. for the first 2 amounts). I can then calculate a total column.

   Date       Amount Day     cum_fridays payment1 payment2
   <date>      <dbl> <ord>         <dbl>    <dbl>    <dbl>
 1 2024-11-08      0 Friday            1      129     97.7
 2 2024-11-15      0 Friday            2      129     97.7
 3 2024-11-22      0 Friday            3      129     97.7
 4 2024-11-26    387 Tuesday           3        0        0
 5 2024-11-29      0 Friday            4        0     97.7
 6 2024-12-06      0 Friday            5        0     97.7
 7 2024-12-13      0 Friday            6        0     97.7
 8 2024-12-20      0 Friday            7        0     97.7
 9 2024-12-27      0 Friday            8        0     97.7
10 2025-01-03      0 Friday            9        0     97.7
11 2025-01-04    879 Saturday          9        0        0
Solution

  • With the addition of an id column to your original data tribble, this will:

    • complete() the date ranges from a start date to each date in data so data2 is in long form
    • calculate amount due per Amount per Friday, round payments so they are in 'real' currency values
    • subtract/add from final payment if rounding is an issue e.g. ensure payments sum to the exact amount with last payment corrected if necessary
    • pivot_wider() so each payment schedule has its own column
    library(dplyr)
library(tidyr)
library(lubridate)

# Modify original data to include id column
data <- tribble(~Date, ~Amount,
                "26/11/2024", 387,
                "04/01/2025", 879,
                "08/02/2025", 954,
                "22/02/2025", 1849,
                "25/02/2025", 103,
                "05/03/2025", 2400) |>
  mutate(Date = dmy(Date)) |>
  arrange(Date) |>
  mutate(id = 1:n())

data2 <- data |>
  group_by(id) |>
  complete(Date = seq.Date(as.Date("2024-11-05"), Date, by = "day")) |>
  fill(id, .direction = "up") |>
  mutate(Day = wday(Date, label = TRUE, abbr = FALSE)) |>
  filter(Day == "Friday" | Amount != 0) |>
  mutate(
    payment = ifelse(!is.na(Amount), 0, round(last(Amount) / (n() - 1), 2)),
    payment = ifelse(sum(payment) != last(Amount) & row_number() == n() - 1,
                 payment - (sum(payment) - last(Amount)), payment)
    ) |>
  ungroup() |>
  select(Date, id, Amount, Day, payment) |>
  pivot_wider(names_from = id,
              values_from = payment,
              names_prefix = "payment") |>
  mutate(across(everything(), ~replace_na(., 0)),
         cum_fridays = if_else(Day == "Friday", 1, 0),
         cum_fridays = cumsum(cum_fridays)) |>
  relocate(cum_fridays, .after = Day)

data.frame(data2)
#          Date Amount       Day cum_fridays payment1 payment2 payment3 payment4 payment5 payment6
# 1  2024-11-08      0    Friday           1      129    97.67    68.14   115.56     6.44   141.18
# 2  2024-11-15      0    Friday           2      129    97.67    68.14   115.56     6.44   141.18
# 3  2024-11-22      0    Friday           3      129    97.67    68.14   115.56     6.44   141.18
# 4  2024-11-26    387   Tuesday           3        0     0.00     0.00     0.00     0.00     0.00
# 5  2024-11-29      0    Friday           4        0    97.67    68.14   115.56     6.44   141.18
# 6  2024-12-06      0    Friday           5        0    97.67    68.14   115.56     6.44   141.18
# 7  2024-12-13      0    Friday           6        0    97.67    68.14   115.56     6.44   141.18
# 8  2024-12-20      0    Friday           7        0    97.67    68.14   115.56     6.44   141.18
# 9  2024-12-27      0    Friday           8        0    97.67    68.14   115.56     6.44   141.18
# 10 2025-01-03      0    Friday           9        0    97.64    68.14   115.56     6.44   141.18
# 11 2025-01-04    879  Saturday           9        0     0.00     0.00     0.00     0.00     0.00
# 12 2025-01-10      0    Friday          10        0     0.00    68.14   115.56     6.44   141.18
# 13 2025-01-17      0    Friday          11        0     0.00    68.14   115.56     6.44   141.18
# 14 2025-01-24      0    Friday          12        0     0.00    68.14   115.56     6.44   141.18
# 15 2025-01-31      0    Friday          13        0     0.00    68.14   115.56     6.44   141.18
# 16 2025-02-07      0    Friday          14        0     0.00    68.18   115.56     6.44   141.18
# 17 2025-02-08    954  Saturday          14        0     0.00     0.00     0.00     0.00     0.00
# 18 2025-02-14      0    Friday          15        0     0.00     0.00   115.56     6.44   141.18
# 19 2025-02-21      0    Friday          16        0     0.00     0.00   115.60     6.40   141.18
# 20 2025-02-22   1849  Saturday          16        0     0.00     0.00     0.00     0.00     0.00
# 21 2025-02-25    103   Tuesday          16        0     0.00     0.00     0.00     0.00     0.00
# 22 2025-02-28      0    Friday          17        0     0.00     0.00     0.00     0.00   141.12
# 23 2025-03-05   2400 Wednesday          17        0     0.00     0.00     0.00     0.00     0.00