Date Calculations

Share your advanced PureBasic knowledge/code with the community.
Mesa
Enthusiast
Enthusiast
Posts: 433
Joined: Fri Feb 24, 2012 10:19 am

Date Calculations

Post by Mesa »

Code: Select all

;....................................................................................
;.: COMPUTATION ON DATES:.
; ============================
; Astronomical Julian Day
; ============================
; Author Mesa
; PureBasic v4.61b, v4.xx
;
; According to "Astronomie pratique et informatique"
; C. Dumoulin and JP Parisot, Ed Masson (scientific level: Master)
;
; The Julian day is universally used by astronomers and historians.
; Its accuracy is of the order of one minute of time between the years -5000 and +8000 (at least)
;
; Calculation of Julian day (JD Julian Day)
; Is essential to astronomical calculations
; But also To make calculations on calendar dates.
;
; Date arithmetic: addition, subtraction, etc. ...
;
; Eg: On June 6, 1944 at 6h 10' 24"+ 3 months 4 days 1 hour 47' 12" = ?
;......................................................................................

;OS : All

;Institut de mecanique celeste et de calcul des ephemerides
;http://www.imcce.fr/fr/grandpublic/temps/jour_julien.php
;http://www.imcce.fr/en/grandpublic/temps/jour_julien.php

Procedure.d jd(Year, Month, Day, Hour, Minute, Second); julian day  at 0h UT (Universal Time)
  
  Protected y.d=0
  Protected m.d=0
  Protected a.d=0
  Protected jj.d=0
  Protected z.d=0
  
  
  If Month<3
    y=Year-1
    m=Month+12
  Else
    y=Year
    m=Month
  EndIf
  
  jj=Int(365.25*(y+4716))+Int(30.6001*(m+1))+Day-1524.5 
  
  ; Consideration of the Gregorian reform
  ; At Thursday, October 4, 1582 will succeed Friday, October 15, 1582
  ;
  a=Year+(Month/100)+(Day/10000)
  If a>1582.1014; 
    a = Int(y/100)
    jj = jj + 2 - a + Int(a/4)
  EndIf
  
  ;Add h m s
  jj + (Hour + Minute/60 + Second/3600)/24
  
  ProcedureReturn jj
EndProcedure

Procedure.d jd2(Year, Month, Day, Hour, Minute, Second); julian day  at 0h UT (Universal Time)
  ; --Does not work before October 15, 1582 but faster than jd()--
  Protected j.d
  Protected m
  Protected a
  Protected jj.d
  
  a=Year
  m=Month
  j=Day+(Hour + Minute/60 + Second/3600)/24
  
  jj=367*a -Int(1.75*(Int((m+9)/12)+a))
  jj-Int(0.75*(1+Int((Int((m-9)/7)+a)*0.01)))
  jj+Int((275*m)/9)+j+1721028.5
  
  ProcedureReturn jj
EndProcedure

Procedure.s jd2Date(jj.d) ; Compute Date from a Julian Day
  
  Protected j1.d,f.d,dm.d,h.d
  Protected z,aa,al,b,c,d,e,an
  Protected result.s
  
  j1=jj+0.5
  z=Int(j1)
  f=j1-z
  If z<2299161
    aa=z
  Else
    al=Int((z-1867216.25)/36524.25)
    aa=z+1+al-Int(al/4)
  EndIf
  b=aa+1524
  c=Int((b-122.1)/365.25)
  d=Int(365.25*c)
  e=Int((b-d)/30.6001)
  dm=b-d-Int(30.6001*e)+f
  If e<14
    m=e-1
  Else
    m=e-13
  EndIf
  If m>2
    an=c-4716
  Else
    an=c-4715
  EndIf
  h=24*(dm-Int(dm))
  result=Str(an)+"/"+Str(m)+"/"+Str(Int(dm))+" "+StrD(h); Year Month Day Hours(fraction of hours)
  ProcedureReturn result
EndProcedure

Procedure.b DayOfWeekJD(jj.d)
  ;Return 0=Sunday, 1 Monday, 2=Tuesday, 3=Wednesday, 4=Thursday, 5=Friday, 6=Saturday
  Protected j.d
  Protected result.b
  j=jj+1.5
  result=Int(j-7*Int(j/7));j%7
  ProcedureReturn result
EndProcedure

Procedure DayOfYearJD(Year, Month, Day) ;Return the rank of days in the year
  Protected result
  result = 1+ jd(Year, Month, Day, 0, 0, 0) - jd(Year, 1, 1, 0, 0, 0)
  ProcedureReturn result
  
EndProcedure

Procedure.b IsLeapYear(year) ; Return : 0 = is not leap year, 1 = is leap year
  ;Bissextile in French
  Protected result.b
  
  If year < 1582 ; Too complicated, believe me !
    ProcedureReturn 0 ; -1
  EndIf
  
  If year%4=0 
    If y%100<>0
      result=1
    ElseIf year%400=0
      result=1
    EndIf
    result=1
  EndIf
  ProcedureReturn result
EndProcedure



Debug ("_____________.: JULIAN DAYs :.______________")
Debug "Gregorian Day : -4712,1,1 :-> Julian Day = " + StrD(jd(-4712,1,1,0,0,0),2)
Debug " Consideration of the Gregorian reform"
Debug " At Thursday, October 4, 1582 will succeed Friday, October 15, 1582"
Debug "Gregorian Day : 1582,10,4 :-> Julian Day = " + StrD(jd(1582,10,4,0,0,0),2)
Debug "Gregorian Day : 1582,10,15 :-> Julian Day = " + StrD(jd(1582,10,15,0,0,0),2)
Debug " Consideration of the Gregorian reform OK"
Debug "Gregorian Day : 1789,7,14 :-> Julian Day = " + StrD(jd(1789,7,14,0,0,0),2)
Debug "Gregorian Day : 1900,1,1 :-> Julian Day = " + StrD(jd(1900,1,1,0,0,0),2)
Debug "Gregorian Day : 2000,1,1 :-> Julian Day = " + StrD(jd(2000,1,1,0,0,0),2)
Debug "judgment Day ;) : 2012,12,21,12,12,12 :-> Julian Day = " + StrD(jd(2012,12,21,12,12,12),6)
Debug "Gregorian Day : 3000,1,1 :-> Julian Day = whew ;)) " + StrD(jd(3000,1,1,0,0,0),2)
Debug ""

Debug("___________Quick JD_____________")
Debug "Quick computing but no Consideration of the Gregorian reform"
Debug "Gregorian Day : 1582,10,15 :-> Julian Day = " + StrD(jd2(1582,10,15,0,0,0),2)
Debug "Gregorian Day : 1789,7,14 :-> Julian Day = " + StrD(jd2(1789,7,14,0,0,0),2)
Debug "Gregorian Day : 1900,1,1 :-> Julian Day = " + StrD(jd2(1900,1,1,0,0,0),2)
Debug "Gregorian Day : 2000,1,1 :-> Julian Day = " + StrD(jd2(2000,1,1,0,0,0),2)
Debug "Judgment Day ;) : 2012,12,21,12,12,12 :-> Julian Day = " + StrD(jd2(2012,12,21,12,12,12),6)
Debug ""

Debug("___________JD -> Grego_(Y, M, D, h)____________")
Debug "Julian Day = -0.50 :-> Gregorian Day : " + jd2Date(-0.50)  
;  Consideration of the Gregorian reform
Debug "  At Thursday, October 4, 1582 will succeed Friday, October 15, 1582"
Debug "Julian Day = 2299159.50 :-> Gregorian Day : " + jd2Date(2299159.50)
Debug "Julian Day = 2299160.50 :-> Gregorian Day : " + jd2Date(2299160.50)
Debug "  Consideration of the Gregorian reform OK"
Debug "Julian Day = 2374673.50 :-> Gregorian Day : " + jd2Date(2374673.50)
Debug "Julian Day = 2415020.50 :-> Gregorian Day : " + jd2Date(2415020.50)
Debug "Julian Day = 2451544.50 :-> Gregorian Day : " +jd2Date(2451544.50)
Debug "Julian Day =2456283.008472 :-> Gregorian Day : " + jd2Date(2456283.008472)
Debug "Julian Day = 2816787.50 :-> Gregorian Day : " + jd2Date(2816787.50)
Debug ""

; Debug("___________Day of Week____________")
; Debug "0=Sunday, 1 Monday, 2=Tuesday, 3=Wednesday, 4=Thursday, 5=Friday, 6=Saturday"
; Debug "  At Thursday, October 4, 1582 will succeed Friday, October 15, 1582"
; Debug "Day of Week of 1582,10,4 is " + Str(DayOfWeekJD(jd(1582,10,4,0,0,0)))
; Debug "Day of Week of 1582,10,15 is " + Str(DayOfWeekJD(jd(1582,10,15,0,0,0)))
; Debug "Day of Week of 2000,1,1 is " + Str(DayOfWeekJD(jd(1582,10,15,0,0,0)))
; Debug ""

Debug("___________Day of Week____________")
; Debug "0=Sunday, 1 Monday, 2=Tuesday, 3=Wednesday, 4=Thursday, 5=Friday, 6=Saturday"
; Debug "  At Thursday, October 4, 1582 will succeed Friday, October 15, 1582"
 days.s ="Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday"
Debug "Day of Week of 1582,10,4 is " + StringField(days.s,DayOfWeekJD(jd(1582,10,4,0,0,0))+1 ,",")
Debug "Day of Week of 1582,10,15 is " + StringField(days.s,DayOfWeekJD(jd(1582,10,15,0,0,0))+1 ,",")
Debug "Day of Week of 2000,1,1 is " + StringField(days.s,DayOfWeekJD(jd(2000,1,1,0,0,0))+1 ,",")
Debug ""

Debug("___________Today____________")
Today$=FormatDate("%yyyy/%mm/%dd %hh:%ii:%ss", Date())
jdToday.d=jd(Year(Date()),Month(Date()),Day(Date()),Hour(Date()),Minute(Date()),Second(Date()))

dow=DayOfWeekJD(jdToday)
dow$=""
;0=Sunday, 1 Monday, 2=Tuesday, 3=Wednesday, 4=Thursday, 5=Friday, 6=Saturday
Select dow
  Case 0 : dow$="Sunday "
  Case 1 : dow$="Monday "
  Case 2 : dow$="Tuesday "
  Case 3 : dow$="Wednesday "
  Case 4 : dow$="Thursday "
  Case 5 : dow$="Friday "
  Case 6 : dow$="Saturday "
EndSelect  
Debug "Today :" + dow$ + Today$
Debug "Julian Day " + StrD(jdToday)
Debug "Day n° " + Str(DayOfYearJD(Year(Date()), Month(Date()), Day(Date()))) + " of the year"
isleap$ =" is a leap year"
isnotleapyear$ = " is not a leap year"
If IsLeapYear(Year(Date())) = 1
  Debug Str(Year(Date())) + isleap$
Else
  Debug Str(Year(Date())) + isnotleapyear$
EndIf


MessageRequester("Listen","Let's do some math.",0)


ClearDebugOutput()
Debug "Let's do some math."
Debug "What's the date of : 373 days after the 2000/1/1 0h ?"
Newjd.d=jd(2000,1,1,0,0,0) + 373
Debug jd2Date(Newjd)
Debug ""

Debug "What's the date of : 119 days before the 2000/1/1 0h ?"
Debug jd2Date(jd(2000,1,1,0,0,0) - 119)
Debug ""

Debug "What's the date of : 3 weeks after the 2000/1/1 0h ?"
Debug jd2Date(jd(2000,1,1,0,0,0) + 7*3)
Debug ""

Debug "What's the number of days between the 2000/1/1 12h 14m 37s And  the 3000/1/1 6h 56m 12s ?"
jd1.d=jd(2000,1,1,12,14,37)
jd2.d=jd(3000,1,1,6,56,12)
Debug jd2-jd1
Debug ""

Debug "baby will be born 9 month from today :"
Debug jd2Date(jdToday + 9*30.5)
Mesa.
User avatar
STARGÅTE
Addict
Addict
Posts: 2227
Joined: Thu Jan 10, 2008 1:30 pm
Location: Germany, Glienicke
Contact:

Re: Date Calculations

Post by STARGÅTE »

any informations?

What about these functions better than to Date(), AddDate() and FormatDate() from PureBasic?

Code: Select all

Debug "Let's do some math."
Debug "What's the date of : 373 days after the 2000/1/1 0h ?"
New.i = AddDate( Date(2000,1,1,0,0,0) , #PB_Date_Day, 373)
Debug FormatDate("%mm/%dd/%yyyy %hh:%ii:%ss", New)
Debug ""
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Lizard - Script language for symbolic calculations and moreTypeface - Sprite-based font include/module
Mesa
Enthusiast
Enthusiast
Posts: 433
Joined: Fri Feb 24, 2012 10:19 am

Re: Date Calculations

Post by Mesa »

At this address http://www.purebasic.com/documentation/date/index.html, we can read :

PureBasic - Date

Overview

The Date library allows for the manipulation of Date and Time from 1970 up to 2038 using the unix method (i.e. the number of seconds elapsed since the 1st of January 1970).

Note: supported date/time values are 1970-01-01, 00:00:00 for the minimum and 2038-01-19, 03:14:07 for the maximum.

So, this code fail.

Code: Select all

Debug "Let's do some math."
Debug "What's the date of : 373 days after the 1950/1/1 0h ?"
New.i = AddDate( Date(1950,1,1,0,0,0) , #PB_Date_Day, 373)
Debug FormatDate("%mm/%dd/%yyyy %hh:%ii:%ss", New)
Debug ""
1970 is not enough for me, i was born before this date ! and i'm not so old. ;)

I think it's not enough if you want to make some astronomical programs or historical thing or...


I know that 1970 is the "unix time" or the "posix time" see
http://en.wikipedia.org/wiki/Unix_time
but I do not know if it's a good reason to have a limited library.
I hope the Julian day will coexist with "unix dates".


Mesa.
User avatar
Lord
Addict
Addict
Posts: 900
Joined: Tue May 26, 2009 2:11 pm

Re: Date Calculations

Post by Lord »

Hi Mesa!

Thanks for sharing your code.
; Consideration of the Gregorian reform
; At Thursday, October 4, 1582 will succeed Friday, October 15, 1582
Maybe it should be possible to choose the implementation date for a given
region, becaus the Gregorian reform wasn't executed at the same time in
all parts of the world.
Wikipedia shows this timeline.
Image
User avatar
STARGÅTE
Addict
Addict
Posts: 2227
Joined: Thu Jan 10, 2008 1:30 pm
Location: Germany, Glienicke
Contact:

Re: Date Calculations

Post by STARGÅTE »

Mesa wrote:1970 is not enough for me, i was born before this date ! and i'm not so old.

I think it's not enough if you want to make some astronomical programs or historical thing or...
Ok, but why you use doubles (yes i know you make arithmetic with Julian days)?
I think it would be better to use Quads and extend the UNIX-Time (arithmetic with seconds)
With sign Quads, you can use time before and after 1970.
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Lizard - Script language for symbolic calculations and moreTypeface - Sprite-based font include/module
staringfrog
User
User
Posts: 58
Joined: Wed Feb 27, 2013 9:36 am

Re: Date Calculations

Post by staringfrog »

STARGÅTE wrote: Ok, but why you use doubles (yes i know you make arithmetic with Julian days)?
I think it would be better to use Quads and extend the UNIX-Time (arithmetic with seconds)
With sign Quads, you can use time before and after 1970.
That's interesting, why don't you show how?

A great topic, and it can be extended in many ways. Any correlations with Moon calendar, for Asian historians? Zodiac signs? Timeline gadgets? Lot of things to devise and dig into.

One other PB forum thread on the subject matter here
Coding's men's knitwork.
Post Reply