The exact ISO 8601-Week-number-Calculation

Re: The exact ISO 8601-Week-number-Calculation

Postby mmercado » Thu Dec 10, 2009 5:11 pm

Dear Rao:
nageswaragunupudi wrote:It appears there is some mistake in this line of your code
Code: Select all  Expand view  RUN
  nWeek     := If( Year( dThisThu ) > Year( dFirstThu ), 1, (( dThisThu - dFirstThu ) / 7) + 1 )

Will you please review your code?

The posted sample code is working right to me, what kind of error are you getting?

Best regards.
manuelmercado at prodigy dot net dot mx
User avatar
mmercado
 
Posts: 782
Joined: Wed Dec 19, 2007 7:50 am
Location: Salamanca, Gto., México

Re: The exact ISO 8601-Week-number-Calculation

Postby nageswaragunupudi » Thu Dec 10, 2009 6:58 pm

Mr. Mercado

Your function, as posted here, shows Week No. as 01 for almost all days, because the condition "Year( dThisThu ) > Year( dFirstThu )" is true in lots of cases and in all such cases nWeek is 1. May be you might have made a minor mistake in copying your code here, though your original code may be working correctly.

Image

Image
Please copy your correct working code here for our benefit.

Please also review my function. I checked it for all dates from 1900 to 3000 and I could not find any wrong result with my function ( function ISO8061WD( dDate ) ) above. I wish to see if we can find any bugs in the function I reported here.
Regards

G. N. Rao.
Hyderabad, India
User avatar
nageswaragunupudi
 
Posts: 10690
Joined: Sun Nov 19, 2006 5:22 am
Location: India

Re: The exact ISO 8601-Week-number-Calculation

Postby nageswaragunupudi » Fri Dec 11, 2009 3:42 pm

Mr. Mercado

On a further study of the function posted by you, I noticed a few issues, which I hope you do not mind me bringing to your notice.

The broad logic that the week number is the number of Thursdays is accepted. The function aims at counting the number of thursdays from the first thursday to the thursday nearest to the given date.
But there is a minor mistake in implementation of the logic. But the first thursday should be the one relating to the year of the nearest thursday but not to the year of the given date.

Subject to your permission, I proposed minor changes to give effect to this. Here is your function modifed without disturbing your core logic.

Code: Select all  Expand view  RUN

Function WeekDate2( dDate )  // Mr Mercado's function slightly modified

   Local nDay, dFirstThu, dThisThu, nWeek, n

   nDay      := If( ( nDay := DoW( dDate ) - 1 ) == 0, 7, nDay )
   dThisThu  := dDate - nDay + 4
   dFirstThu := StoD( Str( Year( dThisThu ), 4 ) + "0101" )
   n         := If( ( n    := DoW( dFirstThu ) - 1 ) == 0, 7, n )
   dFirstThu := dFirstThu - n + 4

   nWeek    := ( dThisThu - dFirstThu ) / 7 + If( Year( dThisThu ) > Year( dFirstThu ), 0, 1 )

Return Str( Year( dThisThu ), 4 ) + '-W' + StrZero( nWeek, 2 ) + '-'  + Str( nDay, 1 )
 


Now, this function returns correct result for all dates.

I may also be permitted to make another point.
Code: Select all  Expand view  RUN

   nWeek    := ( dThisThu - dFirstThu ) / 7 + If( Year( dThisThu ) > Year( dFirstThu ), 0, 1 )
 

gives the same result as :
Code: Select all  Expand view  RUN

Int( ( DoY( dThisThu ) - 1 ) / 7 ) + 1
 


Second approach is computationally simpler and avoids the need to find the first thursday. This is the approah I adopted in the function I proposed. I repost the function below:
Code: Select all  Expand view  RUN

function ISO8061WD( dDate )

   local nWeekDay, dThu

   nWeekDay       := DoW( dDate ) - 1 // Find weekday
   if nWeekDay == 0                   // Mon to Sun
      nWeekDay    := 7                // as 1 to 7
   endif

   dThu           := dDate - nWeekDay + 4 // Nearest Thursday

return   Str( Year( dThu ), 4 ) + '-W' + StrZero( Int( ( DoY( dThu ) - 1 ) / 7 ) + 1, 2 ) + '-'  + Str( nWeekDay, 1 )
 

This function economises on the number of computations and usage of date functions.

Both the functions give correct results for all dates.

Here is the program I used to check the correctness of the results from 1900-01-01 to 3000-12-31
Code: Select all  Expand view  RUN

#include 'fivewin.ch'

function Main()

   local aErr  := {}
   local dFrom, dUpto, dDate
   local aPrev, aThis
   local nMonth, nDay

   dFrom := STOD( '19000101' )
   dUpto := STOD( '30001212' )

   aPrev := Isowd( dFrom )
   dDate := dFrom + 1
   do while dDate <= dUpto
      aThis := isowd( dDate )
      if aThis[ 3 ] == 1
         if aPrev[ 3 ] != 7
            AAdd( aErr, { dDate, 1 } )
         endif
         if aThis[ 2 ] == 1
            // first week should start between Dec 29 and Jan 4
            nMonth         := Month( dDate )
            nDay           := Day( dDate )
            if !( ( nMonth == 12 .and. nDay >= 29 ) .or. ( nMonth == 1 .and. nDay <= 4 ) )
               AAdd( aErr, { dDate, 2 } )
            endif
            if aThis[ 1 ] - aPrev[ 1 ] != 1
               AAdd( aErr, { dDate, 3 } )
            endif
         else
            if aThis[ 2 ] - aPrev[ 2 ] != 1
               AAdd( aErr, { dDate, 4 } )
            endif
            if aThis[ 1 ] != aPrev[ 1 ]
               AAdd( aErr, { dDate, 5 } )
            endif
         endif
      else
         if aThis[ 3 ] - aPrev[ 3 ] != 1
            AAdd( aErr, { dDate, 6 } )
         endif
         if aThis[ 2 ] != aPrev[ 2 ] .or. aThis[ 1 ] != aPrev[ 1 ]
            AAdd( aErr, { dDate, 7 } )
         endif
      endif
      ACopy( aThis, aPrev )
      dDate++
   enddo

   if Len( aErr ) > 0
      xbrowse( aErr, 'Errors' )
   else
      MsgInfo( 'All Correct' )
   endif

return nil

function ISOWD( dDate )

   local nWeekDay, dThu

   nWeekDay       := DoW( dDate ) - 1 // Find weekday
   if nWeekDay == 0                   // Mon to Sun
      nWeekDay    := 7                // as 1 to 7
   endif

   dThu           := dDate - nWeekDay + 4 // Nearest Thursday

return { Year( dThu ), Int( ( DOY( dThu ) - 1 ) / 7 ) + 1, nWeekDay }
 
Regards

G. N. Rao.
Hyderabad, India
User avatar
nageswaragunupudi
 
Posts: 10690
Joined: Sun Nov 19, 2006 5:22 am
Location: India

Re: The exact ISO 8601-Week-number-Calculation

Postby StefanHaupt » Fri Dec 11, 2009 6:38 pm

Nages,

When checked in a range of dates from 21.12.1975 to 08.01.1976, only 3 results are correct and 16 results are wrong. A visual inspection of the screenshot below confirms the incorrect results


you are right, there was a logical error in my function, I wasn´t aware. I only made some quick tests with some dates. Your function is working fine.

But I found, that the build-in function Week() is also working fine in all situations I tested. Below are two screenshots of your sample, that show the results. If you review the source of this function, you will find, that there is an undocumented second parameter, which can be true or false. By default it´s false. The last column shows the results, if you set this parameter to true.

Image

Image
kind regards
Stefan
StefanHaupt
 
Posts: 824
Joined: Thu Oct 13, 2005 7:39 am
Location: Germany

Re: The exact ISO 8601-Week-number-Calculation

Postby nageswaragunupudi » Fri Dec 11, 2009 11:57 pm

Mr. Stefan

You are correct. Week() function, by default is fully ISO compliant. Sorry, my earlier statement was wrong.

We can straight away use the built-in Week() function.

Also, we can further optimize the code to determine the WeekDay number.
Here is the revised function I propose now:
Code: Select all  Expand view  RUN
function cISO8061WeekDay( dDate )

   local dThu, nDay

#ifdef __XHARBOUR__
   nDay        := dDate % 7      // Mon .. Sun as 0 .. 6
#else
   nDay        := ( dDate - CToD( '' ) ) % 7
#endif

   dThu        := dDate - nDay + 3

return Str( Year( dThu ), 4 ) + '-W' + StrZero( Week( dDate ), 2 ) + '-' + Str(  nDay + 1, 1 )
 

I checked for all dates and this function gives the correct results.
As of now, this seems to be the shortest possible code, using (x)Harbour.
Regards

G. N. Rao.
Hyderabad, India
User avatar
nageswaragunupudi
 
Posts: 10690
Joined: Sun Nov 19, 2006 5:22 am
Location: India

Previous

Return to FiveWin for Harbour/xHarbour

Who is online

Users browsing this forum: Google [Bot] and 34 guests