vypocet dna v tyzdni

Pavel Troller patrol@sinus.cz
Pátek Únor 22 07:19:42 CET 2008


Zdravim,
Pridavam verzi programu pro vypocet DOW, pouzivanou v kalkulatoru TI-59.
V jeho standardnim modulu totiz byl program, pouzivajici velmi jednoduchy
algoritmus. Tento jsem bohuzel jiz zapomnel, ale pamatoval jsem si z nej
2 magicke konstanty: 365.25 a 30.6 . Stacilo zadat do googlu a algoritmus
byl opet nalezen, napr. zde:
http://www.amsat.org/amsat/articles/g3ruh/100.html
Abyste nemuseli klikat, davam c&p:

ALGORITHM 1:  DATE to DAY NUMBER
--------------------------------
Takes a date in the form of year, month and day of month and calculates
its day number.  Valid from 1582 onwards:

D0 = -722528:   REM For AMSAT day number        )
D0 =    -428:   REM For GENERAL day number      )) CHOOSE ONE ONLY
D0 = 1720982:   REM For Julian Day at noon      )

REM Enter wih Year YR e.g. 1986, Month MN, Day DY. Result is Day Number DN
Y = YR: M = MN: D = DY:                 REM Preserve YR, MN, DY
IF M <= 2 THEN M = M+12: Y = Y-1
DN = -INT(Y/100)+INT(Y/400)+15  + INT(Y*365.25) + INT((M+1)*30.6) + D + D0

NOTES:
1. You may omit the century calculations so that:
        DN = INT(Y*365.25) + INT((M+1)*30.6) + D + D0
   This restricts the algorithm to  1900 Mar 01 until 2100 Feb 28.

Za bazik se omlouvam, ale transkripci do toho ktereho programovaciho jazyka
jiste zvladne kazdy :-). Sice obsahuje operace ve floatech, ale vhodnymi
manipulacemi s desetinnou teckou by nebyl problem je prevest vsechny na INT.
S pozdravem Pavel Troller


> Tak som si dovolil male variacie na danu temu. Prva funkcia je vlastne ta povodna, druha je variacia na temu 366-dnovy rok (vratane gregorianskej korekcie), a tretia je modifikacia druhej tak, aby sa to dalo jednoducho implementovat v jednocipe. No a prikladam aj vzorovu implementaciu v '51, ale len pre toto storocie. Oboje ma ako "main" test, ktory testuje den za dnom.
> 
> Prijemne (po)citanie! :-)
> 
> wek
> 
> ------
> 
> uses crt;
> 
> var d,m,y:integer;
>     dow:integer;
>     leapday:boolean;
> 
> const
>   dd: array[1..12] of integer = ( 31,28,31,30,31,30,31,31,30,31,30,31);
> 
>   md:array[1..12] of integer = (
>   0,
>   31,
>   31+29,
>   31+29+31,
>   31+29+31+30,
>   31+29+31+30+31,
>   31+29+31+30+31+30,
>   31+29+31+30+31+30+31,
>   31+29+31+30+31+30+31+31,
>   31+29+31+30+31+30+31+31+30,
>   31+29+31+30+31+30+31+31+30+31,
>   31+29+31+30+31+30+31+31+30+31+30
> {  31+29+31+30+31+30+31+31+30+31+30+31,}
> );
> 
> function get_dow(d,m,y:integer):integer;
> var dd:integer;
> const
>   a=3; b=4;
> begin
>   y:=y-2000;
>   dd:=y+((y+a) div 4);
>   dd:=dd+md[m];
>   if (m>2) and (y mod 4 <> 0) then begin
>     dd := dd - 1 ;
>   end;
>   dd:=dd+d;
>   dd := dd + b;
>   get_dow := dd mod 7;
> end;
> 
> 
> function get_dow2(d,m,y:integer):integer;
> var dd,c1,c2,c3,c4:longint;
> const b=0000; c=2; {"gregorian" 1.3.0000 - wednesday}
> begin
>   dd:=longint(y-b)*366+md[m]+d-31-29-1; {nr of days since 1.3.0000 in hypothetical 366-day years}
>   c1:=dd div 366; {correction 366 -> 365 days per year}
>   c2:=c1 div 4; {standard Julian leap year correction}
>   c3:=c1 div 100; {Gregorian correction for 100 years are not leap}
>   c4:=c1 div 400; {Gregorian correction for the overshoot in each 400 years}
>   dd := dd - c1 + c2 - c3 + c4;
>   get_dow2 := (dd + c) mod 7;
> end;
> 
> 
> function get_dow3(d,m,y:integer):integer;
> var dd,c1,c2,c3,c4:longint;
> const b=0000; c=4; {"gregorian" 1.3.0000 - wednesday}
> begin
>   dd:=longint(y-b)*(366 mod 7)+(md[m] mod 7)+d; {nr of days since 1.1.0000 in hypothetical 366-day years}
>   c1:=y-b; if m<3 then dec(c1);
>   c2:=c1 div 4; {standard Julian leap year correction}
>   c3:=c2 div 25; {Gregorian correction for 100 years are not leap}
>   c4:=c3 div 4; {Gregorian correction for the overshoot in each 400 years}
>   dd := dd - c1 + c2 - c3 + c4;
>   get_dow3 := (dd + c) mod 7;
> end;
> 
> 
> 
> 
> begin
> 
>   y:=2000;
>   m:=1;
>   d:=1;
>   dow:=5;
> 
>   repeat
>     writeln(d:2,'-',m:2,'-',y:2,':',dow:2,'/',get_dow3(d,m,y));
>     if dow <> get_dow3(d,m,y) then begin
>       writeln('...mismatch - press ENTER...');
>       readln;
>     end;
>     inc(dow);
>     dow := dow mod 7;
>     inc(d);
>     leapday := (m = 2) and (d = 29) and ((y mod 4) = 0);
>     if leapday and ((y mod 100) = 0) and not ((y mod 400) = 0) then leapday:=false;
>     if d>dd[m] then
>       if not leapday then begin
>         d:=1;
>         inc(m);
>         if m>12 then begin
>           m:=1;
>           inc(y);
>         end;
>       end;
>   until keypressed and (readkey=#27);
> end.
> 
> 
> -------------
> 
> $MOD52
> 
> day equ 30h
> month equ 31h
> year equ 32h
> dow equ 33h
> 
> TestDow:
>        mov   dow,#2
>        mov   year,#0      
>        mov   month,#3
>        sjmp  TestDowX2
> TestDowX1:
>        mov   month,#1
> TestDowX2:
>        mov   day,#1
> TestDowX3:
>        mov   r5,day
>        mov   r6,month
>        mov   r7,year
>        call  DayOfWeek
>        cjne  a,dow,Fail
>        inc   dow
>        mov   a,dow
>        cjne  a,#7,TestDowX4
>        mov   dow,#0
> TestDowX4:
>        inc   day
>        mov   a,month
>        add   a,#TestDowTab-TestDowX5-1
>        movc  a,@a+pc
> TestDowX5:
>        cjne  a,day,TestDowX6
>        sjmp  TestDowX3
> TestDowX6:
>        jnc   TestDowX3
>        mov   a,month
>        cjne  a,#2,TestDowX7
>        mov   a,day
>        cjne  a,#29,TestDowX7
>        mov   a,year
>        anl   a,#3
>        jz    TestDowX3
> TestDowX7:
>        inc   month
>        mov   a,month
>        cjne  a,#12+1,TestDowX2
>        inc   year       
>        mov   a,year
>        cjne  a,#100,TestDowX1
>        sjmp  Pass
> TestDowTab:
>        db    31,28,31,30,31,30,31,31,30,31,30,31
>  
> Fail: 
>        ljmp  Fail
> Pass:
>        sjmp  Pass 
> 
> 
> ;calculates day of week
> ;good since 01.03.2000 until 31.12.2099
> ;input: r7 - year (00-99 for 2000-2099)
> ;       r6 - month (01-12)
> ;       r5 - day (01-31, as appropriate for given month)
> ;no sanity check performed
> ;returns in acc 00-06 for Monday-Sunday
> ;uses b
> ;
> 
> DayOfWeek:
>         mov   a,r6
>         cjne  a,#3,DayOfWeekX1
> DayOfWeekX1:
>         mov   a,r7
>         subb  a,#0
>         mov   b,a
>         rr    a
>         rr    a
>         anl   a,#03Fh
>         clr   c
>         subb  a,b
>         mov   b,a
>         mov   a,r7
>         rl    a
>         add   a,b
>         mov   b,a
>         mov   a,r6
>         add   a,#DayOfWeekTab-DayOfWeekX2-1
>         movc  a,@a+pc
> DayOfWeekX2:
>         add   a,r5
>         add   a,b
>         add   a,#4
>         mov   b,#7
>         div   ab
>         mov   a,b
>         ret
> 
> DayOfWeekTab:
>         db    0,3,4,0,2,5,0,3,6,1,4,6        
> 
> 
>    
> 
> 
>         end
> 
> _______________________________________________
> HW-list mailing list  -  sponsored by www.HW.cz
> Hw-list@list.hw.cz
> http://list.hw.cz/mailman/listinfo/hw-list



Další informace o konferenci Hw-list