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