FAST calendar RETURN DATE calculator

(Sample Scripts and Snippets)

FAST calendar RETURN DATE calculator

Unread postby GSAC3000 » Fri Oct 09, 2015 7:03 pm

Here is a simple program I wrote several years ago, in two other BASIC dialects, to determine the future return dates for a specific weekday, month, and month day (e.g. Friday, 13 November 2015).

Don

WATCH OUT FOR LINE WRAP

Code: Select all
' RETURN_DATES.fbs
'
' RETURN_DATES finds all occurrences of a specific target WEEK-DAY/MONTH-DAY/MONTH return.
' For example, it will quickly find all future occurrences of Friday 29 February given
' any specific Friday 29 February occurrence, e.g. Friday 29 February 2008.
'
' The code exploits the periodic character of successive calendar "return" dates.
' All dates, except 29 February, repeat on the same weekday either every 5, 6, 7, 11, or 12 years.
' The 29th of February repeats on the same weekday either every 12, 28, or 40 years.
'
' Written by GSAC3 (19 May 2009) and originally coded in THINBASIC and BCX.
' RETURN_DATES was re-coded in FBSL 0n 8 October 2015.
'
#include <Include\Windows.inc>
#Option Strict
#apptype CONSOLE
'
DIM $OUT_BUFFER, $MS, $WKDY[7], $MONTHS[12], $OCYCL[7]
DIM %Z, $OUT_HANDLE, %YEARend, %COUNT, %WD, %FIRSTwd
DIM %FIRSTmd, %FIRSTyr, %FIRSTmo, %JD, %JDend, %YL, %L
DIM %YR, %I1, %I2, !!START, !!FINISH, !!EXE_TIME
'
OCYCL   = {5,6,7,11,12,28,40}
MONTHS  = {"Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"}
WKDY    = {"Mon","Tue","Wed","Thu","Fri","Sat","Sun"}
'
PRINT "FAST RETURN DATE FINDER"
PRINT "-----------------------"
'
'  INPUT AND CHECK VALIDITY OF INPUT DATA
'
:L1
FIRSTmo = VAL(InputBox ("Beginning MONTH # (1-12) ?", "Input: ", ""))
IF (FIRSTmo < 1) or (FIRSTmo > 12) THEN
   GOTO L1
END IF
:L2
FIRSTmd = VAL(InputBox ("Begining MONTH DAY # (1-31) ?", "Input: ", ""))
IF (FIRSTmd < 1) or ((FIRSTmd > 29) and (FIRSTmo = 2)) or (FIRSTmd > 31) THEN
   GOTO L2
END IF
:L3
FIRSTyr = VAL(InputBox ("Beginning YEAR ?", "Input: ", ""))
IF (FIRSTyr < 0) THEN
   GOTO L3
END IF
'
JD      = JDate(FIRSTmo,FIRSTmd,FIRSTyr)     'STARTING Julian Date
FIRSTwd = (JD MOD 7)+1
'
I1 = 1
I2 = 5
IF (FIRSTmo = 2 AND FIRSTmd = 29) THEN
   I1 = 5
   I2 = 7
END IF
'
YEARend  =  VAL(InputBox ("Final YEAR ?", "Input: ", ""))
'   
MS = MONTHS[FIRSTmo]
'
JDend = JDate(FIRSTmo,FIRSTmd,YEARend)  'ENDING Julian Date
OUT_BUFFER = WKDY[FIRSTwd-1] &" "& MONTHS[FIRSTmo-1] &" "& FIRSTmd & ", " & FIRSTyr & $CRLF
PRINT "STARTING DATE: ",OUT_BUFFER
PRINT "RETURN DATES:"
PRINT " "
COUNT=0
'
'   BEGIN SEARCH FOR RETURN DATES
'
START = GetTickCount()
'
YR = FIRSTyr
DO WHILE (JD < JDend)
  FOR L = I1 TO I2
      YL = YR + OCYCL[L-1]
      JD = JDate(FIRSTmo,FIRSTmd,YL)
      WD = (JD MOD 7)+1
      IF (WD = FIRSTwd  AND JD <= JDend) THEN
         COUNT = COUNT + 1
         OUT_BUFFER = WKDY[FIRSTwd-1] &" "& MONTHS[FIRSTmo-1] &" "& FIRSTmd & ", " & YL '& $CRLF
         PRINT COUNT,"   ",OUT_BUFFER
         YR=YL
         EXIT FOR
      END IF
  NEXT L
'     
LOOP
'
FINISH = GetTickCount()
EXE_TIME = FINISH - START
PRINT " "
PRINT "TOTAL NUMBER OF RETURN DATES BETWEEN " & FIRSTyr & " AND " & YEARend & " = " & COUNT
PRINT " "
PRINT "Total execution time was ", EXE_TIME, " msec"
PAUSE
'
'
FUNCTION %JDate ( %Month, %Day, %Year)
'***********************************
' Returns the Julian Date
'***********************************
DIM %JM, %J, %JDay
JM=12*(Year+4800)+Month-3
J=(2*(JM MOD 12)+7+365*JM)\12
JDay=J+Day+(JM\48)-32083
IF(JDay <= 2299171) THEN
  JDate  = JDay
ELSE   
  JDate  = JDay+(JM\4800)-(JM\1200)+38
END IF
END FUNCTION
GSAC3000
FBSL tiny seed
FBSL tiny seed
 
Posts: 15
Joined: Thu Oct 01, 2015 8:15 pm

Re: FAST calendar RETURN DATE calculator

Unread postby Mike Lobanovsky » Sat Oct 10, 2015 1:47 am

Hi Don,

Congrats on your first public submission to this site! :)

However, your code contains a few mistakes that are due to peculiarities of FBSL BASIC language as a weakly typed, Variant-based interpretative engine. Besides, your JDate() implementation seems to have some inherent flaws that yield seemingly incorrect results for certain dates in the past and thus can put this program in an endless loop.

We are very tolerant to non-FBSL code here as long as it helps us improve or debug our FBSL programs. So before we go into your FBSL script in somewhat greater detail, can you please post here a usable BCX BASIC equivalent to your FBSL script that you think would work as expected?

In the meantime, please have a look at FBSL's built-in DateConv() function. Perhaps you can find its functionality convenient to implement an alternative to your all-purpose BASIC code.
Mike
"Я старый солдат, мадам, и не знаю слов любви."
"I am an old soldier, ma'am, and I don't know the words of love."
"Je suis un vieux soldat, madame, et je ne connais pas les mots d'amour."
"Ich bin ein alter Soldat, gnädige Frau, und ich weiß nicht die Worte der Liebe."

__________________________________________________________________________________________________________________________________________________
(3.2GHz i5 Core Quad, 8GB RAM / 2 x nVidia GTX 550Ti SLI-bridged, 2GB VRAM)
(x86 Win XP Pro Russian Sp3/x86 Win Vista Ultimate Sp2/x64 Win 7 Ultimate Sp1/Wine in x64 elementaryOS Luna)
User avatar
Mike Lobanovsky
FBSL Administrator
FBSL Administrator
 
Posts: 1823
Joined: Tue Apr 19, 2005 8:22 am
Location: Republic of Belarus

Re: FAST calendar RETURN DATE calculator

Unread postby GSAC3000 » Sat Oct 10, 2015 11:28 pm

Mike:

You are right, my original posted code does have several errors of omission. I have several variations of the program, and the one I converted to FBSL and posted was a conversion of a THINBASIC version which had input data range checks that I forgot to include in my FBSL version. Namely, the initial and last year applicability ranges were omitted. These ranges should both be 1900 to 3000 for this version of the program. I believe the JDATE routine is OK, but its applicability is limited when used with the periodic return years data in this program.

Are INTEGER variables in FBSL 4 bytes long?
Does FBSL have UNSIGNED INTEGER vatiables?

Don

Attached is the corrected code---

Code: Select all
' RETURN_DATES.fbs
'
' RETURN_DATES finds all occurrences of a specific target WEEK-DAY/MONTH-DAY/MONTH return.
' For example, it will quickly find all future occurrences of Friday 29 February given
' any specific Friday 29 February occurrence, e.g. Friday 29 February 2008.
'
' The code exploits the periodic character of successive calendar "return" dates.
' All dates, except 29 February, repeat on the same weekday either every 5, 6, 7, 11, or 12 years.
' The 29th of February repeats on the same weekday either every 12, 28, or 40 years.
'
' Written by GSAC3 (19 May 2009) and originally coded in THINBASIC and BCX.
' RETURN_DATES was re-coded in FBSL 0n 8 October 2015.
'
#include <Include\Windows.inc>
#Option Strict
#apptype CONSOLE
'
DIM $OUT_BUFFER, $MS, $WKDY[7], $MONTHS[12], $OCYCL[7]
DIM %Z, $OUT_HANDLE, %YEARend, %COUNT, %WD, %FIRSTwd
DIM %FIRSTmd, %FIRSTyr, %FIRSTmo, %JD, %JDend, %YL, %L
DIM %YR, %I1, %I2, !!START, !!FINISH, !!EXE_TIME
'
OCYCL   = {5,6,7,11,12,28,40}
MONTHS  = {"Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"}
WKDY    = {"Mon","Tue","Wed","Thu","Fri","Sat","Sun"}
'
PRINT "FAST RETURN DATE FINDER"
PRINT "-----------------------"
'
'  INPUT AND CHECK VALIDITY OF INPUT DATA
'
:L1
FIRSTmo = VAL(InputBox ("Beginning MONTH # (1-12) ?", "Input: ", ""))
IF (FIRSTmo < 1) or (FIRSTmo > 12) THEN
   GOTO L1
END IF
:L2
FIRSTmd = VAL(InputBox ("Begining MONTH DAY # (1-31) ?", "Input: ", ""))
IF (FIRSTmd < 1) or ((FIRSTmd > 29) and (FIRSTmo = 2)) or (FIRSTmd > 31) THEN
   GOTO L2
END IF
:L3
FIRSTyr = VAL(InputBox ("Beginning YEAR (1900-3000)?", "Input: ", ""))
IF (FIRSTyr < 1900) or (FIRSTyr > 3000) THEN
   GOTO L3
END IF
'
JD      = JDate(FIRSTmo,FIRSTmd,FIRSTyr)     'STARTING Julian Date
FIRSTwd = (JD MOD 7)+1
'
I1 = 1
I2 = 5
IF (FIRSTmo = 2 AND FIRSTmd = 29) THEN
   I1 = 5
   I2 = 7
END IF
'
:L4
YEARend  =  VAL(InputBox ("Final YEAR (1900-3000)?", "Input: ", ""))
IF (YEARend < 1900) or (YEARend > 3000) THEN
   GOTO L4
END IF
'   
MS = MONTHS[FIRSTmo]
'
JDend = JDate(FIRSTmo,FIRSTmd,YEARend)  'ENDING Julian Date
OUT_BUFFER = WKDY[FIRSTwd-1] &" "& MONTHS[FIRSTmo-1] &" "& FIRSTmd & ", " & FIRSTyr & $CRLF
PRINT "STARTING DATE: ",OUT_BUFFER
PRINT "RETURN DATES:"
PRINT " "
COUNT=0
'
'   BEGIN SEARCH FOR RETURN DATES
'
START = GetTickCount()
'
YR = FIRSTyr
DO WHILE (JD < JDend)
  FOR L = I1 TO I2
      YL = YR + OCYCL[L-1]
      JD = JDate(FIRSTmo,FIRSTmd,YL)
      WD = (JD MOD 7)+1
      IF (WD = FIRSTwd  AND JD <= JDend) THEN
         COUNT = COUNT + 1
         OUT_BUFFER = WKDY[FIRSTwd-1] &" "& MONTHS[FIRSTmo-1] &" "& FIRSTmd & ", " & YL '& $CRLF
         PRINT COUNT,"   ",OUT_BUFFER
         YR=YL
         EXIT FOR
      END IF
  NEXT L
'     
LOOP
'
FINISH = GetTickCount()
EXE_TIME = FINISH - START
PRINT " "
PRINT "TOTAL NUMBER OF RETURN DATES BETWEEN " & FIRSTyr & " AND " & YEARend & " = " & COUNT
PRINT " "
PRINT "Total execution time was ", EXE_TIME, " msec"
PAUSE
'
'
FUNCTION %JDate ( %Month, %Day, %Year)
'***********************************
' Returns the Julian Date
'***********************************
DIM %JM, %J, %JDay
JM=12*(Year+4800)+Month-3
J=(2*(JM MOD 12)+7+365*JM)\12
JDay=J+Day+(JM\48)-32083
IF(JDay <= 2299171) THEN
  JDate  = JDay
ELSE   
  JDate  = JDay+(JM\4800)-(JM\1200)+38
END IF
END FUNCTION
GSAC3000
FBSL tiny seed
FBSL tiny seed
 
Posts: 15
Joined: Thu Oct 01, 2015 8:15 pm

Re: FAST calendar RETURN DATE calculator

Unread postby Mike Lobanovsky » Sun Oct 11, 2015 3:45 am

Don,

FBSL supports three built-in interoperative languages: interpretative BASIC language, C language JIT-compiled dynamically to native machine code at app start, and Intel-style Assembler also JIT-compiled dynamically to native machine code at app start.

FBSL BASIC has only two built-in integer data types: 32-bit signed Integer proper (Long is an alias to Integer in FBSL) and 64-bit signed integer called Quad. FBSL's Dynamic C (a.k.a. DynC) is fully ANSI standard compliant and supports all simple data types and arithmetics known to C. FBSL's Dynamic Assembler (a.k.a. DynAsm) is a straight-forward no-macro assembly compiler that supports BYTE-, WORD-, DWORD-, and QWORD-sized integer and floating-point values, arith and trig.

For all practical intents and purposes, signed and unsigned BASIC Integer arithmetics would be absolutely identical except for printed output. The FBSL BASIC Print command will always print explicit numeric values as signed Integers and Quads, while its PrintF()/SPrintF() formatted output functions take after their C prototypes and would print explicit numeric values in any signed or unsigned format valid in C.

Shorter integer data types compliant with WinAPI/C library calls can be expressed as strongly-typed standalone user defined types and UDT member fields in the following notations:

Type BYTE
Default %b * 8
End Type


or

Type BYTE
Default b As Integer * 8 ' or As Long * 8
End Type


and e.g.

Type MY_CROOKED_UDT Align 1 ' ensure tight packing of bytes
b As BYTE
w As Integer * 16 ' in fact, as WORD
End Type


etc.

In order to avoid explicit, relatively slow format adjustments in arithmetics for signed/unsigned integers shorter than 32 bits in size, it is convenient to emulate them with ordinary Integers and use a SmallInt library include file presented in this forum message.

I will be busy with my family matters on Sunday so my detailed FBSL-specific review of your Fast Calendar code will come some time on Monday.

Have a nice weekend! :)
Mike
"Я старый солдат, мадам, и не знаю слов любви."
"I am an old soldier, ma'am, and I don't know the words of love."
"Je suis un vieux soldat, madame, et je ne connais pas les mots d'amour."
"Ich bin ein alter Soldat, gnädige Frau, und ich weiß nicht die Worte der Liebe."

__________________________________________________________________________________________________________________________________________________
(3.2GHz i5 Core Quad, 8GB RAM / 2 x nVidia GTX 550Ti SLI-bridged, 2GB VRAM)
(x86 Win XP Pro Russian Sp3/x86 Win Vista Ultimate Sp2/x64 Win 7 Ultimate Sp1/Wine in x64 elementaryOS Luna)
User avatar
Mike Lobanovsky
FBSL Administrator
FBSL Administrator
 
Posts: 1823
Joined: Tue Apr 19, 2005 8:22 am
Location: Republic of Belarus

Re: FAST calendar RETURN DATE calculator

Unread postby GSAC3000 » Sun Oct 11, 2015 7:05 pm

Mike:

Thanks for your reply to my questions about how FBSL interprets the use of the % prefix and AS INTEGER qualifiers for integer variables. I had assumed that these referred to LONG, not SHORT, integers but just wanted to make sure. I frequently use UNSIGNED LONG and UNSIGNED LONGLONG integer variables in some of my programs as well, so the info you provided is very helpful.

Don
GSAC3000
FBSL tiny seed
FBSL tiny seed
 
Posts: 15
Joined: Thu Oct 01, 2015 8:15 pm

Re: FAST calendar RETURN DATE calculator

Unread postby GSAC3000 » Thu Oct 15, 2015 9:14 pm

Mike:

Here is a revised (3a on 19 Oct 2015) version of my RETURN_DATES program that:

1. Uses the FBSL DateConv function instead of my previous JDATE function.
2. Corrects the applicability range of its usefulness when using DateConv.
3. Using DateConv, instead of JDATE, limits the upper year limit to only 3000,
because weekday values computed by DateConv are not always correct above year 3000.
4. Modifies and does a better job of checking user input data
5. Writes the results to the output file RETURN_DATES_3a.TXT

Don

WATCH OUT FOR LINE WRAP !


Code: Select all
' RETURN_DATES_3a.fbs
'
' RETURN_DATES finds all occurrences of a specific target WEEK-DAY/MONTH-DAY/MONTH return.
' For example, it will quickly find all future occurrences of Friday 29 February within a
' given specific range of Gregorian calendar years
'
' The code exploits the periodic character of successive calendar "return" dates.
' All dates, except 29 February, repeat on the same weekday either every 5, 6, 7, 11, or 12 years.
' The 29th of February repeats on the same weekday either every 12, 28, or 40 years.
'
' Written by GSAC3 (19 May 2009) and originally coded in THINBASIC and BCX.
' RETURN_DATES was re-coded in FBSL 0n 8 October 2015.
' FBSL version was updated on 14 October 2015 to check input data
' for Leap Year entry errors and utilize DateConv function instead
' of JDATE function. NOTE: UPPER YEAR LIMIT IS 3000 WHEN USING DateConv.
' DateConv does not always produce correct WEEKDAY numbers above year 3000!
'
#include <Include\Windows.inc>
#Option Strict
#apptype CONSOLE
'
DIM $OUT_BUFFER, $OCYCL[7], %Z, $OUT_HANDLE, $FILE_OUT, $STRT_YR, %MOMD
DIM %COUNT, %WD, %FIRSTwd, %F1, %FIRSTmd, %FIRSTyr, %FIRSTmo, %YEARend
DIM %YL, %L, %Gdate, %MO, %YR, %I1, %I2, !!START, !!FINISH, !!EXE_TIME
'
OCYCL = {5,6,7,11,12,28,40}  ' Values valid from 1590 onward
MO    = {31,29,31,30,31,30,31,31,30,31,30,31}
FILE_OUT = "RETURN_DATES_3a.TXT"
'
F1 = FileOpen( FILE_OUT, "OUTPUT" )
OUT_BUFFER =  "  FAST RETURN DATE FINDER"
PRINT OUT_BUFFER
FilePrint(F1,OUT_BUFFER)
OUT_BUFFER = "---------------------------"
PRINT OUT_BUFFER
FilePrint(F1,OUT_BUFFER)
'
'  ENTER AND CHECK VALIDITY OF INPUT DATA
'
:L0
FIRSTyr = VAL(InputBox ("Starting YEAR (1590-3000)", "Input (1590-3000): ", ""))
STRT_YR = FIRSTyr
IF (STRT_YR = 0) THEN
   GOTO ABORT
END IF
IF (FIRSTyr < 1590) or (FIRSTyr > 3000) THEN
   GOTO L0
END IF
'
:L1
FIRSTwd = VAL(InputBox ("Return WEEK DAY (1-7)", "Input   (1 = Sunday): ", ""))
IF (FIRSTwd < 1) OR (FIRSTwd > 7) THEN
   GOTO L1
END IF
'
:L2
FIRSTmo = VAL(InputBox ("Return MONTH (1-12)", "Input   (1 = January): ", ""))
IF (FIRSTmo < 1) or (FIRSTmo > 12) THEN
   GOTO L2
END IF
'
:L3
FIRSTmd = VAL(InputBox ("Return MONTH DAY (1-31)", "Input   (1-31): ", ""))
IF (FIRSTmd < 1) OR (FIRSTmd > MO[FIRSTmo-1]) THEN
   MsgBox( 0, "INPUT ERROR", "RE-ENTER MONTH DAY", MB_OK)
   GOTO L3
END IF
'
MOMD = FIRSTmo*100 + FIRSTmd
'
'  FIND INITIAL TARGET DATE AFTER STARTING DATE
'
:L4
Gdate = FIRSTyr*10000 + MOMD
IF (DateConv (Gdate,"w") <> FIRSTwd) THEN
   INCR (FIRSTyr,1)
   GOTO L4
END IF   
'
:L5
YEARend  =  VAL(InputBox ("Ending YEAR (1590-3000)", "Input (1590-3000): ", ""))
IF (YEARend =< 1590) or (YEARend > 3000) THEN
   GOTO L5
END IF
'
OUT_BUFFER = "For years from " & STRT_YR & " to " & YEARend & CRLF$
PRINT OUT_BUFFER
FilePrint(F1,OUT_BUFFER)
'
OUT_BUFFER = "RETURN DATES:" & CRLF
PRINT OUT_BUFFER
FilePrint(F1,OUT_BUFFER)
COUNT = 1
'Gdate = FIRSTyr*10000 + MOMD
OUT_BUFFER = COUNT & "   " & DateConv (Gdate,"ddd mmm d, yyyy") '& CRLF$
PRINT OUT_BUFFER
FilePrint(F1,OUT_BUFFER)
'
'   BEGIN SEARCH FOR REMAINING RETURN DATES
'
I1 = 1
I2 = 5
IF (FIRSTmo = 2 AND FIRSTmd = 29) THEN
   I1 = 5
   I2 = 7
END IF
'
START = GetTickCount()
'
YR = FIRSTyr
DO WHILE (YR < YEARend)
  FOR L = I1 TO I2
      YL = YR + OCYCL[L-1]
      IF (YL > YEARend) THEN
         GOTO FIN
      END IF
      Gdate = YL*10000 + MOMD
      WD = DateConv (Gdate,"w")
      IF (WD = FIRSTwd) AND (YL < YEARend) THEN
         INCR (COUNT,1)
         OUT_BUFFER = COUNT & "   " & DateConv (Gdate,"ddd mmm d, yyyy")
         PRINT OUT_BUFFER
         FilePrint(F1,OUT_BUFFER)
         YR=YL
         EXIT FOR
      END IF
  NEXT L
'     
LOOP
'
:FIN
FINISH = GetTickCount()
EXE_TIME = FINISH - START
OUT_BUFFER = CRLF$ & "TOTAL NUMBER OF RETURN DATES BETWEEN " & STRT_YR & " AND " & YEARend & " = " & COUNT & CRLF$
PRINT OUT_BUFFER
FilePrint(F1,OUT_BUFFER)
OUT_BUFFER = "Total execution time was " & EXE_TIME & " msec" &CRLF$
PRINT OUT_BUFFER
FilePrint(F1,OUT_BUFFER)
PRINT " Results were written to " & FILE_OUT & CRLF$
FileClose(F1)
'
PAUSE
:ABORT

GSAC3000
FBSL tiny seed
FBSL tiny seed
 
Posts: 15
Joined: Thu Oct 01, 2015 8:15 pm

Re: FAST calendar RETURN DATE calculator

Unread postby GSAC3000 » Mon Oct 19, 2015 10:15 pm

Mike:

Previous message, originally dated 15 October 2015, and enclosed code have just been revised to reflect changes and corrections due to apparent instability of DateConv function for years after 3000.

Don
GSAC3000
FBSL tiny seed
FBSL tiny seed
 
Posts: 15
Joined: Thu Oct 01, 2015 8:15 pm

Re: FAST calendar RETURN DATE calculator

Unread postby Mike Lobanovsky » Wed Oct 21, 2015 2:18 am

Hi Don,

All variants of this program submitted so far have one and the same common mistake. The FBSL expressions of type
Code: Select all
{1, 2, 3, "", strVar, numVar, "hello world"}

etc. are not just a way to denote array initialization. Those are separate entities which we call anonymous variant (i.e. typeless) arrays and which are also known in other languages as "lists" or "collections". They can contain simultaneously pieces of data of any type, from simple data types thru UDTs and class instances to external COM objects. They can be used for initialization of dynamically resizable named variant data type arrays only and only at the time such named arrays are dim'ed.

Whenever a variable declaration misses an explicit data type, it means the variable is declared As Variant (like in Visual Basic). FBSL performs all the necessary transformations of simple data type Variants automatically based on the kind of statements they are used in and also on the operators they are used with. For example, addition of two simple Variants will yield their numeric sum while concatenation of the same Variants will yield a resultant string. Oftentimes those automatic transformations are executed faster than their alien BASIC counterparts using e.g. a Val() call or explicit casts.

That said and back to our sheep, there's only one legal way to declare your OCYCL array (and the like) using braces:
correct
Code: Select all
Dim OCYCL[] = {5, 6, 7, 11, 12, 28, 40}

vs.

incorrect
Code: Select all
Dim $OCYCL[7] = {5, 6, 7, 11, 12, 28, 40}

' or

Dim $OCYCL[7]

OCYCL = {5, 6, 7, 11, 12, 28, 40}


In other words, you may not initialize fixed size named arrays with dynamic anonymous variant arrays. Both arrays in the correct example above are dynamic, but in the incorrect example, OCYCL is a fixed size string array while its initializer is a dynamic variant-based (currently numeric-only) list.

Dynamic arrays cannot be REDIM'ed. Their subscripts need not be contiguous. The missing elements are created automatically on the fly when the missing subscript is referred to in the code for the first time. Dynamic arrays have no notion of LBound or UBound, only Count which will return the number of dynamic array's currently existing elements. Dynamic arrays are implemented internally as linked lists, aren't contiguous in memory, and therefore aren't WinAPI-compatible.

Strongly typed fixed-size arrays are WinAPI compatible, have LBound/UBound/Count properties, and can be REDIM'ed and optionally PRESERVE'd.

Failure to observe the above rules may lead to memory corruption which may be hard to detect yet makes the overall results undefined. In many cases, it is likely to crash the app altogether.

The code may be simplified and optimized for FBSL in many other ways but all of them aren't vital for proper operation, so we can leave it be until you gain more FBSL experience and are able to spot and eliminate the redundancies yourself. :)

Thanks for staying with FBSL and sorry to have kept you waiting for my answer for so long.
Mike
"Я старый солдат, мадам, и не знаю слов любви."
"I am an old soldier, ma'am, and I don't know the words of love."
"Je suis un vieux soldat, madame, et je ne connais pas les mots d'amour."
"Ich bin ein alter Soldat, gnädige Frau, und ich weiß nicht die Worte der Liebe."

__________________________________________________________________________________________________________________________________________________
(3.2GHz i5 Core Quad, 8GB RAM / 2 x nVidia GTX 550Ti SLI-bridged, 2GB VRAM)
(x86 Win XP Pro Russian Sp3/x86 Win Vista Ultimate Sp2/x64 Win 7 Ultimate Sp1/Wine in x64 elementaryOS Luna)
User avatar
Mike Lobanovsky
FBSL Administrator
FBSL Administrator
 
Posts: 1823
Joined: Tue Apr 19, 2005 8:22 am
Location: Republic of Belarus

Re: FAST calendar RETURN DATE calculator

Unread postby GSAC3000 » Thu Oct 22, 2015 2:06 am

Mike:

Thanks for your reply.

Can you now tell me how to initiaize elements of a STATIC DIMed array like $aaa{0 TO 6] or %bbb[0 TO 11] ?

Don
GSAC3000
FBSL tiny seed
FBSL tiny seed
 
Posts: 15
Joined: Thu Oct 01, 2015 8:15 pm

Re: FAST calendar RETURN DATE calculator

Unread postby Mike Lobanovsky » Thu Oct 22, 2015 5:30 am

Don,

You will have to do it the only purely traditional BASIC way, by individual element assignments or, for testing purposes, by iteration:

Code: Select all
Dim $a[0 To 3], %b[3] ' 4 elements all in all!

For Dim i = 0 To 3 ' or i = LBound(a) To UBound(a)
  a[i] = $i ' or better a[i] = i; as long as data types on both sides of assignment are
            ' simple and convertible, internal conversion works faster than explicit cast
Next

' or if not convertible then

a[0] = "zero": a[1] = "one": a[2] = "two": a[3] = "three"

' same for integer array

For i = 0 To 3
  b[i] = i ' or more exotic b[i] = $i will still be converted to integers (see notes below)
Next

' or extremely exotic

b[0] = $0: b[1] = 1: b[2] = "": b[3] = "3" ' will be initialized with 0, 1, 0, 3 respectively

Please note that simple data type variables -- Integer (a.k.a. Long), Single, Double, Quad, String, Variant, and elements of dynamic or static arrays of Variants -- are typeless and always fully automatically convertible to whatever resultant data type of their assignment is regardless of initial declaration of the variable. That's called "weak typing" also seen in other Variant-based interpreters like Visual Basic or Lua. Type declarations when DIM'ing a simple variable are just syntactic sugar to make the code look more familiar to alien BASIC users. If your code is very basic and contains only simple variables, then you can even define #Option Implicit at the top of the script and not declare your variables at all. They will be created automatically when used in the script for the first time and will almost never need explicit conversion (casts) from one simple "data type" to another in FBSL statements.

In contrast to that, compound data types -- non-Variant static arrays, UDTs and their member fields, Unions (those are in fact Integer/Long named bitfields), namespace and class props and methods -- are strongly typed according to the data types used in their respective declarations and must be declared regardless of #Option setting. FBSL will always attempt to convert the incoming assignment value to the data type of a given compound variable, i.e. will do exactly the opposite to what it does for simple variables but quite similar to what strongly typed languages do. That's a design decision to keep advanced FBSL code in sync with external system and 3rd-party APIs, and also with FBSL's own strongly typed ANSI C and assembly engines.

One-member UDTs can also be used to emulate strongly typed simple variables that would deny the default "weak typing" rules and will behave like their counterparts in strongly typed programming languages. I've already shown how that can be done in my colorful examples earlier in this thread.
Mike
"Я старый солдат, мадам, и не знаю слов любви."
"I am an old soldier, ma'am, and I don't know the words of love."
"Je suis un vieux soldat, madame, et je ne connais pas les mots d'amour."
"Ich bin ein alter Soldat, gnädige Frau, und ich weiß nicht die Worte der Liebe."

__________________________________________________________________________________________________________________________________________________
(3.2GHz i5 Core Quad, 8GB RAM / 2 x nVidia GTX 550Ti SLI-bridged, 2GB VRAM)
(x86 Win XP Pro Russian Sp3/x86 Win Vista Ultimate Sp2/x64 Win 7 Ultimate Sp1/Wine in x64 elementaryOS Luna)
User avatar
Mike Lobanovsky
FBSL Administrator
FBSL Administrator
 
Posts: 1823
Joined: Tue Apr 19, 2005 8:22 am
Location: Republic of Belarus

Re: FAST calendar RETURN DATE calculator

Unread postby GSAC3000 » Thu Oct 22, 2015 6:05 pm

Mike:

Thanks again for your very helpful information about initializing static arrays in FBSL.

Based on your earlier post about my program's errors, I have made the corrections and now everything works fine, using DateConv, for any Gregorian Calendar date from 1590 onward. The results obtained, using DateConv, match exactly with those obtained when using my JDATE function over any span of years from 1590 upward.

Don

Here is a listing of the finalize code:

Code: Select all
' FRDaa.fbs   (RETURN_DATES_3a1.fbs)
'
' RETURN_DATES finds all occurrences of a specific target WEEK-DAY/MONTH-DAY/MONTH return.
' For example, it will quickly find all future occurrences of Friday 29 February within a
' given specific range of Gregorian calendar years
'
' The code exploits the periodic character of successive calendar "return" dates.
' All dates, except 29 February, repeat on the same weekday either every 5, 6, 7, 11, or 12 years.
' The 29th of February repeats on the same weekday either every 12, 28, or 40 years.
'
' Written by GSAC3 (19 May 2009) and originally coded in THINBASIC and BCX.
' RETURN_DATES was re-coded in FBSL 0n 8 October 2015.
' FBSL version was updated on 14 October 2015 to check input data
' for Leap Year entry errors and utilize DateConv function instead
' of JDATE function.
'
#include <Include\Windows.inc>
#Option Strict
#apptype CONSOLE
'
DIM $OUT_BUFFER, %Z, $OUT_HANDLE, $FILE_OUT, $STRT_YR
DIM $WKDY, $BUFR, %COUNT, %WD, %FIRSTwd, %F1, %FIRSTmd, %FIRSTyr, %FIRSTmo
DIM %YEARend, %MOMD, %YL, %L, %Gdate, %MO, %YR, %I1, %I2, !!START, !!FINISH
DIM !!EXE_TIME
'
DIM OCYCL[]   = {5,6,7,11,12,28,40}  ' Values valid from 1590 onward
DIM MO[]        = {31,29,31,30,31,30,31,31,30,31,30,31}
DIM MONTHS[] = {"Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"}
DIM WKDY[]     = {"Sun","Mon","Tue","Wed","Thu","Fri","Sat"}
'
FILE_OUT = "FRDaa.TXT"
'
F1 = FileOpen( FILE_OUT, "OUTPUT" )
OUT_BUFFER =  "  FAST RETURN DATE FINDER"
PRINT OUT_BUFFER
FilePrint(F1,OUT_BUFFER)
OUT_BUFFER = "---------------------------"
PRINT OUT_BUFFER
FilePrint(F1,OUT_BUFFER)
'
'  ENTER AND CHECK VALIDITY OF INPUT DATA
'
:L0
FIRSTyr = VAL(InputBox ("Starting YEAR (1590--->)", "Input (1590--->): ", ""))
STRT_YR = FIRSTyr
IF (STRT_YR = 0) THEN
   GOTO ABORT
END IF
IF (FIRSTyr < 1590) THEN 
   GOTO L0
END IF
'
:L1
FIRSTwd = VAL(InputBox ("Return WEEK DAY (1-7)", "Input   (1 = Sunday): ", ""))
IF (FIRSTwd < 1) OR (FIRSTwd > 7) THEN
   GOTO L1
END IF
'
:L2
FIRSTmo = VAL(InputBox ("Return MONTH (1-12)", "Input   (1 = January): ", ""))
IF (FIRSTmo < 1) or (FIRSTmo > 12) THEN
   GOTO L2
END IF
'
:L3
FIRSTmd = VAL(InputBox ("Return MONTH DAY (1-31)", "Input   (1-31): ", ""))
IF (FIRSTmd < 1) OR (FIRSTmd > MO[FIRSTmo-1]) THEN
   MsgBox( 0, "INPUT ERROR", "RE-ENTER MONTH DAY", MB_OK)
   GOTO L3
END IF
'
MOMD = FIRSTmo*100 + FIRSTmd
'
'  FIND INITIAL TARGET DATE AFTER STARTING DATE
'
:L4
Gdate = FIRSTyr*10000 + MOMD
IF (DateConv (Gdate,"w") <> FIRSTwd) THEN
   INCR (FIRSTyr,1)
   GOTO L4
END IF   
'
:L5
YEARend  =  VAL(InputBox ("Ending YEAR (1590--->)", "Input (1590--->): ", ""))
IF (YEARend =< 1590) THEN 
   GOTO L5
END IF
'
OUT_BUFFER = "For years from " & STRT_YR & " to " & YEARend & CRLF$
PRINT OUT_BUFFER
FilePrint(F1,OUT_BUFFER)
'
OUT_BUFFER = "RETURN DATES:" & CRLF
PRINT OUT_BUFFER
FilePrint(F1,OUT_BUFFER)
COUNT = 1
BUFR = "   " & WKDY[FIRSTwd - 1 ] & " " & MONTHS[FIRSTmo-1] & " " & FIRSTmd & ","
OUT_BUFFER = COUNT & BUFR & FIRSTyr
PRINT OUT_BUFFER
FilePrint(F1,OUT_BUFFER)
'
'   BEGIN SEARCH FOR REMAINING RETURN DATES
'
I1 = 1
I2 = 5
IF (FIRSTmo = 2 AND FIRSTmd = 29) THEN
   I1 = 5
   I2 = 7
END IF
'
START = GetTickCount()
'
YR = FIRSTyr
DO WHILE (YR < YEARend)
  FOR L = I1 TO I2
      YL = YR + OCYCL[L-1]
      IF (YL > YEARend) THEN
         GOTO FIN
      END IF
      Gdate = YL*10000 + MOMD
      WD = DateConv (Gdate,"w")
      IF (WD = FIRSTwd) AND (YL < YEARend) THEN
         INCR (COUNT,1)
         OUT_BUFFER = COUNT & BUFR & YL
    PRINT OUT_BUFFER
         FilePrint(F1,OUT_BUFFER)
         YR=YL
         EXIT FOR
      END IF
  NEXT L
'     
LOOP
'
:FIN
FINISH = GetTickCount()
EXE_TIME = FINISH - START
OUT_BUFFER = CRLF$ & "TOTAL NUMBER OF RETURN DATES BETWEEN " & STRT_YR & " AND " & YEARend & " = " & COUNT & CRLF$
PRINT OUT_BUFFER
FilePrint(F1,OUT_BUFFER)
OUT_BUFFER = "Total execution time was " & EXE_TIME & " msec" &CRLF$
PRINT OUT_BUFFER
FilePrint(F1,OUT_BUFFER)
PRINT " Results were written to " & FILE_OUT & CRLF$
FileClose(F1)
'
PAUSE
:ABORT

GSAC3000
FBSL tiny seed
FBSL tiny seed
 
Posts: 15
Joined: Thu Oct 01, 2015 8:15 pm

Re: FAST calendar RETURN DATE calculator

Unread postby Mike Lobanovsky » Sat Oct 24, 2015 2:20 pm

Hi Don,

I'm glad to have been of help to get your program up and running in FBSL. Looking forward to your further submissions. Don't hesitate to ask about anything you might find unusual or unfamiliar about FBSL BASIC as compared to other BASIC dialects.
Mike
"Я старый солдат, мадам, и не знаю слов любви."
"I am an old soldier, ma'am, and I don't know the words of love."
"Je suis un vieux soldat, madame, et je ne connais pas les mots d'amour."
"Ich bin ein alter Soldat, gnädige Frau, und ich weiß nicht die Worte der Liebe."

__________________________________________________________________________________________________________________________________________________
(3.2GHz i5 Core Quad, 8GB RAM / 2 x nVidia GTX 550Ti SLI-bridged, 2GB VRAM)
(x86 Win XP Pro Russian Sp3/x86 Win Vista Ultimate Sp2/x64 Win 7 Ultimate Sp1/Wine in x64 elementaryOS Luna)
User avatar
Mike Lobanovsky
FBSL Administrator
FBSL Administrator
 
Posts: 1823
Joined: Tue Apr 19, 2005 8:22 am
Location: Republic of Belarus


Return to FBSL v3 Samples Repository

Who is online

Users browsing this forum: No registered users and 1 guest