Qbasicnews.com
August 26, 2019, 12:06:07 AM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: 1 [2]
  Print  
Author Topic: Challenge: Compute the number of Tuesdays since a given date  (Read 7631 times)
Moneo
Na_th_an
*****
Posts: 1971


« Reply #15 on: June 13, 2004, 09:02:18 PM »

Xhantt,

I looked up the FIX command. For positive numbers it's the same as using an INT. For negative numbers it truncates the decimals, whereas INT will truncate but increment the whole number part by one.

However, your code still has a problem. Your statement:

PRINT "Han pasado "; FIX(dias / 7); " jueves"

will print the truncated number of weeks between the two dates. The number of weeks is not necessarily the number of Tuesdays or Thurdays that transpired, because the first date could have started on a Tuesday and the end date could end on a Wednesday which means that you have 2 extra Tuesdays in the count.

You need to add a little routine that computes the day of the week for a given value which you call JulianDate#.

I suggest you do some more testing with real, small dates that can be checked manually with a calendar.
*****
Logged
Moneo
Na_th_an
*****
Posts: 1971


« Reply #16 on: June 13, 2004, 10:43:45 PM »

Ok guys, here's my solution. I used a bunch of date handling routines that I already had. The actual Tuesday logic is a small FOR loop that's very simple. A more clever algorithm might be used, but why spend the energy.

You run the program with a command-line parameter of the "from" date you want in the format YYYYMMDD.
Try it out.
*****
Code:

REM *** Program to count number of Tuesdays from input date to today-1.***
DEFINT A-Z

DECLARE FUNCTION IsLeapYear% (Z)  

DIM YEAR.MIN     AS INTEGER  'Minimum valid year for dates (default=0)
DIM DATE.FACTOR  AS SINGLE   'Number of days given date is from day zero.
DIM WEEK.DAY     AS INTEGER  'Day of week value: 1=Sunday....7=Saturday.
DIM WEEK.NUM     AS INTEGER  'Week number within year (1 to 54).
DIM JULIAN.DAY   AS INTEGER  'Day  number within year (1 to 366).
DIM DATE.OK      AS INTEGER  'Valid date indicator: -1=True, 0=False.
Z$               =  ""       'Date string as YYYYMMDD.
DIM ZYY          AS INTEGER  'Value of the 4 digit year.
DIM ZMM          AS INTEGER  'Value of the 2 digit month.
DIM ZDD          AS INTEGER  'Value of the 2 digit day.
DIM ZDWORK       AS LONG     'Variable    internal to date routines.
DIM ZFSAVE       AS SINGLE   'Variable    internal to date routines.
DIM ZFSAVE2      AS SINGLE   'Variable    internal to date routines.
ZTEMP$           =  ""       'Work string internal to date routines.

'NOTE: The following variable ZMO() is internal to date routines.

DIM ZMO(1 TO 12) AS INTEGER
DATA 31,28,31,30,31,30,31,31,30,31,30,31
FOR ZMM=1 TO 12:READ ZMO(ZMM):NEXT

dim factor1 as single
dim factor2 as single
dim dtfact as single
dim tcount as long

REM *** MAIN LINE *************************************************************

param1$ = ltrim$(rtrim$(command$))  'input date (from)
gosub date.today:param2$=z$

print param1$
print param2$

z$=Param1$
gosub date.factor
factor1=date.factor
if not(date.ok) then print "Invalid input date, must be YYYYMMDD":system
if param1$ >= param2$ then print "Input date >= today, nothing to do":system

z$=Param2$
gosub date.factor
factor2=date.factor

for dtfact=factor1 to factor2-1
    date.factor=dtfact
    gosub compute.weekday
    if week.day=3 then tcount=tcount+1  'count Tuesdays (3)
next dtfact

print:print "Number of Tuesdays between ";param1$;" and today is ";tcount

SYSTEM

REM ************************  DATE.FACTOR  ************************************
REM *
REM *** PRINCIPAL DATE SUBROUTINE:
REM *   =========================
REM *   - Validate input date string.
REM *   - Compute number of days (date.factor) from year 0, month 0, day 0.
REM *   - Compute day of week.
REM *   - Compute week number.
REM *   - Compute "julian" day of year.
REM *
REM *  INPUT:
REM *  =====
REM *  Z$         = Date string formatted as YYYYMMDD.
REM *  YEAR.MIN   = Minimum year user wishes to allow (default 0)
REM *
REM * OUTPUT:
REM * ======
REM * DATE.OK       = -1 if input date VALID.   (true)
REM *               =  0 if Input date INVALID. (false)                    
REM * NOTE: IF VALID,   THE FOLLOWING VARIABLES AR BASED ON INPUT DATE.
REM *       IF INVALID, THE VALUES MAY HAVE CHANGED AND ARE MEANINGLESS.
REM * DATE.FACTOR   = Number of cumulative days from year/month/day 0.
REM * WEEK.DAY      = 1 to   7 is Sunday to Saturday respectively.  
REM * WEEK.NUM      = 1 TO  54 is week number within year.            
REM * JULIAN.DAY    = 1 TO 366 is day  number within year.            
REM * ZYY           = Value of of 4 digit year.        
REM * ZMM           = Value of month.                    
REM * ZDD           = Value of day.                                
REM * EASTERSUNDAY$ = Date of Easter for given year.                
REM * Z$            = (unchanged).
REM * YEAR.MIN      = (unchanged).
REM *
REM *
REM * Date factor logic adopted from a Texas Instruments calculator manual.
REM *
DATE.FACTOR:
  gosub Date.Check                     'check input date
  if not(date.ok) then RETURN          'exit if invalid
 
  zmm=1:zdd=1                          'set to January 1st
  gosub Compute.Factor                 'compute factor of Jan 1st
  zfsave=date.factor                   'save factor   of Jan 1st
  gosub Compute.Weekday                'week.day now has day of week of Jan 1st

  zdd=val(right$(z$,2))                'Restore input date's day + month  
  zmm=val(mid$(z$,5,2))  
  gosub Compute.Factor                 'compute factor of input date

  '* Julian day is input date minus Jan 1st of same year +1
  julian.day=date.factor-zfsave+1  

  '* Compute the week number: (week.day-1 is week day of Jan 1st relative to 0)
  week.num=int((julian.day+(week.day-1)-1)/7)+1

  '* Compute the day of the week of input date:
  gosub Compute.Weekday
RETURN

COMPUTE.FACTOR:
  DATE.FACTOR=365!*ZYY+ZDD+31*(ZMM-1)  'NOTE: WON'T WORK WITHOUT ! AFTER 365.
  IF ZMM<3 THEN
     DATE.FACTOR=DATE.FACTOR+INT((ZYY-1)/4)-INT(3/4*(INT((ZYY-1)/100)+1))
  ELSE
     DATE.FACTOR=DATE.FACTOR-INT(.4*ZMM+2.3)+INT(ZYY/4)-INT(3/4*(INT(ZYY/100)+1))
  END IF
RETURN

COMPUTE.WEEKDAY:
  '* Compute the day of the week:
  WEEK.DAY=DATE.FACTOR-INT(DATE.FACTOR/7)*7    'Modulo 7.
  IF WEEK.DAY=0 THEN WEEK.DAY=7                'WEEK.DAY=1=Sunday.
RETURN
REM ******************  DATE.TODAY  *******************************************
REM *
REM *** SUBROUTINE TO GET TODAY'S DATE AND FORMAT AS YYYYMMDD.
REM *
REM *  INPUT: (None)
REM *
REM * OUTPUT: Z$ = Today's date, string as YYYYMMDD.
REM *
DATE.TODAY:
  z$=date$                                'Date is mm-dd-yyyy
  if left$(time$,2)="00" then z$=date$    'make sure date didn't just roll over
  Z$=right$(z$,4)+left$(z$,2)+mid$(z$,4,2)        'in YYYYMMDD format
RETURN
REM *********************  DATE.CHECK  ****************************************
REM *
REM *** VALIDATE A DATE IN YYYYMMDD FORMAT.
REM *
REM *  INPUT: Z$       = Given date in format YYYYMMDD.
REM *         YEAR.MIN = Minimum valid year allowed. (default=0)
REM *
REM * OUTPUT: DATE.OK = -1 if input date is VALID.   (true)
REM *                    0 if input date is INVALID. (false)                    
REM *         (if VALID):
REM *         ZYY      = Value of 4 digit year.        
REM *         ZMM      = Value of month.                              
REM *         ZDD      = Value of day.                                
REM *
REM *
DATE.CHECK:
  DATE.OK = 0      'preset to false
  ZTEMP$="1"+Z$+"1"
  IF LEN(Z$)<>8 OR MID$(STR$(VAL(ZTEMP$)),2)<>ZTEMP$ THEN RETURN
  ZDD=VAL(RIGHT$(Z$,2))                'Set day                
  ZMM=VAL(MID$(Z$,5,2))                'Set month.
  ZYY=VAL(LEFT$(Z$,4))                 'Set year.
  IF ZMM<1 OR ZMM>12 OR ZDD<1 OR ZDD>31 OR ZYY<YEAR.MIN THEN RETURN
  IF ZMO(ZMM)+1*(-(ZMM=2 AND ISLEAPYEAR(ZYY))) < ZDD THEN RETURN
  '   If expression (month=2 and is leapyear) is TRUE which is -1, then
  '   taking the negative of this issues a plus 1. Conversely, the FALSE    
  '   always gives a zero. Multiplying the +1 by this result of 1 or 0
  '   will either add 1 or not to the number of days in the month.
  '   The routine wants to add 1 only when it is February and leap year.
  DATE.OK = -1        '-1=valid (true)
RETURN      
REM ***************************************************************************

END

' ====================== ISLEAPYEAR ==========================
'         Determines if a year is a leap year or not.
' ============================================================
'
FUNCTION IsLeapYear (Z) STATIC

   ' If the year is evenly divisible by 4 and not divisible
   ' by 100, or if the year is evenly divisible by 400, then
   ' it's a leap year:
   IsLeapYear = (Z MOD 4 = 0 AND Z MOD 100 <> 0) OR (Z MOD 400 = 0)
END FUNCTION
Logged
xhantt
Member
*
Posts: 90



« Reply #17 on: June 15, 2004, 02:32:58 PM »

Last code. I fix the 'fix' problem and count the last tuesday :-)
Code:

FUNCTION JulianDate# (y%, m%, d%, ut%)
  DIM a, b, c
  a = INT(7# * (y% + INT((m% + 9#) / 12#)) / 4#)
  b = INT(3# * (INT((y% + (m% - 9#) / 7#) / 100#) + 1#) / 4#)
  c = INT(275 * m% / 9#) + d% + 1721028.5# + ut% / 24#
  JulianDate# = 367# * y% - a - b + c
END FUNCTION

'Tuesdays elapsed between y1-m1-d1 and y2-m2-d2, including y1-m1-d1
' but not including y2-m2-d2
FUNCTION TuesdaysElapsed# (y1%, m1%, d1%, y2%, m2%, d2%)
  DIM j1, j2, j3 AS DOUBLE
  DIM WE AS DOUBLE
  DIM TE AS DOUBLE
  j1 = JulianDate#(y1%, m1%, d1%, 0)
  j2 = JulianDate#(y2%, m2%, d2%, 0)
  'Weeks elapsed
  WE = INT((j2 - j1) / 7)
  'for each complete week there's one tuesday
  TE = WE
  'next tuesday not counted
  j3 = j1 + WE * 7 + (7 - (INT(j1) MOD 7)) MOD 7
  'if next tuesdays is before y2-m2-d2 count it
  IF j3 < j2 THEN TE = TE + 1
  TuesdaysElapsed# = TE
END FUNCTION
Logged
Moneo
Na_th_an
*****
Posts: 1971


« Reply #18 on: June 17, 2004, 12:17:04 AM »

Xhantt,

Looks much better. Give me a few days to test it out.
*****
Logged
Moneo
Na_th_an
*****
Posts: 1971


« Reply #19 on: June 20, 2004, 08:01:36 PM »

Xhantt,

I inserted your functions into a test program and they run fine. I ran some parallel tests with my solution and the results were the same.

So, congratulations, you are the winner!
*****
Logged
Neo
Na_th_an
*****
Posts: 2150



« Reply #20 on: June 21, 2004, 09:08:44 AM »

Hrmm, I couldn't post this very simple solution of mine earlier, but here it is still:

Code:
' =================================================
' Day Counter
'
' By Neo Deus Ex Machina
' Simplest form I could make up ... ;)
'
' Saturday 19th of June 2004
' =================================================

DECLARE SUB InitData ()
DECLARE SUB GetInput ()
DECLARE SUB Calculate ()

DEFINT A-Z
'$DYNAMIC

DIM SHARED DaysPerMonth(1 TO 12) AS INTEGER
DIM SHARED MonthsName(1 TO 12) AS STRING
DIM SHARED DaysName(1 TO 7) AS STRING

DIM SHARED TodayDay AS INTEGER
DIM SHARED TodayMonth AS INTEGER
DIM SHARED TodayYear AS INTEGER
DIM SHARED NowIndex AS INTEGER
DIM SHARED NowDay AS INTEGER
DIM SHARED NowMonth AS INTEGER
DIM SHARED NowYear AS INTEGER
DIM SHARED NumReqDays AS LONG
DIM SHARED DayCount AS INTEGER

'NOTE:
' 1-1-1900 was a Sunday (backtracked)

InitData
GetInput
Calculate

PRINT
SYSTEM

SUB Calculate
NowDay = 1
NowMonth = 1
NowYear = 1900
NowIndex = 7
NumReqDays = 0

IF INT(NowYear / 4) * 4 = NowYear THEN DaysPerMonth(2) = 29 ELSE DaysPerMonth(2) = 28
IF NowIndex = DayCount THEN NumReqDays = NumReqDays + 1
DO UNTIL NowDay >= TodayDay AND NowMonth >= TodayMonth AND NowYear >= TodayYear
                NowDay = NowDay + 1

                IF NowDay > DaysPerMonth(NowMonth) THEN
                NowDay = 1
                NowMonth = NowMonth + 1
                IF NowMonth > 12 THEN
                NowMonth = 1
                NowYear = NowYear + 1
                IF INT(NowYear / 4) * 4 = NowYear THEN DaysPerMonth(2) = 29 ELSE DaysPerMonth(2) = 28
                END IF
                END IF

                NowIndex = NowIndex + 1
                IF NowIndex > 7 THEN NowIndex = 1

                IF NowIndex = DayCount THEN NumReqDays = NumReqDays + 1
LOOP

CLS
BackPrint$ = ""
IF NowDay MOD 10 = 1 THEN
BackPrint$ = "st"
ELSEIF NowDay MOD 10 = 2 THEN
BackPrint$ = "nd"
ELSEIF NowDay MOD 10 = 3 THEN
BackPrint$ = "rd"
ELSE
BackPrint$ = "th"
END IF
PRINT NumReqDays; DaysName(DayCount) + "s had passed since Sunday 1st of January 1900 up to"
PRINT " and including "; DaysName(NowIndex); STR$(NowDay) + BackPrint$ + " of "; MonthsName(NowMonth); NowYear
END SUB

SUB InitData
DaysPerMonth(1) = 31
DaysPerMonth(2) = 28
DaysPerMonth(3) = 31
DaysPerMonth(4) = 30
DaysPerMonth(5) = 31
DaysPerMonth(6) = 30
DaysPerMonth(7) = 31
DaysPerMonth(8) = 31
DaysPerMonth(9) = 30
DaysPerMonth(10) = 31
DaysPerMonth(11) = 30
DaysPerMonth(12) = 31

MonthsName(1) = "January"
MonthsName(2) = "February"
MonthsName(3) = "March"
MonthsName(4) = "April"
MonthsName(5) = "May"
MonthsName(6) = "June"
MonthsName(7) = "July"
MonthsName(8) = "August"
MonthsName(9) = "September"
MonthsName(10) = "October"
MonthsName(11) = "November"
MonthsName(12) = "December"

DaysName(1) = "Monday"
DaysName(2) = "Tuesday"
DaysName(3) = "Wednesday"
DaysName(4) = "Thursday"
DaysName(5) = "Friday"
DaysName(6) = "Saturday"
DaysName(7) = "Sunday"
END SUB

SUB GetInput
PRINT "This program can give the number of specific days passed up to a given date"
PRINT
DO
PRINT "Enter the year (>= 1900 and <= 32000):"
INPUT "", TYEAR$
LOOP UNTIL VAL(TYEAR$) >= 1900 AND VAL(TYEAR$) <= 32000
PRINT
DO
PRINT "Enter the month (>= 1 and <= 12):"
INPUT "", TMONTH$
LOOP UNTIL VAL(TMONTH$) >= 1 AND VAL(TMONTH$) <= 12
PRINT
DO
PRINT "Enter the day (>= 1 and <= 31 and existing):"
INPUT "", TDAY$
LOOP UNTIL VAL(TDAY$) >= 1 AND VAL(TDAY$) <= 31
PRINT
DO
EXIST = 0

PRINT "Enter the name of the day to count (e.g. tuesday) in English:"
INPUT "", DAY$

FOR I = 1 TO 7
IF LCASE$(LTRIM$(RTRIM$(DAY$))) = LCASE$(LTRIM$(RTRIM$(DaysName(I)))) THEN EXIST = I
NEXT I
LOOP UNTIL EXIST > 0

TodayDay = VAL(TDAY$)
TodayMonth = VAL(TMONTH$)
TodayYear = VAL(TYEAR$)
DayCount = EXIST
END SUB
Logged
Moneo
Na_th_an
*****
Posts: 1971


« Reply #21 on: June 22, 2004, 10:59:49 PM »

Neo, looks interesting. Give me a few days to test it out.

Two comments:
(1)
' 1-1-1900 was a Sunday (backtracked)
NO, IT WAS A MONDAY.

(2) IF INT(NowYear / 4) * 4
THIS IS NOT A VERY GOOD WAY TO CHECK FOR LEAP YEAR. FOR EXAMPLE, THIS CODE WOULD CONSIDER 1900 AS A LEAP YEAR, WHICH IT WAS NOT. SEE TH╦ "ISLEAPYEAR" FUNCTION AND COMMENTS AT THE END OF MY POSTED SOLUTION ABOVE.
*****
Logged
Neo
Na_th_an
*****
Posts: 2150



« Reply #22 on: June 23, 2004, 08:54:20 AM »

Quote from: "Moneo"
(1)
' 1-1-1900 was a Sunday (backtracked)
NO, IT WAS A MONDAY.

This is caused by my explaination at comment (2).

Quote from: "Moneo"
(2) IF INT(NowYear / 4) * 4
THIS IS NOT A VERY GOOD WAY TO CHECK FOR LEAP YEAR. FOR EXAMPLE, THIS CODE WOULD CONSIDER 1900 AS A LEAP YEAR, WHICH IT WAS NOT. SEE TH╦ "ISLEAPYEAR" FUNCTION AND COMMENTS AT THE END OF MY POSTED SOLUTION ABOVE.
*****

Hrmm, I thought every year, multiplier of 4 was a leap year. (read your IsLeapYear)... hrmmm... ok right. So 1900 was not... that means 1-1-1900 wasn't a Sunday but a Monday indeed (counted 1 day extra: 29-2-1900). To solve this problem, do this:

Replace:
Code:
IF INT(NowYear / 4) * 4 = NowYear THEN DaysPerMonth(2) = 29 ELSE DaysPerMonth(2) = 28

by:
Code:
IF (NowYear MOD 4 = 0 AND NowYear MOD 100 <> 0) OR (NowYear MOD 400 = 0) THEN DaysPerMonth(2) = 29 ELSE DaysPerMonth(2) = 28

(didn't even know this but I learnt from your function Wink)
Logged
Moneo
Na_th_an
*****
Posts: 1971


« Reply #23 on: June 27, 2004, 12:57:52 AM »

Neo,

Actually I found the rule in my Webster's dictionary under leap year. If a year is a multiple of 100, although it as a multiple of 4, in order to be a leap year it has to be a multiple of 400. Example: the year 2100 will not be a leap year either.

Recently, I saw a new rule added to leap year. I'm not sure exactly but it has to do with being a multiple of 4000. A little too far in the future for me yet, so I haven't bothered to implement it into my leap year algorithm.

BTW, my main computer is down so I haven't had a chance to test your posted solution. I'm writing this from my daughter's machine which does not have any of my QB stuff. Give me a few more days.
*****
Logged
Moneo
Na_th_an
*****
Posts: 1971


« Reply #24 on: June 28, 2004, 11:29:09 PM »

Ok Neo, tried your routine and discovered that you got the specifications mixed up.
The original specs said: Starting from a given date, no earlier than 1/1/1900, compute the number of Tuesdays that have transpired up to but not including today.

The specs that you programmed are: Compute the number of Tuesdays from 1/1/1900 up to and including an input date.

Close, but an entirely different idea. Anyway, you'll be happy to know that it computed 5452 Tuesdays from 1/1/1900 to today 6/28/2004 --- which is correct.

So, except for the leap year error, your other date computations seem to be working pretty good.

Try fixing the program to use the original specs. I'd like to see how it performs then.
*****
Logged
Pages: 1 [2]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!