Home  |  Contents 

Microcontroller and PC projects
  Forum Index : Microcontroller and PC projects         Section
Subject Topic: A day of the year function. Post ReplyPost New Topic
Page of 2 Next >>
Author
Message << Prev Topic | Next Topic >>
Paul_L
Guru
Guru


Joined: 03 March 2016
Location: United States
Online Status: Offline
Posts: 426
Posted: 10 July 2018 at 10:41am | IP Logged Quote Paul_L

Take a look at this day of the year function which I dashed off just now. I wonder if anyone can suggest a better way to do it.

Paul in NY

' DofY.bas, P Lepkowski, 7/9/2018
  ' tests function DofY(d$) which finds the numeric day of any year
  ' run it under MMBasic for DOS

GLOBALS:
  Option base 1
  Dim m%,d%,y%,day$, year%,LeapYear%
  ' date$="dd-mm-yyyy", time$="hh:mm:ss"

main:
  Do
    Print "Enter a day, month and year or '0' (zero) to end!"
    Input "day"; d%: If (d%<1 Or d%>31) Then Exit Do
    Input "month"; m%: If (m%<1 Or m%>12) Then Exit Do
    Input "year"; y%: If y%<100 Then y%=2000+y%
    day$=Str$(d%,2,0,"0")+"-"+Str$(m%,2,0,"0")+"-"+Str$(y%,4,0,"0")
    Print
    Print day$+" is the "+ Str$( DofY%(day$) )+" day of the year."
  Loop
  Print
  Print "Today is "+Date$+" which is the "+ Str$( DofY%(Date$) )+" day of the year."
  Print
  Print "This displays all years from 2000 to 2500 followed by '1' if it is a leap year or '0' if it is not a leap year."
  Print "It verifies that 2100, 2200, 2300 and 2500 are not leap years."
  Print "Hint: stretch this window horizontally and vertically until you see 20 columns and 25 rows!."
  For year%=2000 To 2500
    If (year%\100)=(year%/100) Then
      LeapYear%=((year%\400)=(year%/400))
    Else
      LeapYear%=((year%\4)=(year%/4))
    EndIf
    Print Str$(year%)+" "+Str$(LeapYear%),
  Next year%
End

Function DofY%(DofY.dat$) 'accepts date$() or "dd-mm-yyyy"
  Local DofY.i%, DofY.d%, DofY.m%, DofY.y%, DofY.LeapY%, DofY.inMo%(12)
  ' parse DofY.dat$ passed in
  DofY.d%=Val(Mid$(DofY.dat$,1,2))
  DofY.m%=Val(Mid$(DofY.dat$,4,2))
  DofY.y%=Val(Mid$(DofY.dat$,7,4))
  ' is DofY.Y% a leap year
  If (DofY.y%\100)=(DofY.y%/100) Then
    DofY.LeapY%=((DofY.y%\400)=(DofY.y%/400))
  Else
    DofY.LeapY%=((DofY.y%\4)=(DofY.y%/4))
  EndIf
  ' load DofY.inMo%(12) array
  If DofY.LeapY%=1 Then Restore DofYleapData Else Restore DofYData
  For DofY.i%=1 To 12:Read DofY.inMo%(DofY.i%):Next DofY.i%
  ' calculate Day of Year
  If DofY.m%=1 Then DofY%=DofY.d% Else DofY%=DofY.d%+DofY.inMo%(DofY.m%-1)
End Function 'DofY%

DofYData:
  Data 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365

DofYleapData:
  Data 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366

  ''''''''''''''''''''''''''''eof



Back to Top View Paul_L's Profile Search for other posts by Paul_L
 
Grogster
Guru
Guru
Avatar

Joined: 31 December 2012
Location: New Zealand
Online Status: Offline
Posts: 6227
Posted: 10 July 2018 at 12:45pm | IP Logged Quote Grogster

I setup a one-dimensional array to hold the days:


DOW$(0)="Sunday":DOW$(1)="Monday":DOW$(2)="Tuesday":DOW$(3)="Wednesday"
DOW$(4)="Thursday":DOW$(5)="Friday":DOW$(6)="Saturday"


...then a Function to calculate the day reference:


function DayOfWeek(year, month, day)
  a = int((14-month)/12)
  m = month + 12*a - 2
  y = year - a
  DayOfWeek = (day + y + int(y/4)-int(y/100)+int(y/400)+int(31*m/12)) mod 7
end function



...then used a simple SUB to build the date string whenever I needed it:



SUB BUILD_DATE
  YEAR=val(MID$(DATE$,7,4)):MONTH=VAL(MID$(DATE$,4,2)):DAY=val(MID$(DATE$,1,2))
  DOW_DAY$=DOW$(DayOfWeek(YEAR,MONTH,DAY)) + ", " + DATE$
  CtrlVal(MM_DAD)="THE DATE TODAY IS:  "+DOW_DAY$
END SUB



Result:






The formula for DayOfWeek came from someone here on the forums, and I think they got it from the net. I understand it is a reasonably well known formula for calculating the day of the week.


__________________
Smoke makes things work. When the smoke gets out, it stops!
Back to Top View Grogster's Profile Search for other posts by Grogster Visit Grogster's Homepage
 
MicroBlocks
Guru
Guru
Avatar

Joined: 12 May 2012
Location: Thailand
Online Status: Offline
Posts: 2192
Posted: 10 July 2018 at 12:52pm | IP Logged Quote MicroBlocks

Grogster wrote:

The formula for DayOfWeek came from someone here on the forums, and I think they got it from the net. I understand it is a reasonably well known formula for calculating the day of the week.

Yep, that would have been me. :)

Used that for so many years even back in the GWBasic days.

I know I got it from somewhere (was not the internet at that time!) :)

I made it a bit smaller, and more obscure I think, to fit in a tiny function that can be included when needed.


__________________
Microblocks. Build with logic.
Back to Top View MicroBlocks's Profile Search for other posts by MicroBlocks
 
Grogster
Guru
Guru
Avatar

Joined: 31 December 2012
Location: New Zealand
Online Status: Offline
Posts: 6227
Posted: 10 July 2018 at 12:55pm | IP Logged Quote Grogster



__________________
Smoke makes things work. When the smoke gets out, it stops!
Back to Top View Grogster's Profile Search for other posts by Grogster Visit Grogster's Homepage
 
TassyJim
Guru
Guru
Avatar

Joined: 07 August 2011
Location: Australia
Online Status: Offline
Posts: 2711
Posted: 10 July 2018 at 1:01pm | IP Logged Quote TassyJim

This is a SUB I have used in the past.
It was before Integers were available and includes the Microsoft Excel 'days since 1900'. You can remove or just ignore that line.
Quote:
'given day, month, year
'dayz=days since 1/1/1900 - agrees with Excel after 1/3/1900
SUB toMSday (d, m, y, dayz, dayofyear)
dayofyear= d+
INT((m-1)*30.57+0.5)
IF m>2 THEN
dayofyear= dayofyear-
1
IF (y MOD 4)>0 THEN dayofyear= dayofyear-1
IF (y MOD 100)=0 THEN dayofyear= dayofyear-1
IF (y MOD 400)=0 THEN dayofyear= dayofyear+1
ENDIF
dayz=
INT((y-1900)*365.25-0.25)+dayofyear+1
END SUB


I did a quick check and it seems to agree with your code.

Jim


__________________
It all started with the ZX81....
VK7JH
http://www.c-com.com.au/MMedit.htm
Back to Top View TassyJim's Profile Search for other posts by TassyJim Visit TassyJim's Homepage
 
greybeard
Senior Member
Senior Member


Joined: 04 January 2010
Location: Australia
Online Status: Offline
Posts: 119
Posted: 10 July 2018 at 1:58pm | IP Logged Quote greybeard

Probably a bit simple

function DayOfWeek(year, month, day)
DayOfWeek = Today
end Function
Back to Top View greybeard's Profile Search for other posts by greybeard Visit greybeard's Homepage
 
Paul_L
Guru
Guru


Joined: 03 March 2016
Location: United States
Online Status: Offline
Posts: 426
Posted: 10 July 2018 at 2:32pm | IP Logged Quote Paul_L

@TassyJim - thanks, that's a nice one.

The rest of youse guys, DofY should return an integer from 1 to 366, never "Monday".

Paul in NY
Back to Top View Paul_L's Profile Search for other posts by Paul_L
 
rave
Newbie
Newbie


Joined: 24 February 2018
Location: United States
Online Status: Offline
Posts: 28
Posted: 12 July 2018 at 9:10am | IP Logged Quote rave

Paul_L wrote:
@TassyJim - thanks, that's a nice one.

The rest of youse guys, DofY should return an integer from 1 to 366, never "Monday".

Paul in NY


True. The following two simple functions do the trick (this is all very standard stuff and published elsewhere):

' return days since 01-01-0001 without Julian calendar correction
Function Days(d, m, y)
  Local a
  a = Int((14-m)/12)
  m = m+12*a
  y = y-a
  Days = 365*y+Int(y/4)-Int(y/100)+Int(y/400)+Int((153*m-457)/5)+d-306
End Function

' return the weekday of the given date
Function WeekDay$(d, m, y)
  Local a,w$
  a = 7*(Days(d, m, y) Mod 7)+1
  w$ = "Sun    Mon    Tues   Wednes Thurs  Fri    Satur "
  WeekDay$ = Mid$(w$,a,Instr(a,w$," ")-a)+"day"
End Function


I shamelessly optimized string storage requirements, in the second function, sacrificing its readability

- Rob
Back to Top View rave's Profile Search for other posts by rave
 
Paul_L
Guru
Guru


Joined: 03 March 2016
Location: United States
Online Status: Offline
Posts: 426
Posted: 12 July 2018 at 1:10pm | IP Logged Quote Paul_L

Hi Rob, it's good to see you drop in here.

That's a nice way to optimize string storage in that second function, but I'm not sure it works in MMBasic. I believe that Geoff had to compromise and allocate 256 bytes for any string so using an array might work better but even then it might have 256 bytes reserved.

option base 1
' return days since 01-01-0001 without Julian calendar correction
Function Days(d, m, y)
  Local a
  a = Int((14-m)/12)
  m = m+12*a
  y = y-a
  Days = 365*y+Int(y/4)-Int(y/100)+Int(y/400)+Int((153*m-457)/5)+d-306
End Function

' return the weekday of the given date
Function WeekDay$(d, m, y)
  Local a,w$(7) length 6 =("Sun","Mon","Tues","Wednes","Thurs","Fri","Satur")
  ' the entire w$() array might still use 256 bytes instead of 49 bytes
  a = 7*(Days(d, m, y) Mod 7)+1
  WeekDay$ = w$(a)+"day"
End Function

While we're at it, do you see any way to optimize this further?

  Dim d%,m%,y%,day$="dd-mm-yyyy",DOY%
  d%=11:m%=2:y%=1940:DOY%=DofY%():print DOY%,
  day$="11-02-1940":DOY%=DofYs%(day$):print DOY%,
  DOY%=DofYs%(DATE$):print DOY%,
END
  
function DofYs%(d$) ' return dayofyear% given DATE$() or "dd-mm-yyyy"
  d%=Val(Mid$(d$,1,2)):m%=Val(Mid$(d$,4,2)):y%=Val(Mid$(d$,7,4)):DofYs%=DofY%()
End function 'DofYs%(d$) ' return dayofyear% given DATE$() or "dd-mm-yyyy"

Function DofY%() ' return dayofyear% given globals d%, m%, y%
  DofY%= d% + Int((m%-1)*30.57+0.5)
  If m%>2 Then
    DofY%=DofY%-1
    If (y% Mod 4)>0 Then DofY%= DofY%-1 'not leap year
    If (y% Mod 100)=0 Then DofY%= DofY%-1 'not leap century
    If (y% Mod 400)=0 Then DofY%= DofY%+1 'leap 4th century
  EndIf
End Function 'DofY%() ' return dayofyear% given globals d%, m%, y%

Paul in NY
Back to Top View Paul_L's Profile Search for other posts by Paul_L
 
TassyJim
Guru
Guru
Avatar

Joined: 07 August 2011
Location: Australia
Online Status: Offline
Posts: 2711
Posted: 12 July 2018 at 2:49pm | IP Logged Quote TassyJim

Paul_L wrote:
Hi Rob, it's good to see you drop in here.

That's a nice way to optimize string storage in that second function, but I'm not sure it works in MMBasic. I believe that Geoff had to compromise and allocate 256 bytes for any string so using an array might work better but even then it might have 256 bytes reserved.

Either way works.
I often use Rob's method.

Jim

__________________
It all started with the ZX81....
VK7JH
http://www.c-com.com.au/MMedit.htm
Back to Top View TassyJim's Profile Search for other posts by TassyJim Visit TassyJim's Homepage
 
rave
Newbie
Newbie


Joined: 24 February 2018
Location: United States
Online Status: Offline
Posts: 28
Posted: 13 July 2018 at 3:03am | IP Logged Quote rave

Hi Paul,

Paul_L wrote:
That's a nice way to optimize string storage in that second function, but I'm not sure it works in MMBasic.
[...]
option base 1
' return the weekday of the given date
Function WeekDay$(d, m, y)
  Local a,w$(7) length 6 =("Sun","Mon","Tues","Wednes","Thurs","Fri","Satur")
  ' the entire w$() array might still use 256 bytes instead of 49 bytes
  a = 7*(Days(d, m, y) Mod 7)+1
  WeekDay$ = w$(a)+"day"
End Function


I like your suggestion to use the inline array!! Unfortunately, MMBASIC V4.5 runs on the Colour MaxiMite that I'm using and does not support this.

Paul_L wrote:

While we're at it, do you see any way to optimize this further?

[...]
Function DofY%() ' return dayofyear% given globals d%, m%, y%
  DofY%= d% + Int((m%-1)*30.57+0.5)
  If m%>2 Then
    DofY%=DofY%-1
    If (y% Mod 4)>0 Then DofY%= DofY%-1 'not leap year
    If (y% Mod 100)=0 Then DofY%= DofY%-1 'not leap century
    If (y% Mod 400)=0 Then DofY%= DofY%+1 'leap 4th century
  EndIf
End Function 'DofY%() ' return dayofyear% given globals d%, m%, y%


Sure, I'd reckon that your DofY%() function can be simplified to:
Function DofY%()
  Local mm%,yy%,a%
  a% = Int((14-m%)/12)
  mm% = m%+12*a%
  yy% = y%-a%
  DofY% = 365*yy%+Int(yy%/4)-Int(yy%/100)+Int(yy%/400)+Int((153*mm%-457)/5)+d%-306
End Function

PS. Note that the Days() function in my earlier example changes the arguments m and y when passed as variables to the function, which in general we want to avoid by using locals mm% and yy% such as in the code above.

- Rob
Back to Top View rave's Profile Search for other posts by rave
 
lew247
Guru
Guru
Avatar

Joined: 23 December 2015
Location: United Kingdom
Online Status: Offline
Posts: 972
Posted: 09 September 2018 at 5:53pm | IP Logged Quote lew247

I'm still having problems with the day of the week function

It keeps saying the day is Sat

Can anyone see any problems with this code?
I'm using a PICROMITE - the code should be identical to any other version of the MM though


DOW$(0)="Sun":DOW$(1)="Mon":DOW$(2)="Tue":DOW$(3)="Wed":DOW$(4)="Thu":DOW$(5)="Fri":DOW$(6)="Sat"
Year=Val(Mid$(Date$,7,4)):Month=Val(Mid$(Date$,4,2)):Day=Val(Mid$(Date$,1,2))
dowx1$=DOW$(DayOfWeek(YEAR,MONTH,DAY))
do
print DOW$(DayOfWeek(YEAR,MONTH,DAY))
pause 2000
print DOW$(DayOfWeek(YEAR,MONTH,DAY)) @print 2nd time to see if it changes the day after a pause
end
function DayOfWeek(year, month, day)
print year 'to check if it's correct
print month 'to check if it's correct
print day 'to check if it's correct
local a,m,y
  a = int((14-month)/12)
  m = month + 12*a - 2
  y = year - a
  DayOfWeek = (day + y + int(y/4)-int(y/100)+int(y/400)+int(31*m/12)) mod 7
end function
Back to Top View lew247's Profile Search for other posts by lew247
 


Page of 2 Next >>
In the news...
 
Post ReplyPost New Topic
Printable version Printable version
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot delete your posts in this forum
You cannot edit your posts in this forum
You cannot create polls in this forum
You cannot vote in polls in this forum

Powered by Web Wiz Forums version 7.8
Copyright ©2001-2004 Web Wiz Guide

This page was generated in 0.1406 seconds.
Privacy Policy     Process times : 0, 0, 0, 0.14