Skip to content

Commit d7c5c66

Browse files
simontreanorsimontreanor
committed
calculate schedule length precisely
1 parent d1921d3 commit d7c5c66

File tree

4 files changed

+186
-58
lines changed

4 files changed

+186
-58
lines changed

‎CHANGELOG.md‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,16 @@
88

99
---
1010

11+
## [2.5.3] - 2025-06-04
12+
13+
### Fixed
14+
15+
- When using a maximum duration rather than a payment count to generate a payment schedule based on a
16+
unit-period config, it was using approximations of the number of payments within a particular timeframe
17+
rather than calculating precisely. This now calculates precisely.
18+
19+
---
20+
1121
## [2.5.2] - 2025-06-02
1222

1323
### Fixed

‎src/Scheduling.fs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -758,7 +758,7 @@ module Scheduling =
758758
| AutoGenerateSchedule rs ->
759759
match rs.ScheduleLength with
760760
| PaymentCount 0
761-
| MaxDuration 0<DurationDay> -> Map.empty
761+
| MaxDuration(_, 0<DurationDay>) -> Map.empty
762762
| _ ->
763763
let unitPeriodConfigStartDate = Config.startDate rs.UnitPeriodConfig
764764

‎src/UnitPeriod.fs‎

Lines changed: 167 additions & 53 deletions
Original file line numberDiff line numberDiff line change
@@ -270,22 +270,12 @@ module UnitPeriod =
270270
[<Struct; StructuredFormatDisplay("{Html}")>]
271271
type ScheduleLength =
272272
| PaymentCount of Payments: int
273-
| MaxDuration of Days: int<DurationDay>
273+
| MaxDuration of StartDate: Date * Days: int<DurationDay>
274274

275275
member sl.Html =
276276
match sl with
277277
| PaymentCount payments -> $"<i>payment count</i> {payments}"
278-
| MaxDuration days -> $"<i>max duration</i> {days}"
279-
280-
/// generates a suggested number of payments to constrain the loan within a certain duration
281-
let maxPaymentCount (maxDuration: int<DurationDay>) (config: Config) =
282-
match config with
283-
| Daily _ -> float maxDuration
284-
| Weekly(multiple, _) when multiple > 0 -> float maxDuration / (float multiple * 7.)
285-
| SemiMonthly _ -> float maxDuration / 15.
286-
| Monthly(multiple, _, _, _) when multiple > 0 -> float maxDuration / (float multiple * 30.)
287-
| _ -> 1.
288-
|> int
278+
| MaxDuration(_, days) -> $"<i>max duration</i> {days}"
289279

290280
/// direction in which to generate the schedule: forward works forwards from a given date and reverse works backwards
291281
[<Struct; RequireQualifiedAccess>]
@@ -297,49 +287,173 @@ module UnitPeriod =
297287

298288
/// generate a payment schedule based on a unit-period config
299289
let generatePaymentSchedule scheduleLength direction unitPeriodConfig =
300-
let count =
290+
let adjustMonthEnd monthEndTrackingDay (date: Date) =
291+
if date.Day > 15 && monthEndTrackingDay > 28 then
292+
TrackingDay.toDate date.Year date.Month monthEndTrackingDay
293+
else
294+
date
295+
296+
let initCount = 0
297+
298+
match unitPeriodConfig |> Config.constrain with
299+
| Daily firstPaymentDate ->
300+
match scheduleLength with
301+
| PaymentCount count ->
302+
match direction with
303+
| Direction.Forward -> Array.init count (fun i -> firstPaymentDate.AddDays i)
304+
| Direction.Reverse -> Array.init count (fun i -> firstPaymentDate.AddDays -i)
305+
| MaxDuration(startDate, duration) ->
306+
match direction with
307+
| Direction.Forward ->
308+
Array.unfold
309+
(fun count ->
310+
let nextDate = firstPaymentDate.AddDays count
311+
312+
if nextDate <= startDate.AddDays +(int duration) then
313+
Some(nextDate, count + 1)
314+
else
315+
None
316+
)
317+
initCount
318+
| Direction.Reverse ->
319+
Array.unfold
320+
(fun count ->
321+
let nextDate = firstPaymentDate.AddDays -count
322+
323+
if nextDate <= startDate.AddDays -(int duration) then
324+
Some(nextDate, count - 1)
325+
else
326+
None
327+
)
328+
initCount
329+
| Weekly(multiple, firstPaymentDate) ->
330+
match scheduleLength with
331+
| PaymentCount count ->
332+
match direction with
333+
| Direction.Forward -> Array.init count (fun i -> firstPaymentDate.AddDays(i * 7 * multiple))
334+
| Direction.Reverse -> Array.init count (fun i -> firstPaymentDate.AddDays -(i * 7 * multiple))
335+
| MaxDuration(startDate, duration) ->
336+
match direction with
337+
| Direction.Forward ->
338+
Array.unfold
339+
(fun i ->
340+
let nextDate = firstPaymentDate.AddDays(i * 7 * multiple)
341+
342+
if nextDate <= startDate.AddDays +(int duration) then
343+
Some(nextDate, i + 1)
344+
else
345+
None
346+
)
347+
initCount
348+
| Direction.Reverse ->
349+
Array.unfold
350+
(fun i ->
351+
let nextDate = firstPaymentDate.AddDays -(i * 7 * multiple)
352+
353+
if nextDate <= startDate.AddDays -(int duration) then
354+
Some(nextDate, i - 1)
355+
else
356+
None
357+
)
358+
initCount
359+
| SemiMonthly(year, month, td1, td2) ->
360+
let firstPaymentDate = TrackingDay.toDate year month td1
361+
362+
let offset, monthEndTrackingDay =
363+
if td1 > td2 then 1, td1 else 0, td2
364+
|> fun (o, metd) ->
365+
match direction with
366+
| Direction.Forward -> o, metd
367+
| Direction.Reverse -> o - 1, metd
368+
301369
match scheduleLength with
302-
| PaymentCount c -> c
303-
| MaxDuration d -> maxPaymentCount d unitPeriodConfig
370+
| PaymentCount count ->
371+
match direction with
372+
| Direction.Forward -> [| 0 .. (count - 1) |]
373+
| Direction.Reverse -> [| 0 .. -1 .. -(count - 1) |]
374+
|> Array.collect (fun c -> [|
375+
firstPaymentDate.AddMonths c |> adjustMonthEnd monthEndTrackingDay
376+
377+
firstPaymentDate.AddMonths(c + offset)
378+
|> fun d -> TrackingDay.toDate d.Year d.Month td2
379+
|> adjustMonthEnd monthEndTrackingDay
380+
|])
381+
|> Array.take count
382+
383+
| MaxDuration(startDate, duration) ->
384+
Array.unfold
385+
(fun count ->
386+
let nextDate1 =
387+
firstPaymentDate.AddMonths count |> adjustMonthEnd monthEndTrackingDay
388+
389+
let nextDate2 =
390+
firstPaymentDate.AddMonths(count + offset)
391+
|> fun d -> TrackingDay.toDate d.Year d.Month td2
392+
|> adjustMonthEnd monthEndTrackingDay
393+
394+
match direction with
395+
| Direction.Forward ->
396+
let finalPaymentDate = startDate.AddDays(int duration)
397+
398+
let output = [|
399+
if nextDate1 <= finalPaymentDate then
400+
yield nextDate1
401+
if nextDate2 <= finalPaymentDate then
402+
yield nextDate2
403+
|]
404+
405+
if output.Length > 0 then Some(output, count + 1) else None
406+
| Direction.Reverse ->
407+
let finalPaymentDate = startDate.AddDays -(int duration)
408+
409+
let output = [|
410+
if nextDate1 >= finalPaymentDate then
411+
yield nextDate1
412+
if nextDate2 >= finalPaymentDate then
413+
yield nextDate2
414+
|]
415+
416+
if output.Length > 0 then Some(output, count - 1) else None
417+
)
418+
initCount
419+
|> Array.collect id
420+
| Monthly(multiple, year, month, trackingDay) ->
421+
let firstPaymentDate = TrackingDay.toDate year month trackingDay
304422

305-
if count = 0 then
306-
[||]
307-
else
308-
let adjustMonthEnd monthEndTrackingDay (d: Date) =
309-
if d.Day > 15 && monthEndTrackingDay > 28 then
310-
TrackingDay.toDate d.Year d.Month monthEndTrackingDay
311-
else
312-
d
313-
314-
let generate upc =
315-
match upc |> Config.constrain with
316-
| Daily startDate -> Array.map startDate.AddDays
317-
| Weekly(multiple, startDate) -> Array.map (fun c -> startDate.AddDays(c * 7 * multiple))
318-
| SemiMonthly(year, month, td1, td2) ->
319-
let startDate = TrackingDay.toDate year month td1
320-
321-
let offset, monthEndTrackingDay =
322-
if td1 > td2 then 1, td1 else 0, td2
323-
|> fun (o, metd) ->
324-
match direction with
325-
| Direction.Forward -> o, metd
326-
| Direction.Reverse -> o - 1, metd
327-
328-
Array.collect (fun c -> [|
329-
startDate.AddMonths c |> adjustMonthEnd monthEndTrackingDay
330-
331-
startDate.AddMonths(c + offset)
332-
|> fun d -> TrackingDay.toDate d.Year d.Month td2
333-
|> adjustMonthEnd monthEndTrackingDay
334-
|])
335-
>> Array.take count
336-
| Monthly(multiple, year, month, td) ->
337-
let startDate = TrackingDay.toDate year month td
338-
Array.map (fun c -> startDate.AddMonths(c * multiple) |> adjustMonthEnd td)
339-
340-
match direction with
341-
| Direction.Forward -> [| 0 .. (count - 1) |] |> generate unitPeriodConfig
342-
| Direction.Reverse -> [| 0 .. -1 .. -(count - 1) |] |> generate unitPeriodConfig |> Array.sort
423+
match scheduleLength with
424+
| PaymentCount c ->
425+
match direction with
426+
| Direction.Forward ->
427+
Array.init c (fun i -> firstPaymentDate.AddMonths(i * multiple) |> adjustMonthEnd trackingDay)
428+
| Direction.Reverse ->
429+
Array.init c (fun i -> firstPaymentDate.AddMonths(-i * multiple) |> adjustMonthEnd trackingDay)
430+
| MaxDuration(startDate, duration) ->
431+
match direction with
432+
| Direction.Forward ->
433+
Array.unfold
434+
(fun count ->
435+
let nextDate =
436+
firstPaymentDate.AddMonths(count * multiple) |> adjustMonthEnd trackingDay
437+
438+
if nextDate <= startDate.AddDays +(int duration) then
439+
Some(nextDate, count + 1)
440+
else
441+
None
442+
)
443+
initCount
444+
| Direction.Reverse ->
445+
Array.unfold
446+
(fun count ->
447+
let nextDate =
448+
firstPaymentDate.AddMonths(-count * multiple) |> adjustMonthEnd trackingDay
449+
450+
if nextDate <= startDate.AddDays -(int duration) then
451+
Some(nextDate, count - 1)
452+
else
453+
None
454+
)
455+
initCount
456+
|> Array.sort
343457

344458
/// for a given interval and array of dates, devise the unit-period config
345459
let detect direction interval transferDates =

‎tests/PaymentScheduleTests.fs‎

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -2048,15 +2048,17 @@ module PaymentScheduleTests =
20482048
let title = "PaymentScheduleTest002"
20492049
let description = "Term must not exceed maximum duration"
20502050

2051+
let startDate = Date(2024, 5, 8)
2052+
20512053
let p = {
20522054
parameters with
20532055
EvaluationDate = Date(2024, 5, 8)
2054-
StartDate = Date(2024, 5, 8)
2056+
StartDate = startDate
20552057
Principal = 1000_00L<Cent>
20562058
ScheduleConfig =
20572059
AutoGenerateSchedule {
20582060
UnitPeriodConfig = Monthly(1, 2024, 5, 8)
2059-
ScheduleLength = MaxDuration 183<DurationDay>
2061+
ScheduleLength = MaxDuration(startDate, 183<DurationDay>)
20602062
}
20612063
}
20622064

@@ -2074,15 +2076,17 @@ module PaymentScheduleTests =
20742076
let title = "PaymentScheduleTest003"
20752077
let description = "Term must not exceed maximum duration"
20762078

2079+
let startDate = Date(2024, 5, 8)
2080+
20772081
let p = {
20782082
parameters with
20792083
EvaluationDate = Date(2024, 5, 8)
2080-
StartDate = Date(2024, 5, 8)
2084+
StartDate = startDate
20812085
Principal = 1000_00L<Cent>
20822086
ScheduleConfig =
20832087
AutoGenerateSchedule {
20842088
UnitPeriodConfig = Monthly(1, 2024, 5, 18)
2085-
ScheduleLength = MaxDuration 184<DurationDay>
2089+
ScheduleLength = MaxDuration(startDate, 184<DurationDay>)
20862090
}
20872091
}
20882092

0 commit comments

Comments
 (0)