Skip to content

Commit 483db91

Browse files
OldesOldes
committed
FEAT: conversion from date to decimal now returns Julian date as well as /julian date accessor
resolves: Oldes/Rebol-issues#2551
1 parent b18dc57 commit 483db91

File tree

4 files changed

+165
-5
lines changed

4 files changed

+165
-5
lines changed

‎src/core/t-date.c

+100-2
Original file line numberDiff line numberDiff line change
@@ -457,6 +457,86 @@ static const REBI64 DAYS_OF_JAN_1ST_1970 = 719468; // number of days for 1st Jan
457457
}
458458

459459

460+
/***********************************************************************
461+
**
462+
*/ REBDEC Gregorian_To_Julian_Date(REBDAT date, REB_TIMEF time)
463+
/*
464+
** Given a Gregorian date and time, return Julian date
465+
** https://www.typecalendar.com/julian-date
466+
** https://pdc.ro.nu/jd-code.html
467+
**
468+
***********************************************************************/
469+
{
470+
long jd;
471+
long d = date.date.day-1;
472+
long m = date.date.month-1;
473+
long y = date.date.year;
474+
475+
//printf("%li-%li-%li %i:%i:%i\n", d, m, y, time.h, time.m, time.s);
476+
if (time.h <= 12) {
477+
d--;
478+
time.h += 12;
479+
} else {
480+
time.h -= 12;
481+
}
482+
date = Normalize_Date(d,m,y,0);
483+
d = date.date.day-1;
484+
m = date.date.month;
485+
y = date.date.year;
486+
//printf("%li-%li-%li %i:%i:%i\n", d, m, y, time.h, time.m, time.s);
487+
488+
y += 8000;
489+
if (m < 3) { y--; m += 12; }
490+
jd = (y*365) +(y/4) -(y/100) +(y/400) -1200820;
491+
jd += (m*153+3)/5-92;
492+
jd += d ;
493+
494+
return (REBDEC)jd + ((double)time.h / 24.0 + (double)time.m / 1440.0 + (double)time.s / 86400.0);
495+
}
496+
497+
/***********************************************************************
498+
**
499+
*/ void Julian_To_Gregorian_Date(REBDEC julian, REBINT *day, REBINT *month, REBINT *year, REBI64 *secs)
500+
/*
501+
** Converts a Julian date to a Gregorian date and time.
502+
** https://www.typecalendar.com/julian-date
503+
** NOTE: month and day are 1-based!
504+
**
505+
***********************************************************************/
506+
{
507+
REBINT z, w, x, a, b, c, d, e, f;
508+
double fp, ip;
509+
REBI64 h, m, s;
510+
511+
fp = modf(julian, &ip); // The fractional part
512+
513+
z = (REBINT)ip; // The integral part of the Julian day
514+
w = (z - 1867216.25) / 36524.25; // The value used in the calculation to determine the leap years. It represents the number of leap years since 4713 BC
515+
x = w / 4; // The number of 4-year cycles (leap year groups) that have passed since the year 4713 BC.
516+
a = z + 1 + w - x; // The adjusted Julian day number, taking into account leap years.
517+
b = a + 1524; // The Julian day number shifted by 122.1 to provide a suitable starting point for subsequent calculations.
518+
c = (b - 122.1) / 365.25; // The estimated year of the Gregorian calendar.
519+
d = 365.25 * c; // The number of days that have passed in the year, excluding the current month.
520+
e = (b - d) / 30.6001; // The month number.
521+
f = 30.6001 * e; // The number of days that have passed in the current month, excluding the current day.
522+
523+
*day = b - d - f + fp;
524+
*month = (e < 14) ? e - 1 : e - 13;
525+
*year = (*month > 2) ? c - 4716 : c - 4715;
526+
527+
528+
fp *= 24;
529+
h = (REBI64)fp;
530+
fp = (fp - h) * 60;
531+
m = (REBI64)fp;
532+
fp = (fp - m) * 60;
533+
s = (REBI64)round(fp);
534+
535+
//printf("--- %i-%i-%i %lli:%lli:%lli\n", *day, *month, *year, h, m, s);
536+
537+
*secs = (h+12) * HR_SEC + m * MIN_SEC + s * SEC_SEC;
538+
}
539+
460540
/***********************************************************************
461541
**
462542
*/ void Subtract_Date(REBVAL *d1, REBVAL *d2, REBVAL *result)
@@ -679,9 +759,17 @@ static const REBI64 DAYS_OF_JAN_1ST_1970 = 719468; // number of days for 1st Jan
679759
num = Week_Day(date);
680760
break;
681761
case SYM_YEARDAY:
682-
case SYM_JULIAN:
683762
num = (REBINT)Julian_Date(date);
684763
break;
764+
case SYM_JULIAN:
765+
if (secs == NO_TIME) {
766+
time.h = 12; // Julian date is counted from noon
767+
} else {
768+
// Julian date result is in universal time!
769+
Split_Time(secs - ((i64)tz) * ((i64)ZONE_SECS * SEC_SEC), &time);
770+
}
771+
SET_DECIMAL(val, Gregorian_To_Julian_Date(date, time));
772+
return PE_USE;
685773
case SYM_UTC:
686774
*val = *data;
687775
VAL_ZONE(val) = 0;
@@ -788,13 +876,18 @@ static const REBI64 DAYS_OF_JAN_1ST_1970 = 719468; // number of days for 1st Jan
788876
VAL_ZONE(data) = 0;
789877
return PE_USE;
790878
case SYM_YEARDAY:
791-
case SYM_JULIAN:
792879
if (!IS_INTEGER(val)) return PE_BAD_SET_TYPE;
793880
Date_Of_Days( Days_Of_Jan_1st(year) + n - 1, &date);
794881
day = date.date.day - 1;
795882
month = date.date.month - 1;
796883
year = date.date.year;
797884
break;
885+
case SYM_JULIAN:
886+
if (!IS_DECIMAL(val)) return PE_BAD_SET_TYPE;
887+
Julian_To_Gregorian_Date(VAL_DECIMAL(val), &day, &month, &year, &secs);
888+
day--; month--; // The date/time normalization expects 0-based day and month
889+
tz = 0; // no timezone
890+
break;
798891

799892
default:
800893
return PE_BAD_SET;
@@ -921,6 +1014,11 @@ static const REBI64 DAYS_OF_JAN_1ST_1970 = 719468; // number of days for 1st Jan
9211014
Timestamp_To_Date(D_RET, VAL_INT64(arg));
9221015
return R_RET;
9231016
}
1017+
else if (IS_DECIMAL(arg)) {
1018+
Julian_To_Gregorian_Date(VAL_DECIMAL(arg), &day, &month, &year, &secs);
1019+
day--; month--; // The date/time normalization expects 0-based day and month
1020+
goto fixTime;
1021+
}
9241022
// else if (IS_NONE(arg)) {
9251023
// secs = nsec = day = month = year = tz = 0;
9261024
// goto fixTime;

‎src/core/t-decimal.c

+10
Original file line numberDiff line numberDiff line change
@@ -407,6 +407,16 @@ REBOOL almost_equal(REBDEC a, REBDEC b, REBCNT max_diff) {
407407
d1 = VAL_DECIMAL(D_RET);
408408
break;
409409

410+
case REB_DATE:
411+
{
412+
REB_TIMEF time = {12,0,0,0};
413+
if (VAL_TIME(val) != NO_TIME) {
414+
Split_Time(VAL_TIME(val), &time);
415+
}
416+
d1 = Gregorian_To_Julian_Date(VAL_DATE(val), time);
417+
break;
418+
}
419+
410420
#ifdef removed
411421
// case REB_ISSUE:
412422
{

‎src/tests/units/date-test.r3

+14-2
Original file line numberDiff line numberDiff line change
@@ -335,6 +335,18 @@ Rebol [
335335

336336
===end-group===
337337

338+
===start-group=== "Julian date"
339+
;@@ https://github.com/Oldes/Rebol-issues/issues/2551
340+
--test-- "Julian accessor"
341+
date: 10-Jun-2023/20:47:53+2:00
342+
--assert date/julian = to decimal! date
343+
--assert 2460106.28325231 = date/julian
344+
--assert 2460106.28325231 = pick date 'julian
345+
--test-- "Julian date setter"
346+
--assert 2415020.5 = date/julian: 2415020.5
347+
--assert date = 1-Jan-1900/0:00
348+
349+
===end-group===
338350

339351
===start-group=== "QUERY date"
340352
date: 8-Apr-2020/12:04:32+2:00
@@ -348,11 +360,11 @@ Rebol [
348360
--assert date/time = query/mode date 'time
349361
--assert [2020 4] = query/mode date [year month]
350362
--assert [month: 4 year: 2020] = query/mode date [month: year:]
351-
--assert equal? query/mode date all-date-words [2020 4 8 12:04:32 8-Apr-2020 2:00 12 4 32 3 99 2:00 8-Apr-2020/10:04:32 99]
363+
--assert equal? query/mode date all-date-words [2020 4 8 12:04:32 8-Apr-2020 2:00 12 4 32 3 99 2:00 8-Apr-2020/10:04:32 2458947.91981481]
352364

353365
--test-- "query/mode date"
354366
date: 8-Apr-2020 ; no time!
355-
--assert equal? query/mode date all-date-words [2020 4 8 #[none] 2020-04-08 #[none] #[none] #[none] #[none] 3 99 #[none] 2020-04-08 99]
367+
--assert equal? query/mode date all-date-words [2020 4 8 #[none] 2020-04-08 #[none] #[none] #[none] #[none] 3 99 #[none] 2020-04-08 2458948.0]
356368

357369
===end-group===
358370

‎src/tests/units/make-test.r3

+41-1
Original file line numberDiff line numberDiff line change
@@ -61,7 +61,26 @@ Rebol [
6161
--assert 20-Sep-2021/12:46:42 = to date! 1632142002
6262
--assert 20-Sep-2021/10:58:32 = make date! 1632135512
6363
--assert 20-Sep-2021/10:58:32 = to date! 1632135512
64-
64+
--test-- "make/to date! decimal!"
65+
;@@ https://github.com/Oldes/Rebol-issues/issues/2551
66+
--assert 01-Jan-1900/00:00:00 = make date! 2415020.5
67+
--assert 01-Jan-1900/00:00:00 = to date! 2415020.5
68+
--assert 02-May-2003/12:00:00 = make date! 2452762.0
69+
--assert 02-May-2003/12:00:00 = to date! 2452762.0
70+
--assert 10-Jun-2023/01:30:00 = make date! 2460105.5625
71+
--assert 10-Jun-2023/01:30:00 = to date! 2460105.5625
72+
--assert 10-Jun-2023/19:30:00 = make date! 2460106.3125
73+
--assert 10-Jun-2023/19:30:00 = to date! 2460106.3125
74+
--assert 01-Jan-2023/12:00:00 = make date! 2459946.0
75+
--assert 01-Jan-2023/12:00:00 = to date! 2459946.0
76+
--assert 01-Jan-2023/19:30:00 = make date! 2459946.3125
77+
--assert 01-Jan-2023/19:30:00 = to date! 2459946.3125
78+
--assert 01-Jan-2023/01:00:00 = make date! 2459945.54166667
79+
--assert 01-Jan-2023/01:00:00 = to date! 2459945.54166667
80+
--assert 31-Aug-2132/00:00:00 = make date! 2499999.5
81+
--assert 31-Aug-2132/00:00:00 = to date! 2499999.5
82+
--assert 01-Sep-2132/00:00:00 = make date! 2500000.5
83+
--assert 01-Sep-2132/00:00:00 = to date! 2500000.5
6584
===end-group===
6685

6786
===start-group=== "make/to integer"
@@ -142,6 +161,27 @@ Rebol [
142161
repeat x 255 [unless error? try [to-decimal join "1" to-char x] [append ch to-char x]]
143162
--assert ch = "^- ',.0123456789Ee"
144163

164+
165+
--test-- "make/to decimal! date!"
166+
;@@ https://github.com/Oldes/Rebol-issues/issues/2551
167+
--assert 2415020.5 = make decimal! 01-Jan-1900/00:00:00
168+
--assert 2415020.5 = to decimal! 01-Jan-1900/00:00:00
169+
--assert 2452762.0 = make decimal! 02-May-2003/12:00:00
170+
--assert 2452762.0 = to decimal! 02-May-2003/12:00:00
171+
--assert 2460105.5625 = make decimal! 10-Jun-2023/01:30:00
172+
--assert 2460105.5625 = to decimal! 10-Jun-2023/01:30:00
173+
--assert 2460106.3125 = make decimal! 10-Jun-2023/19:30:00
174+
--assert 2460106.3125 = to decimal! 10-Jun-2023/19:30:00
175+
--assert 2459946.0 = make decimal! 01-Jan-2023/12:00:00
176+
--assert 2459946.0 = to decimal! 01-Jan-2023/12:00:00
177+
--assert 2459946.3125 = make decimal! 01-Jan-2023/19:30:00
178+
--assert 2459946.3125 = to decimal! 01-Jan-2023/19:30:00
179+
--assert 2459945.54166667 = make decimal! 01-Jan-2023/01:00:00
180+
--assert 2459945.54166667 = to decimal! 01-Jan-2023/01:00:00
181+
--assert 2499999.5 = make decimal! 31-Aug-2132/00:00:00
182+
--assert 2499999.5 = to decimal! 31-Aug-2132/00:00:00
183+
--assert 2500000.5 = make decimal! 01-Sep-2132/00:00:00
184+
--assert 2500000.5 = to decimal! 01-Sep-2132/00:00:00
145185
===end-group===
146186

147187

0 commit comments

Comments
 (0)