A tiny New Year's programming challenge

[Dieter]

(01-01-2015 04:51 PM)Dieter Wrote:  And here is your task: Write a program that accepts a valid Gregorian Date and returns the corresponding ISO week number, as well as the day number within that week.

Just before week 2 starts, here is what I got with my 34s. Dates may be entered in dd.mmyyyy or mm.ddyyyy format.

Code:

LBL "KW"  // "KW" is the common German abbreviation for "Kalenderwoche" ;-)
LocR 01   // a single temporary register (and one flag) will do
D->J
RCL L
YEAR
STO.00    // save year in R.00
SDR 004
INC X
SDR 002
INC X     // build 01.01yyyy
D->J      // JD(1 Jan)
#003
+         // JD(4 Jan), which is always in week 1
#007
IDIV
RCL*L     // = JD(4 Jan) - JD(4 Jan) mod 7 = day 1 of week 1
-         // # of days since day 1 of week 1
x>=0?     // date not before day 1 of week 1?
GTO 51
#007
+         // adjust negative day# by adding back 7 days
DEC.00    // week is last of previous year
RCL.00
XEQ 53    // get last week# of previous year
GTO 52    // and exit

LBL 51    // standard case
RCL X
#007
RMDR
x<> Y
#007
IDIV      // day# in Y, week# in X
RCL.00
XEQ 53    // get last week of year
x<? Y     // if computed week# is larger
INC.00    // increment year
x<? Y
CLx       // and set week# to first week in year
MIN

LBL 52    // exit routine
INC X     // adjust week# from 0...52 to 1...53
INC Y     // adjust day# from 0...6 to 1...7
RCL.00
SDR 004
+         // generate ww.yyyy
CLα
αIP.00    // build output string
α"-W"
#010
x>? Y
α"0"
DROP
αIP X
α"-"
αIP Y     // => "yyyy-Www-d"
TOP?      // if directly called by user,
VWα+X     // display formatted result
RTN       // in any case return ww.yyyy in X and day# in Y

LBL 53    // input: year
CF.01     // output: 51 or 52
LEAP?     // = last week# (0-based)
SF.01
SDR 004
INC X
SDR 002
INC X     // build 01.01yyyy
WDAY      // get weekday of 1 Jan
#004
-
x=0?      // is it Thursday?
SKIP 002  // then continue with x=0
FS?C.01   // if not and leap year:
INC X     // set result to 0 also for Wednesday (was 3-4=-1)
SIGN
ABS       // turn any non-zero value into 1
+/-
#052
+         // last week# = 52-0 resp. 52-1
RTN

R.00: year
Flag .01: set if leap year, clear otherwise


04.071979 XEQ"KW" => 1979-W27-3   27.1979  [x<>y]  3
01.012012 XEQ"KW" => 2011-W52-7   52.2011  [x<>y]  7
31.122004 XEQ"KW" => 2004-W53-5   53.2004  [x<>y]  5
31.122012 XEQ"KW" => 2013-W01-1    1.2013  [x<>y]  1

The subroutine at LBL 53 returns the last week# (zero-based) for a given year, i.e. 51 or 52. It checks whether the year starts with a Thursday or – if it is a leap year – with a Wednesday. These years have 53 weeks, otherwise 52.

Dieter