daydate.ha (14767B)
1 // SPDX-License-Identifier: MPL-2.0 2 // (c) Hare authors <https://harelang.org> 3 4 // Hare internally uses the Unix epoch (1970-01-01) for calendrical logic. Here 5 // we provide useful constant for working with the astronomically numbered 6 // proleptic Gregorian calendar, as offsets from the Hare epoch. 7 8 // The Hare epochal day of the Julian Day Number. 9 export def EPOCHDAY_JULIAN: i64 = -2440588; 10 11 // The Hare epochal day of the Gregorian Common Era. 12 export def EPOCHDAY_GREGORIAN: i64 = -719164; 13 14 // Number of days in the Gregorian 400 year cycle 15 def GREGORIAN_CYCLE_DAYS: i64 = 146097; 16 17 fn has(item: int, list: int...) bool = { 18 for (let member .. list) { 19 if (member == item) { 20 return true; 21 }; 22 }; 23 return false; 24 }; 25 26 // Calculates whether a year is a leap year. 27 export fn isleapyear(y: int) bool = { 28 return if (y % 4 != 0) false 29 else if (y % 100 != 0) true 30 else if (y % 400 != 0) false 31 else true; 32 }; 33 34 // Calculates whether a given year, month, and day-of-month, is a valid date. 35 fn is_valid_ymd(y: int, m: int, d: int) bool = { 36 return m >= 1 && m <= 12 && d >= 1 && 37 d <= calc_days_in_month(y, m); 38 }; 39 40 // Calculates whether a given year, and day-of-year, is a valid date. 41 fn is_valid_yd(y: int, yd: int) bool = { 42 return yd >= 1 && yd <= calc_days_in_year(y); 43 }; 44 45 // Calculates the number of days in the given month of the given year. 46 fn calc_days_in_month(y: int, m: int) int = { 47 const days_per_month: [_]int = [ 48 31, -1, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 49 ]; 50 if (m == 2) { 51 return if (isleapyear(y)) 29 else 28; 52 } else { 53 return days_per_month[m - 1]; 54 }; 55 }; 56 57 // Calculates the number of days in a given year. 58 fn calc_days_in_year(y: int) int = { 59 return if (isleapyear(y)) 366 else 365; 60 }; 61 62 // Calculates the day-of-week of January 1st, given a year. 63 fn calc_janfirstweekday(y: int) int = { 64 const y = (y % 400) + 400; // keep year > 0 (using Gregorian cycle) 65 // Gauss' algorithm 66 const wd = (5 * ((y - 1) % 4) 67 + 4 * ((y - 1) % 100) 68 + 6 * ((y - 1) % 400) 69 ) % 7; 70 return wd; 71 }; 72 73 // Calculates the era, given a year. 74 fn calc_era(y: int) int = { 75 return if (y >= 0) { 76 yield 1; // CE "Common Era" 77 } else { 78 yield 0; // BCE "Before Common Era" 79 }; 80 }; 81 82 // Calculates the year, month, and day-of-month, given an epochal day. 83 fn calc_ymd(e: i64) (int, int, int) = { 84 // Algorithm adapted from: 85 // https://en.wikipedia.org/wiki/Julian_day#Julian_or_Gregorian_calendar_from_Julian_day_number 86 // 87 // TODO: Review, cite, verify, annotate. 88 89 // workaround for dates before -4716 March 1st 90 let E = e; 91 let cycles = 0; 92 for (E < -2441951) { 93 E += GREGORIAN_CYCLE_DAYS; 94 cycles += 1; 95 }; 96 97 const J = E - EPOCHDAY_JULIAN; 98 99 const b = 274277; 100 const c = -38; 101 const j = 1401; 102 const m = 2; 103 const n = 12; 104 const p = 1461; 105 const r = 4; 106 const s = 153; 107 const u = 5; 108 const v = 3; 109 const w = 2; 110 const y = 4716; 111 112 const f = J + j + (((4 * J + b) / GREGORIAN_CYCLE_DAYS) * 3) / 4 + c; 113 const a = r * f + v; 114 const g = (a % p) / r; 115 const h = u * g + w; 116 117 const D = (h % s) / u + 1; 118 const M = ((h / s + m) % n) + 1; 119 const Y = (a / p) - y + (n + m - M) / n; 120 121 const Y = Y - (400 * cycles); 122 123 return (Y: int, M: int, D: int); 124 }; 125 126 // Calculates the day-of-year, given a year, month, and day-of-month. 127 fn calc_yearday(y: int, m: int, d: int) int = { 128 const months_firsts: [_]int = [ 129 0, 31, 59, 130 90, 120, 151, 131 181, 212, 243, 132 273, 304, 334, 133 ]; 134 135 if (m > FEBRUARY && isleapyear(y)) { 136 return months_firsts[m - 1] + d + 1; 137 } else { 138 return months_firsts[m - 1] + d; 139 }; 140 }; 141 142 // Calculates the ISO week-numbering year, 143 // given a year, month, day-of-month, and day-of-week. 144 fn calc_isoweekyear(y: int, m: int, d: int, wd: int) int = { 145 if ( 146 // if the date is within a week whose Thursday 147 // belongs to the previous Gregorian year 148 m == JANUARY && ( 149 (d == 1 && has(wd, FRIDAY, SATURDAY, SUNDAY)) || 150 (d == 2 && has(wd, SATURDAY, SUNDAY)) || 151 (d == 3 && has(wd, SUNDAY)) 152 ) 153 ) { 154 return y - 1; 155 } else if ( 156 // if the date is within a week whose Thursday 157 // belongs to the next Gregorian year 158 m == DECEMBER && ( 159 (d == 29 && has(wd, MONDAY)) || 160 (d == 30 && has(wd, MONDAY, TUESDAY)) || 161 (d == 31 && has(wd, MONDAY, TUESDAY, WEDNESDAY)) 162 ) 163 ) { 164 return y + 1; 165 } else { 166 return y; 167 }; 168 }; 169 170 // Calculates the ISO week, 171 // given a year, week, day-of-week, and day-of-year. 172 fn calc_isoweek(y: int, w: int) int = { 173 switch (calc_janfirstweekday(y)) { 174 case MONDAY => 175 return w; 176 case TUESDAY, WEDNESDAY, THURSDAY => 177 return w + 1; 178 case FRIDAY => 179 return if (w != 0) w else 53; 180 case SATURDAY => 181 return if (w != 0) w else { 182 yield if (isleapyear(y - 1)) 53 else 52; 183 }; 184 case SUNDAY => 185 return if (w != 0) w else 52; 186 case => 187 abort(); 188 }; 189 }; 190 191 // Calculates the week within a Gregorian year [0..53], 192 // given a day-of-year and day-of-week. 193 // All days in a year before the year's first Monday belong to week 0. 194 fn calc_week(yd: int, wd: int) int = { 195 return (yd + 6 - wd) / 7; 196 }; 197 198 // Calculates the week within a Gregorian year [0..53], 199 // given a day-of-year and day-of-week. 200 // All days in a year before the year's first Sunday belong to week 0. 201 fn calc_sundayweek(yd: int, wd: int) int = { 202 return (yd + 6 - ((wd + 1) % 7)) / 7; 203 }; 204 205 // Calculates the day-of-week, given a epochal day, 206 // from Monday=0 to Sunday=6. 207 fn calc_weekday(e: i64) int = { 208 const wd = ((e + 3) % 7): int; 209 return (wd + 7) % 7; 210 }; 211 212 // Calculates the daydate, 213 // given a year, month, and day-of-month. 214 fn calc_daydate__ymd(y: int, m: int, d: int) (i64 | invalid) = { 215 if (!is_valid_ymd(y, m, d)) { 216 return invalid; 217 }; 218 219 // Algorithm adapted from: 220 // https://en.wikipedia.org/wiki/Julian_day 221 // 222 // TODO: Review, cite, verify, annotate. 223 224 // workaround for dates before -4800 March 1st 225 let Y = y; 226 let cycles = 0; 227 for (Y <= -4800) { 228 Y += 400; // Gregorian 400 year cycle 229 cycles += 1; 230 }; 231 232 const jdn = ( // Julian Date Number 233 (1461 * (Y + 4800 + (m - 14) / 12)) / 4 234 + (367 * (m - 2 - 12 * ((m - 14) / 12))) / 12 235 - (3 * ((Y + 4900 + (m - 14) / 12) / 100)) / 4 236 + d 237 - 32075 238 ); 239 240 const e = jdn + EPOCHDAY_JULIAN - (GREGORIAN_CYCLE_DAYS * cycles); 241 242 return e; 243 }; 244 245 // Calculates the daydate, 246 // given a year, week, and day-of-week. 247 fn calc_daydate__ywd(y: int, w: int, wd: int) (i64 | invalid) = { 248 const jan1wd = calc_janfirstweekday(y); 249 const yd = wd - jan1wd + 7 * w; 250 return calc_daydate__yd(y, yd)?; 251 }; 252 253 // Calculates the daydate, 254 // given a year and day-of-year. 255 fn calc_daydate__yd(y: int, yd: int) (i64 | invalid) = { 256 if (yd < 1 || yd > calc_days_in_year(y)) { 257 return invalid; 258 }; 259 return calc_daydate__ymd(y, 1, 1)? + yd - 1; 260 }; 261 262 @test fn calc_daydate__ymd() void = { 263 const cases = [ 264 (( -768, 2, 5), -999999, false), 265 (( -1, 12, 31), -719529, false), 266 (( 0, 1, 1), -719528, false), 267 (( 0, 1, 2), -719527, false), 268 (( 0, 12, 31), -719163, false), 269 (( 1, 1, 1), -719162, false), 270 (( 1, 1, 2), -719161, false), 271 (( 1965, 3, 23), -1745, false), 272 (( 1969, 12, 31), -1, false), 273 (( 1970, 1, 1), 0, false), 274 (( 1970, 1, 2), 1, false), 275 (( 1999, 12, 31), 10956, false), 276 (( 2000, 1, 1), 10957, false), 277 (( 2000, 1, 2), 10958, false), 278 (( 2038, 1, 18), 24854, false), 279 (( 2038, 1, 19), 24855, false), 280 (( 2038, 1, 20), 24856, false), 281 (( 2243, 10, 17), 100000, false), 282 (( 4707, 11, 28), 999999, false), 283 (( 4707, 11, 29), 1000000, false), 284 ((29349, 1, 25), 9999999, false), 285 286 (( 1970,-99,-99), 0, true), 287 (( 1970, -9, -9), 0, true), 288 (( 1970, -1, -1), 0, true), 289 (( 1970, 0, 0), 0, true), 290 (( 1970, 0, 1), 0, true), 291 (( 1970, 1, 99), 0, true), 292 (( 1970, 99, 99), 0, true), 293 ]; 294 for (let (params, expect, should_error) .. cases) { 295 const actual = calc_daydate__ymd( 296 params.0, params.1, params.2, 297 ); 298 299 if (should_error) { 300 assert(actual is invalid, "invalid date accepted"); 301 } else { 302 assert(actual is i64, "valid date not accepted"); 303 assert(actual as i64 == expect, "date miscalculation"); 304 }; 305 }; 306 }; 307 308 @test fn calc_daydate__ywd() void = { 309 const cases = [ 310 (( -768, 0, 4), -1000034), 311 (( -768, 5, 4), -999999), 312 (( -1, 52, 5), -719529), 313 (( 0, 0, 6), -719528), 314 (( 0, 0, 7), -719527), 315 (( 0, 52, 7), -719163), 316 (( 1, 0, 1), -719162), 317 (( 1, 0, 2), -719161), 318 (( 1965, 12, 2), -1745), 319 (( 1969, 52, 3), -1), 320 (( 1970, 0, 4), 0), 321 (( 1970, 0, 5), 1), 322 (( 1999, 52, 5), 10956), 323 (( 2000, 0, 6), 10957), 324 (( 2000, 0, 7), 10958), 325 (( 2020, 0, 3), 18262), 326 (( 2022, 9, 1), 19051), 327 (( 2022, 9, 2), 19052), 328 (( 2023, 51, 7), 19715), 329 (( 2024, 8, 3), 19781), 330 (( 2024, 8, 4), 19782), 331 (( 2024, 8, 5), 19783), 332 (( 2024, 49, 4), 20069), 333 (( 2024, 52, 2), 20088), 334 (( 2038, 3, 1), 24854), 335 (( 2038, 3, 2), 24855), 336 (( 2038, 3, 3), 24856), 337 (( 2243, 41, 2), 99993), 338 (( 4707, 47, 4), 999999), 339 (( 4707, 47, 5), 1000000), 340 ((29349, 3, 6), 9999999), 341 ]; 342 343 for (let (ywd, expected) .. cases) { 344 const actual = calc_daydate__ywd(ywd.0, ywd.1, ywd.2)!; 345 assert(actual == expected, 346 "incorrect calc_daydate__ywd() result"); 347 }; 348 }; 349 350 @test fn calc_daydate__yd() void = { 351 const cases = [ 352 ( -768, 36, -999999), 353 ( -1, 365, -719529), 354 ( 0, 1, -719528), 355 ( 0, 2, -719527), 356 ( 0, 366, -719163), 357 ( 1, 1, -719162), 358 ( 1, 2, -719161), 359 ( 1965, 82, -1745 ), 360 ( 1969, 365, -1 ), 361 ( 1970, 1, 0 ), 362 ( 1970, 2, 1 ), 363 ( 1999, 365, 10956 ), 364 ( 2000, 1, 10957 ), 365 ( 2000, 2, 10958 ), 366 ( 2038, 18, 24854 ), 367 ( 2038, 19, 24855 ), 368 ( 2038, 20, 24856 ), 369 ( 2243, 290, 100000 ), 370 ( 4707, 332, 999999 ), 371 ( 4707, 333, 1000000), 372 (29349, 25, 9999999), 373 ]; 374 375 for (let (y, yd, expected) .. cases) { 376 const actual = calc_daydate__yd(y, yd)!; 377 assert(expected == actual, 378 "error in date calculation from yd"); 379 }; 380 assert(calc_daydate__yd(2020, 0) is invalid, 381 "calc_daydate__yd() did not reject invalid yearday"); 382 assert(calc_daydate__yd(2020, 400) is invalid, 383 "calc_daydate__yd() did not reject invalid yearday"); 384 }; 385 386 @test fn calc_ymd() void = { 387 const cases = [ 388 (-999999, ( -768, 2, 5)), 389 (-719529, ( -1, 12, 31)), 390 (-719528, ( 0, 1, 1)), 391 (-719527, ( 0, 1, 2)), 392 (-719163, ( 0, 12, 31)), 393 (-719162, ( 1, 1, 1)), 394 (-719161, ( 1, 1, 2)), 395 ( -1745, ( 1965, 3, 23)), 396 ( -1, ( 1969, 12, 31)), 397 ( 0, ( 1970, 1, 1)), 398 ( 1, ( 1970, 1, 2)), 399 ( 10956, ( 1999, 12, 31)), 400 ( 10957, ( 2000, 1, 1)), 401 ( 10958, ( 2000, 1, 2)), 402 ( 24854, ( 2038, 1, 18)), 403 ( 24855, ( 2038, 1, 19)), 404 ( 24856, ( 2038, 1, 20)), 405 ( 100000, ( 2243, 10, 17)), 406 ( 999999, ( 4707, 11, 28)), 407 (1000000, ( 4707, 11, 29)), 408 (9999999, (29349, 1, 25)), 409 ]; 410 for (let (paramt, expect) .. cases) { 411 const actual = calc_ymd(paramt); 412 assert(expect.0 == actual.0, "year mismatch"); 413 assert(expect.1 == actual.1, "month mismatch"); 414 assert(expect.2 == actual.2, "day mismatch"); 415 }; 416 }; 417 418 @test fn calc_yearday() void = { 419 const cases = [ 420 (( -768, 2, 5), 36), 421 (( -1, 12, 31), 365), 422 (( 0, 1, 1), 1), 423 (( 0, 1, 2), 2), 424 (( 0, 12, 31), 366), 425 (( 1, 1, 1), 1), 426 (( 1, 1, 2), 2), 427 (( 1965, 3, 23), 82), 428 (( 1969, 12, 31), 365), 429 (( 1970, 1, 1), 1), 430 (( 1970, 1, 2), 2), 431 (( 1999, 12, 31), 365), 432 (( 2000, 1, 1), 1), 433 (( 2000, 1, 2), 2), 434 (( 2020, 2, 12), 43), 435 (( 2038, 1, 18), 18), 436 (( 2038, 1, 19), 19), 437 (( 2038, 1, 20), 20), 438 (( 2243, 10, 17), 290), 439 (( 4707, 11, 28), 332), 440 (( 4707, 11, 29), 333), 441 ((29349, 1, 25), 25), 442 ]; 443 for (let (params, expect) .. cases) { 444 const actual = calc_yearday(params.0, params.1, params.2); 445 assert(expect == actual, "yearday miscalculation"); 446 }; 447 }; 448 449 @test fn calc_week() void = { 450 const cases = [ 451 (( 1, 0), 1), 452 (( 1, 1), 0), 453 (( 1, 2), 0), 454 (( 1, 3), 0), 455 (( 1, 4), 0), 456 (( 1, 5), 0), 457 (( 1, 6), 0), 458 (( 21, 1), 3), 459 (( 61, 2), 9), 460 ((193, 4), 27), 461 ((229, 0), 33), 462 ((286, 3), 41), 463 ((341, 6), 48), 464 ((365, 5), 52), 465 ((366, 0), 53), 466 ]; 467 468 for (let (params, expect) .. cases) { 469 const actual = calc_week(params.0, params.1); 470 assert(expect == actual, "week miscalculation"); 471 }; 472 }; 473 474 @test fn calc_sundayweek() void = { 475 const cases = [ 476 (( 1, 0), 0), 477 (( 1, 1), 0), 478 (( 1, 2), 0), 479 (( 1, 3), 0), 480 (( 1, 4), 0), 481 (( 1, 5), 0), 482 (( 1, 6), 1), 483 (( 21, 1), 3), 484 (( 61, 2), 9), 485 ((193, 4), 27), 486 ((229, 0), 33), 487 ((286, 3), 41), 488 ((341, 6), 49), 489 ((365, 5), 52), 490 ((366, 0), 53), 491 ]; 492 493 for (let (params, expect) .. cases) { 494 const actual = calc_sundayweek(params.0, params.1); 495 assert(expect == actual, "week miscalculation"); 496 }; 497 }; 498 499 @test fn calc_weekday() void = { 500 const cases = [ 501 (-999999, 3), // -0768-02-05 502 (-719529, 4), // -0001-12-31 503 (-719528, 5), // 0000-01-01 504 (-719527, 6), // 0000-01-02 505 (-719163, 6), // 0000-12-31 506 (-719162, 0), // 0001-01-01 507 (-719161, 1), // 0001-01-02 508 ( -1745, 1), // 1965-03-23 509 ( -1, 2), // 1969-12-31 510 ( 0, 3), // 1970-01-01 511 ( 1, 4), // 1970-01-02 512 ( 10956, 4), // 1999-12-31 513 ( 10957, 5), // 2000-01-01 514 ( 10958, 6), // 2000-01-02 515 ( 24854, 0), // 2038-01-18 516 ( 24855, 1), // 2038-01-19 517 ( 24856, 2), // 2038-01-20 518 ( 100000, 1), // 2243-10-17 519 ( 999999, 3), // 4707-11-28 520 (1000000, 4), // 4707-11-29 521 (9999999, 5), // 29349-01-25 522 ]; 523 for (let (paramt, expect) .. cases) { 524 const actual = calc_weekday(paramt); 525 assert(expect == actual, "weekday miscalculation"); 526 }; 527 }; 528 529 @test fn calc_janfirstweekday() void = { 530 const cases = [ 531 // year weekday 532 (1969, 2), 533 (1970, 3), 534 (1971, 4), 535 (1972, 5), 536 (1973, 0), 537 (1974, 1), 538 (1975, 2), 539 (1976, 3), 540 (1977, 5), 541 (1978, 6), 542 (1979, 0), 543 (1980, 1), 544 (1981, 3), 545 (1982, 4), 546 (1983, 5), 547 (1984, 6), 548 (1985, 1), 549 (1986, 2), 550 (1987, 3), 551 (1988, 4), 552 (1989, 6), 553 (1990, 0), 554 (1991, 1), 555 (1992, 2), 556 (1993, 4), 557 (1994, 5), 558 (1995, 6), 559 (1996, 0), 560 (1997, 2), 561 (1998, 3), 562 (1999, 4), 563 (2000, 5), 564 (2001, 0), 565 (2002, 1), 566 (2003, 2), 567 (2004, 3), 568 (2005, 5), 569 (2006, 6), 570 (2007, 0), 571 (2008, 1), 572 (2009, 3), 573 (2010, 4), 574 (2011, 5), 575 (2012, 6), 576 (2013, 1), 577 (2014, 2), 578 (2015, 3), 579 (2016, 4), 580 (2017, 6), 581 (2018, 0), 582 (2019, 1), 583 (2020, 2), 584 (2021, 4), 585 (2022, 5), 586 (2023, 6), 587 (2024, 0), 588 (2025, 2), 589 (2026, 3), 590 (2027, 4), 591 (2028, 5), 592 (2029, 0), 593 (2030, 1), 594 (2031, 2), 595 (2032, 3), 596 (2033, 5), 597 (2034, 6), 598 (2035, 0), 599 (2036, 1), 600 (2037, 3), 601 (2038, 4), 602 (2039, 5), 603 ]; 604 for (let (paramt, expect) .. cases) { 605 const actual = calc_janfirstweekday(paramt); 606 assert(expect == actual, "calc_janfirstweekday() miscalculation"); 607 }; 608 };