### kal_tibet ### 29.12.2007, revised 3.1.2008; slightly revised 12.7.2008 ### Maple procedures for the Tibetan calendar. ### (c) Svante Janson 2007-2008 ### May be freely used and modified for non-commercial properties. ### These procedures are drafts only and not in a final, polished ### version (and probably never will be). ### There is no guarantee that they are correct. ### There is, unfortunately, no further documentation. if # true or (not (Qkal_tibet_LOADED=true)) then Qkal_tibet_LOADED:=true; # NB final fi last in the file # To avoid unnecessary repeated loadings of the file, # the line "true or" should be commented away with "#" # While working on the file, remove this "#" if not (Qkal_bas_loaded=true) then read kal_bas fi: if not (Qkal_julgreg_loaded=true) then read kal_julgreg fi: Kina_60dag:=jd->amod(jd-10,60); ################### Tibet ### Init; different versions and different epochs tib_epok_806:=2015501; # E 806 söndag 26.2 806 tib_epok_806T:=2015531; # E 806T #### 806 tib_epok_1927:=2424972; # E 1927 lördag 2.4 1927 tib_epok_1987:=2446914; # E 1987 tisdag 28.4 1987 tib_epok_1732:=2353745; # E 1732 onsdag 26.3 1732 (TS) tib_epok_1852:=2397598; # E 1852 måndag 19.4 1852 (TS) tib_epok__127:=1675015; # E-127 måndag 7.12 -127 (TS) #ydiff:=1121; #mdiff:=13866; #JDdiff:=409465; ## E806-E1927 tib_m1P:=radixx([29,31,50,0,480],[1,60,60,6,707]); #167025/5656 tib_m2P:=radixx([0,59,3,4,16],[1,60,60,6,707]); #11135/11312 tib_m1T:=radixx([29,31,50,0,8,584],[1,60,60,6,13,707]); #167025/5656 (TS) =tib_m1P tib_m2T:=tib_m1T/30; # antar jag tib_m0E806:=radixx([0,50,44,2,38],[1,60,60,6,707]); #4783/5656 Schuh (m=1) tib_m0E806T:=radixx([2,25,20,2,352],[1,60,60,6,707]); # 2+3224803/7635600 Schuh (m=8) tib_m0E1927:=radixx([6,57,53,2,20],[1,60,60,6,707]); #6+5457/5656 E1927 Henning tib_m0E1987:=radixx([3,11,27,2,332],[1,60,60,6,707]); #3+135/707 E1987 tib_m0E1732:=radixx([4,14,6,2,2,666],[1,60,60,6,13,707]); # E1732 (TS) tib_m0E1852:=radixx([2,9,24,2,5,417],[1,60,60,6,13,707]); # E1732 (TS) tib_m0E_127:=1071/1616; tib_s1P:=radixx([2,10,58,1,17],[27,60,60,6,67]); # 65/804 tib_s2P:=radixx([0,4,21,5,43],[27,60,60,6,67]); # 13/4824 tib_s1T:=radixx([2,10,58,1,3,20],[27,60,60,6,13, 67]); # 65/804 (TS) =tib_s1P tib_s2T:=tib_s1T/30; # antar jag tib_s0E806:=radixx([24,57,5,2,16],[27,60,60,6,67]); # 743/804 Schuh (m=1) tib_s0E806T:=radixx([0,29,34,5,37],[27,60,60,6,67]); # 991/54270 Schuh (m=8) tib_s0E1927:=radixx([25,9,10,4,32],[27,60,60,6,67]); # 749/804 E1927 Henning tib_s0E1987:=1; # E1987 tib_s0E1732:=-radixx([1,29,17,5,6,1],[27,60,60,6,13,67]); # -5983/108540 (TS) tib_s0E1852:=radixx([0,1,22,2,4,18],[27,60,60,6,13,67]); # 23/27135 (TS) tib_ano1P:=radixx([2,1],[28,126]); # 253/3528 tib_ano2P:=radixx([1,0],[28,126]); # 1/28 but Henning uses (1+tib_ano1)/30 tib_ano0E806:=radixx([3,97],[28,126]); # 475/3528 Schuh (m=1) tib_ano0E806T:=radixx([5,112],[28,126]); # 53/252 Schuh (m=8) tib_ano0E1927:=radixx([13,103],[28,126]); # 1741/3528 Henning tib_ano0E1987:=radixx([21,90],[28,126]); # 38/49 tib_ano0E1732:=radixx([14,99],[28,126]); # 207/392 TS tib_ano0E1852:=radixx([0,72],[28,126]); # 1/49 TS Tibet_Init1:=proc(typ,m1,m2,m0,s1,s2,s0,ano1,ano2,ano0,y0,epok) # sätter globala variabler som kan variera mellan olika versioner # typ skall vara string # Phuglug om typ börjar med P # Tsurluk om typ börjar med T local tib_PL; global tib_m1,tib_m2,tib_m0, tib_s1,tib_s2,tib_s0, tib_ano1,tib_ano2,tib_ano0, tib_y0, tib_epok,tib_epokx,tib_alpha,tib_beta,tib_betax,tib_p0,tib_p1,tib_typ; tib_m1:=m1; tib_m2:=m2; tib_m0:=m0; tib_s1:=s1; tib_s2:=s2; tib_s0:=s0; tib_ano1:=ano1; tib_ano2:=ano2; tib_ano0:=ano0; tib_y0:=y0; tib_epok:=epok; tib_epokx:=tib_epok-floor(tib_m0); tib_typ:=typ; tib_PL:=(typ[1]="P"); if tib_PL then tib_p1:=radixx([0,23,6],[1,27,60]); # PL value else tib_p1:=radixx([0,23,0],[1,27,60]) # TS fudge fi; tib_p0:=tib_p1-1/12; tib_alpha:=12*xfrac(tib_s0-tib_p0); tib_beta:=ceil(67*tib_alpha); if tib_PL then tib_betax:=(54-tib_beta) mod 65; # PL else tib_betax:=(6-tib_beta) mod 65; # TS fi; end; Tibet_Init2:=proc(typ,m0,s0,ano0,y0,epok) # sätter globala variabler med Tibet_Init1 enligt typ och epok mm # typ skall vara string # Phuglug om typ börjar med P # Tsurluk om typ börjar med T # ano2 = (1+ano1)/30 enl Henning (mer exakt) om "+" i typ global tib_m2,tib_s2,tib_ano2; if typ[1]="P" then Tibet_Init1(typ,tib_m1P,tib_m2P,m0,tib_s1P,tib_s2P,s0,tib_ano1P,tib_ano2P,ano0,y0,epok); fi; if typ[1]="T" then Tibet_Init1(typ,tib_m1T,tib_m2T,m0,tib_s1T,tib_s2T,s0,tib_ano1P,tib_ano2P,ano0,y0,epok); fi; if searchtext("+",typ)>0 then tib_m2:=tib_m1/30; tib_s2:=tib_s1/30; tib_ano2:=(1+tib_ano1)/30; fi; end; Tibet_Init:=proc(kod) local nr; nr:=Hitta(kod,["E806","E1927","E1987","E1732","E1852","E-127", "E806+","E1927+","E1987+","E1732+","E1852+","E-127+","PL","TS","PL+","TS+", "CC","E806T","E806T+"]); if nr=1 then Tibet_Init2("PL",tib_m0E806,tib_s0E806,tib_ano0E806,806,tib_epok_806); elif nr=2 then Tibet_Init2("PL",tib_m0E1927,tib_s0E1927,tib_ano0E1927,1927,tib_epok_1927); elif nr=3 then Tibet_Init2("PL",tib_m0E1987,tib_s0E1987,tib_ano0E1987,1987,tib_epok_1987); elif nr=4 then Tibet_Init2("TS",tib_m0E1732,tib_s0E1732,tib_ano0E1732,1732,tib_epok_1732); elif nr=5 then Tibet_Init2("TS",tib_m0E1852,tib_s0E1852,tib_ano0E1852,1852,tib_epok_1852); elif nr=6 then Tibet_Init2("PL",tib_m0E_127,tib_s0E_127,tib_ano0E_127,-127,tib_epok__127); elif nr=7 then Tibet_Init2("PL+",tib_m0E806,tib_s0E806,tib_ano0E806,806,tib_epok_806); elif nr=8 then Tibet_Init2("PL+",tib_m0E1927,tib_s0E1927,tib_ano0E1927,1927,tib_epok_1927); elif nr=9 then Tibet_Init2("PL+",tib_m0E1987,tib_s0E1987,tib_ano0E1987,1987,tib_epok_1987); elif nr=10 then Tibet_Init2("TS+",tib_m0E1732,tib_s0E1732,tib_ano0E1732,1732,tib_epok_1732); elif nr=11 then Tibet_Init2("TS+",tib_m0E1852,tib_s0E1852,tib_ano0E1852,1852,tib_epok_1852); elif nr=12 then Tibet_Init2("PL+",tib_m0E_127,tib_s0E_127,tib_ano0E_127,-127,tib_epok__127); elif nr=13 then Tibet_Init(1); elif nr=14 then Tibet_Init(4); elif nr=15 then Tibet_Init(7); elif nr=16 then Tibet_Init(10); elif nr=17 then Tibet_Init(12); elif nr=18 then Tibet_Init2("TS",tib_m0E806T,tib_s0E806T,tib_ano0E806T,806,tib_epok_806T); elif nr=19 then Tibet_Init2("TS+",tib_m0E806T,tib_s0E806T,tib_ano0E806T,806,tib_epok_806T); fi; (tib_typ,tib_y0); end; Tibet_Init("PL+"); ### default choice #Tibet_Init("E1927+"); ### Henning # REM tib_m2=tib_m1/30 and tib_s2=tib_s1/30, but tib_ano2 is rounded # in some versions (not the ones with "+" in my tib_typ). # Henning uses instead tib_ano2:=(1+tib_ano1)/30; # this makes a very small difference (about once in 10 years) # TIBET_ROUND selects rounding in a few places # TIBET_ROUND:=0; no rounding # TIBET_ROUND:=1; truncation towards 0 # TIBET_ROUND:=2; rounding to nearest integer #TIBET_ROUND:=0; #no rounding TIBET_ROUND:=1; # truncation Tibet_divisor:=proc(radix) # the product of the radices local i; mul(i,i=radix); end; Tibet_round:=proc(x,radix) # rounds x to the smallest unit in radix, depending on TIBET_ROUND local m; m:=Tibet_divisor(radix); if TIBET_ROUND=1 then trunc(x*m)/m; elif TIBET_ROUND=2 then round(x*m)/m; else x; fi; end; # TIBET_YEAR defines the year format. Legal values: #TIBET_YEAR:=0; #Gregorian year #TIBET_YEAR:=1; # Epoch 127 BC; 2130 = 2003 AD #TIBET_YEAR:=2; # [cycle,year], with first cycle starting in 1027 AD #TIBET_YEAR:=3; # [element,gender,animal]; output only #TIBET_YEAR:=0; #Gregorian year TIBET_YEAR:=1; #Epoch 127 BC # converts a Tibetan year to the (approx) Gregorian used in the calculations Tibet_year_in:=proc(yy); if TIBET_YEAR=0 then yy; #Gregorian year elif TIBET_YEAR=1 then yy-127; # Epoch 127 BC; 2130 = 2003 AD elif TIBET_YEAR=2 then 60*yy[1]+yy[2]+1027-60-1; # [cycle,year] else error "invalid TIBET_YEAR", TIBET_YEAR; fi; end; # converts a Gregorian year to Tibetan for output Tibet_year_out:=proc(y); if TIBET_YEAR=0 then y; #Gregorian year elif TIBET_YEAR=1 then y+127; # Epoch 127 BC; 2130 = 2003 AD elif TIBET_YEAR=2 then [floor((y-1027)/60)+1,amod(y-1027+1,60)]; elif TIBET_YEAR=3 then Tibet_yearname(y); else error "invalid TIBET_YEAR", TIBET_YEAR; fi; end; #Tibet_cycle Tibet_animals:= ["Mouse","Ox","Tiger","Rabbit","Dragon","Snake","Horse","Sheep","Monkey","Bird","Dog","Pig"]; ###["Mouse","Ox","Tiger","Hare","Dragon","Snake","Horse","Sheep","Monkey","Bird","Dog","Pig"]; #CC Tibet_animal:=proc(y); Tibet_animals[amod(y-1027+4,12)]; end; Tibet_elements:=["wood","fire","earth","iron","water"]; Tibet_element:=proc(y) local y10; y10:=amod(y-1027+4,10); Tibet_elements[ceil(y10/2)]; end; Tibet_genders:=["male","female"]; Tibet_gender:=proc(y) Tibet_genders[amod(y-1,2)]; end; Tibet_yearname:=proc(y); [Tibet_element(y),Tibet_gender(y),Tibet_animal(y)]; end; Tibet_dayname:=proc(jd) local n; n:=Kina_60dag(jd)+1023; [Tibet_element(n),Tibet_gender(n),Tibet_animal(n)]; end; # month count since epoch # if there is no leap month (m,yy), then (m,true,yy) gives the same # result as (m,false,yy) Tibet_monthcount:=proc(m,l,yy) floor((12*(Tibet_year_in(yy)-tib_y0)+m-tib_alpha-ifx(l,1-12*tib_s1))/(12*tib_s1)); # floor((12*(Tibet_year_in(yy)-tib_y0)+m-tib_alpha)/(12*tib_s1))-Indicator(l); end; # mean date at beginning of month count n Tibet_mean_date_month:=proc(n) n*tib_m1+tib_m0+tib_epokx; end; #traditional form Tibet_mean_date_month_trad:=proc(n) radix4frac1(Tibet_mean_date_month(n)+2,7,[60,60,6,707]); end; # mean date at end of lunar day (mean weekday) Tibet_mean_date_end_day:=proc(d,n) d*tib_m2+Tibet_mean_date_month(n); end; #traditional form Tibet_mean_date_end_day_trad:=proc(d,n) radix4frac1(Tibet_mean_date_end_day(d,n)+2,7,[60,60,6,707]); end; # mean longitude of sun at beginning of month count n Tibet_mean_sun_month:=proc(n) n*tib_s1+tib_s0; end; # mean longitude of sun at end of lunar day Tibet_mean_sun_end_day:=proc(d,n) d*tib_s2+Tibet_mean_sun_month(n); end; #traditional form Tibet_mean_sun_end_day_trad:=proc(d,n) radix4frac1(Tibet_mean_sun_end_day(d,n),1,[27,60,60,6,67]); end; # mean anomaly of the moon at beginning of month count n Tibet_anomaly_moon_month:=proc(n) n*tib_ano1+tib_ano0; end; #traditional form Tibet_anomaly_moon_month_trad:=proc(n) radix4frac1(Tibet_anomaly_moon_month(n),1,[28,126]); end; # mean anomaly of the moon at end of lunar day Tibet_anomaly_moon_end_day:=proc(d,n) d*tib_ano2+Tibet_anomaly_moon_month(n); end; #traditional form Tibet_anomaly_moon_end_day_trad:=proc(d,n) radix4frac1(Tibet_anomaly_moon_end_day(d,n),1,[28,126]); end; # data for moon_equ. Extended by one extra item for the case when # x is exactly 7 mod 14 (z0=7,z1=0) Tibet_moon_tab_data:=[0,5,10,15,19,22,24,25,25]; Tibet_moon_tab:=proc(x) local z,z0,z1,k; z:= x-28*floor(x/28); if z>14 then k:=-1; z:=z-14; else k:=1; fi; if z>7 then z:=14-z; fi; z0:=floor(z); z1:=z-z0; k*(z1*Tibet_moon_tab_data[z0+2]+(1-z1)*Tibet_moon_tab_data[z0+1]); end; # equation of the moon at end of lunar day Tibet_moon_equ:=proc(d,n) local ano; ano:=Tibet_anomaly_moon_end_day(d,n); Tibet_moon_tab(28*ano)/60; end; # traditional Tibet_moon_equ_trad:=proc(d,n) radix4frac(Tibet_moon_equ(d,n),[60,60,6,67]); end; # data for sun_equ. Extended by one extra item for the case when x is # exactly 3 mod 6 (z0=3,z1=0) Tibet_sun_tab_data:=[0,6,10,11,11]; Tibet_sun_tab:=proc(x) local z,z0,z1,k; z:= x-12*floor(x/12); if z>6 then k:=-1; z:=z-6; else k:=1; fi; if z>3 then z:=6-z; fi; z0:=floor(z); z1:=z-z0; k*(z1*Tibet_sun_tab_data[z0+2]+(1-z1)*Tibet_sun_tab_data[z0+1]); end; # equation of the sun at end of day Tibet_sun_equ:=proc(d,n) local ano; ano:=Tibet_mean_sun_end_day(d,n)-1/4; Tibet_sun_tab(12*ano)/60; end; # traditional Tibet_sun_equ_trad:=proc(d,n) radix4frac(Tibet_sun_equ(d,n),[60,60,6,67]); end; # semitrue date at end of lunar day Tibet_semitrue_date_end_day:=proc(d,n) Tibet_mean_date_end_day(d,n)+Tibet_moon_equ(d,n); end; #traditional form Tibet_semitrue_date_end_day_trad:=proc(d,n) radix4frac1(Tibet_semitrue_date_end_day(d,n)+2,7,[60,60,6,707]); end; # true date at end of lunar day Tibet_true_date_end_day:=proc(d,n) Tibet_mean_date_end_day(d,n)+Tibet_moon_equ(d,n)-Tibet_sun_equ(d,n); end; #traditional form Tibet_true_date_end_day_trad:=proc(d,n) radix4frac1(Tibet_true_date_end_day(d,n)+2,7,[60,60,6,67]); end; # true longitude of sun at end of lunar day Tibet_true_sun_end_day:=proc(d,n) Tibet_mean_sun_end_day(d,n)-Tibet_sun_equ(d,n)/27; end; # traditional form Tibet_true_sun_end_day_trad:=proc(d,n) radix4frac1(Tibet_true_sun_end_day(d,n)+2,1,[27,60,60,6,67]); end; # JD for day d of month m year yy (leap month if l=true); # if two days d, the later is chosen if later=true # if the day is unique, "later" does not matter # if the day does not exist, the function gives the preceding day if later=true # and the following day if later=false # d=1..30 assumed (d=0 should work with later=true, but not for later=false) JD4Tibet1:=proc(d,later,m,l,yy); if later then floor(Tibet_true_date_end_day(d,Tibet_monthcount(m,l,yy))) else if d>1 then floor(Tibet_true_date_end_day(d-1,Tibet_monthcount(m,l,yy))+1) else floor(Tibet_true_date_end_day(30,Tibet_monthcount(m,l,yy)-1)+1); fi; fi; end; # JD for day d of month m year yy; # if two days d, the first is chosen, # and -d gives the second day d; # -m gives leap month m. # If the day is unique, -d gives the same day as d; # if there is no leap month m, -m gives the same as m. # If the day does not exist, the function gives the preceding day if d<0 # and the following day if d>0 # d=1..30 assumed (d=0 should work) JD4Tibet:=proc(d,m,yy); JD4Tibet1(abs(d),d<=0,abs(m),m<0,yy); end; # JD4Tibet_lunardaycount:=proc(ldc) local d,n; d:=amod(ldc,30); n:=(ldc-d)/30; floor(Tibet_true_date_end_day(d,n)); end; Tibet_lunardaycount4JD:=proc(jd) local ldc,x; ldc:=ceil(30*(jd-tib_epok)/tib_m1); x:=JD4Tibet_lunardaycount(ldc); if x>jd then while x>jd do ldc:=ldc-1; x:=JD4Tibet_lunardaycount(ldc); od; if xjd then RETURN(ldc) fi; fi; #ldc now gives correct date jd, but may be non-unique; if JD4Tibet_lunardaycount(ldc-1)=jd then ldc-1 else ldc; fi; end; # Tibet date from JD: # [day, dtype, month, leapmonth, year] # De luxe version, where dtype=0 for unique date and dtype=1 for the # first and dtype=2 for the second of a duplicated day Tibet4JD2:=proc(jd) local ldc,dtype,d,n,x,m,l,y,yy; ldc:=Tibet_lunardaycount4JD(jd); if JD4Tibet_lunardaycount(ldc)>jd then dtype:=1; elif JD4Tibet_lunardaycount(ldc-1)jd); later:=evalb(JD4Tibet_lunardaycount(ldc-1)RD4JD(JD4Tibet1(d,later,m,l,yy)); Tibet4RD:=rd->Tibet4JD(JD4RD(rd)); Tibet4Jul:=(d,m,y)->Tibet4JD(JD4Jul(d,m,y)); Tibet4Greg:=(d,m,y)->Tibet4JD(JD4Greg(d,m,y)); RD4Tibet:=(d,m,y)->RD4JD(JD4Tibet(d,m,y)); Jul4Tibet:=(d,m,y)->Jul4JD(JD4Tibet(d,m,y)); Greg4Tibet:=(d,m,y)->Greg4JD(JD4Tibet(d,m,y)); ### special Tibetan functions # Boolean function showing whether the date is omitted (does not exist) Tibet_omitted:=proc(d,m,l,yy); evalb(JD4Tibet1(d,true,m,l,yy)JD4Tibet1(d,false,m,l,yy)); end; # Boolean function showing whether the month is repeated (a leap month) Tibet_leapmonth:=proc(m,yy); evalb(Tibet_monthcount(m,false,yy)-Tibet_monthcount(m-1,false,yy)>1); end; # prints number of leap month, if any Tibet_leapmonth_in_year:=proc(yy) local m; for m to 12 do if Tibet_leapmonth(m,yy) then print(m,"leap month"); fi; od; end; # lists omitted days (with -) and repeated days in month m (l) year yy Tibet_specialdays_in_month1:=proc(m,l,yy) local d,dd,s; s:=[]; for d to 30 do dd:=JD4Tibet1(d,true,m,l,yy)-JD4Tibet1(d-1,true,m,l,yy); if dd<1 then s:=[op(s),-d] fi; if dd>1 then s:=[op(s),d] fi; od; RETURN(s); end; # prints omitted days (with -) and repeated days in month m (l) year yy Tibet_specialdays_in_month0:=proc(m,l,yy) local d,dd; for d to 30 do dd:=JD4Tibet1(d,true,m,l,yy)-JD4Tibet1(d-1,true,m,l,yy); if dd<1 then print(-d) fi; if dd>1 then print(d) fi; od; end; # prints omitted days and repeated days for each month in year yy # each month on a separate line Tibet_specialdays_in_year1:=proc(yy) local m; for m to 12 do if Tibet_leapmonth(m,yy) then print(m,Tibet_specialdays_in_month1(m,true,yy)); fi; print(m,Tibet_specialdays_in_month1(m,false,yy)); od; end; # prints omitted days and repeated days for each month in year yy # each day on a separate line Tibet_specialdays_in_year0:=proc(yy) local m; for m to 12 do if Tibet_leapmonth(m,yy) then print("leap month",m); Tibet_specialdays_in_month0(m,true,yy); fi; print("month",m); Tibet_specialdays_in_month0(m,false,yy); od; end; # JD for first day of month m year yy # this is day 2 if day 1 is omitted JD4Tibet_month_starts:=proc(m,l,yy); floor(Tibet_true_date_end_day(30,Tibet_monthcount(m,l,yy)-1))+1; end; # Alternative: JD4Tibet1(1,false,m,l,yy) # JD for last day of month m year yy # this is day 29 if day 30 is omitted JD4Tibet_month_ends:=proc(m,l,yy); floor(Tibet_true_date_end_day(30,Tibet_monthcount(m,l,yy))); end; # Alternative: JD4Tibet1(30,true,m,l,yy) # JD for first day of year yy # This is first day (possibly day 2) of the first month (possibly a leap month) JD4Tibet_Newyear:=proc(yy) JD4Tibet1(1,false,1,true,yy); end; # Alternative: JD4Tibet1(30,true,12,false,yy-1)+1 # Alternative: # floor(Tibet_true_date_end_day(30,Tibet_monthcount(12,false,yy-1)))+1; # Synonym JD4Tibet_Losar:=yy->JD4Tibet_Newyear(yy); # JD for "astronomical" beginning of month m year yy (leap month if l=true) # Usually the last day of the preceding month! # This is based on the astronomical calculations for the beginning of # month, and may conceivably differ from calendar day 30 in the # preceding month. This is intended for tests rather than calenders. JD4Tibet_month:=proc(m,l,yy); floor(Tibet_true_date_end_day(0,Tibet_monthcount(m,l,yy))); end; # intercalation index, zla phro Tibet_ix:=proc(m,yy); 2*(12*(Tibet_year_in(yy)-tib_y0)+m-3)+tib_betax mod 65; end; # "true month" = [month count,intercalation index] (1,65) Tibet_true_month:=proc(m,yy); (67*(12*(Tibet_year_in(yy)-tib_y0)+m-3)+tib_betax)/65; end; # longitude of the moon at end of lunar day Tibet_moon_long_lunar_day:=proc(d,n) Tibet_true_sun_end_day(d,n)+d/30; end; # longitude of the moon at start of calendar day Tibet_moon_long_daybreak:=proc(d,n) Tibet_moon_long_lunar_day(d,n)- xfrac(Tibet_true_date_end_day(d,n))/27; end; # yoga=sum of moon longitude and sun longitude Tibet_yoga:=proc(d,n) Tibet_moon_long_daybreak(d,n) + Tibet_true_sun_end_day(d,n); end; # (calendar) day count from epoch; general day; fixed day; Tibet_daycount:=proc(d,l0,m,l,yy) JD4Tibet1(d,l0,m,l,yy)-tib_epok; end; # lunar day count from epoch; Tibet_daycount:=proc(d,l0,m,l,yy) d+30*Tibet_monthcount(m,l,yy); end; ########## PLANETS ## ONLY PL CALCULATIONS # (calendar) day count from epoch; general day; # in traditional calculations, daycount is obtained from this by # checking the day of week and if necessary adjusting by +-1. # (We omit this and use instead JD4Tibet1.) Tibet_daycount_approx:=proc(d,m,l,yy) local n,a,x; a:=xfrac(-tib_m0); n:=30*Tibet_monthcount(m,l,yy)+d; x:=n*(1-708/45248)-a; #45248=64*707; ceil(x); end; tib_planet0:=table([mercury=4639,venus=301,mars=157,jupiter=3964,saturn=6286]); # E1927 tib_planet1:=table([mercury=8797,venus=2247,mars=687,jupiter=4332,saturn=10766]); tib_planet2:=table([mercury=100,venus=10,mars=1,jupiter=1,saturn=1]); tib_planet_birth:=table([mercury=33/54,venus=6/27,mars=19/54,jupiter=12/27,saturn=18/27]); # rahu is for LUNAR days tib_rahu1:=radixx([0,0,14,0,12],[27,60,60,6,23]); #1/6900 = 1/230 months tib_rahu0:=187*30; #E1927 tib_planet_radix:=table([mercury=[27,60,60,6,8797], venus=[27,60,60,6,749], mars=[27,60,60,6,229], jupiter=[27,60,60,6,361], saturn=[27,60,60,6,5383], rahu=[27,60,60,6,23]]); tib_planet_outer:=table([mercury=false,venus=false,mars=true,jupiter=true,saturn=true]); tib_planet_step1:=18382/6714405; #[0,4,26,0,93156] (radixstep) tib_planet_step0:=-458672/6714405; # [25,9,20,0,97440] (radixstep) # E1927 tib_planet_radix_step:=[27,60,60,6,149209]; Tibet_planet_particularday:=proc(dc,planet); (dc*tib_planet2[planet]+tib_planet0[planet]) mod tib_planet1[planet]; end; Tibet_planet_mean_sun_long:=proc(dc); # mean solar longitude, new calculation (end of solar day) xfrac(dc*tib_planet_step1+tib_planet_step0); end; Tibet_planet_mean_slow_long:=proc(dc,planet); # mean slow longitude, dal bar # for outer planets: = mean heliocentric longitude # for inner planers: = mean longitude of sun if tib_planet_outer[planet] then Tibet_planet_particularday(dc,planet)/tib_planet1[planet] else Tibet_planet_mean_sun_long(dc); fi; end; # traditional Tibet_planet_mean_slow_long_trad:=proc(dc,planet) local rx; if tib_planet_outer[planet] then rx:=tib_planet_radix[planet] else rx:=tib_planet_radix_step fi; radix4frac(Tibet_planet_mean_slow_long(dc,planet),rx); end; Tibet_planet_stepindex:=proc(dc,planet); # step index # for outer planets: = mean solar longitude # for inner planets: = mean heliocentric longitude if tib_planet_outer[planet] then Tibet_planet_mean_sun_long(dc); else Tibet_planet_particularday(dc,planet)/tib_planet1[planet] fi; end; # traditional Tibet_planet_stepindex_trad:=proc(dc,planet) local rx; if (not tib_planet_outer[planet]) then rx:=tib_planet_radix[planet] else rx:=tib_planet_radix_step fi; radix4frac(Tibet_planet_stepindex(dc,planet),rx); end; # data for planet_equ. # Extended by symmetries to 0..12 # data for one extra item (4) given for the case # when x is exactly 3 mod 6 (z0=3,z1=0) Tibet_planet_equ_tab_data:=table([ mercury=[0,10,17,20,17], venus=[0,5,9,10,9], mars=[0,25,43,50,43], jupiter=[0,11,20,23,20], saturn=[0,22,37,43,37]]); Tibet_planet_equ_tab:=proc(x,planet) # table look up for Tibet_planet_equ; local z,z0,z1,k,tab_data; tab_data:=Tibet_planet_equ_tab_data[planet]; z:= x-12*floor(x/12); if z>6 then k:=-1; z:=z-6; else k:=1; fi; if z>3 then z:=6-z; fi; z0:=floor(z); z1:=z-z0; k*(z1*tab_data[z0+2]+(1-z1)*tab_data[z0+1]); end; # equation of the planets Tibet_planet_equ:=proc(dc,planet) local ano; ano:=Tibet_planet_mean_slow_long(dc,planet)-tib_planet_birth[planet]; Tibet_planet_equ_tab(12*ano,planet); end; # traditional Tibet_planet_equ_trad:=proc(dc,planet) local rx; if tib_planet_outer[planet] then rx:=tib_planet_radix[planet] else rx:=tib_planet_radix_step fi; radix4frac(Tibet_planet_equ(dc,planet)/27/60,rx); end; Tibet_planet_true_slow_long:=proc(dc,planet); # true slow (heliocentric) longitude Tibet_planet_mean_slow_long(dc,planet)-Tibet_planet_equ(dc,planet)/(60*27); end; # traditional Tibet_planet_true_slow_long_trad:=proc(dc,planet) local rx; if tib_planet_outer[planet] then rx:=tib_planet_radix[planet] else rx:=tib_planet_radix_step fi; radix4frac(Tibet_planet_true_slow_long(dc,planet),rx); end; # data for planet_corr. # (extended by skewsymmetry up to index 27) Tibet_planet_corr_tab_data:=table([ mercury=[0,16,32,47,61,74,85,92,97,97,93,82,62,34,-34], venus=[0,25,50,75,99,123,145,167,185,200,208,202,172,83,-83], mars=[0,24,47,70,93,114,135,153,168,179,182,171,133,53,-53], jupiter=[0,10,20,29,37,43,49,51,52,49,43,34,23,7,-7], saturn=[0,6,11,16,20,24,26,28,28,26,22,17,11,3,-3]]); Tibet_planet_corr_tab:=proc(x,planet) # table look up for Tibet_planet_corr; # argument x in [0,27] ! local z,z0,z1,k,tab_data; tab_data:=Tibet_planet_corr_tab_data[planet]; z:=x; ## or, safer, z:= x-27*floor(x/27); if z>13.5 then k:=-1; z:=27-z; else k:=1; fi; z0:=floor(z); z1:=z-z0; k*(z1*tab_data[z0+2]+(1-z1)*tab_data[z0+1]); end; # correction table argument for the planets # value in [0,1) Tibet_planet_corr_arg:=proc(dc,planet) xfrac(Tibet_planet_stepindex(dc,planet)-Tibet_planet_true_slow_long(dc,planet)); end; # traditional Tibet_planet_corr_arg_trad:=proc(dc,planet) radix4frac(Tibet_planet_corr_arg(dc,planet),tib_planet_radix[planet]); end; # correction for the planets Tibet_planet_corr:=proc(dc,planet) local x; x:=Tibet_planet_corr_tab(27*Tibet_planet_corr_arg(dc,planet),planet)/(27*60); Tibet_round(x,tib_planet_radix[planet]); end; # traditional Tibet_planet_corr_trad:=proc(dc,planet) radix4frac(Tibet_planet_corr(dc,planet),tib_planet_radix[planet]); end; Tibet_planet_fast_long:=proc(dc,planet) # true fast (geocentric) longitude local x; x:=Tibet_planet_true_slow_long(dc,planet)+Tibet_planet_corr(dc,planet); Tibet_round(x,tib_planet_radix[planet]); end; # traditional Tibet_planet_fast_long_trad:=proc(dc,planet); radix4frac(Tibet_planet_fast_long(dc,planet),tib_planet_radix[planet]); end; Tibet_rahu_source4lunardaycount:=proc(ldc) # longitude of Source of Rahu for lunar day count since epoch xfrac((ldc+tib_rahu0)*tib_rahu1); end; # traditional Tibet_rahu_source4lunardaycount_trad:=proc(ldc) radix4frac(Tibet_rahu_source4lunardaycount(ldc),tib_planet_radix[rahu]); end; Tibet_rahu_head4lunardaycount:=proc(ldc) # longitude of Head of Rahu for lunar day count since epoch xfrac(-Tibet_rahu_source4lunardaycount(ldc)); end; # traditional Tibet_rahu_head4lunardaycount_trad:=proc(ldc) radix4frac(Tibet_rahu_head4lunardaycount(ldc),tib_planet_radix[rahu]); end; Tibet_rahu_tail4lunardaycount:=proc(ldc) # longitude of Tail of Rahu for lunar day count since epoch xfrac(1/2-Tibet_rahu_source4lunardaycount(ldc)); end; # traditional Tibet_rahu_tail4lunardaycount_trad:=proc(ldc) radix4frac(Tibet_rahu_tail4lunardaycount(ldc),tib_planet_radix[rahu]); end; Tibet_rahu_source4JD:=proc(JD) # longitude of Source of Rahu for JD Tibet_rahu_source4lunardaycount(Tibet_lunardaycount4JD(JD)); end; # traditional Tibet_rahu_source4JD_trad:=proc(JD) radix4frac(Tibet_rahu_source4JD(JD),tib_planet_radix[rahu]); end; Tibet_rahu_head4JD:=proc(JD) # longitude of Head of Rahu for lunar day count since epoch xfrac(-Tibet_rahu_source4JD(JD)); end; # traditional Tibet_rahu_head4JD_trad:=proc(JD) radix4frac(Tibet_rahu_head4JD(JD),tib_planet_radix[rahu]); end; Tibet_rahu_tail4JD:=proc(JD) # longitude of Tail of Rahu for lunar day count since epoch xfrac(1/2-Tibet_rahu_source4JD(JD)); end; # traditional Tibet_rahu_tail4JD_trad:=proc(JD) radix4frac(Tibet_rahu_tail4JD(JD),tib_planet_radix[rahu]); end; #QQQ ##################### FOR TESTING # tests consistency Tibet_test0:=proc(jd1,jd2) local i; for i from jd1 to jd2 do if (JD4Tibet1(op(Tibet4JD1(i)))<>i) then error i fi; if i mod 1000 =0 then print(i) fi; od; end; #Tibet_test0(2000000,2500000); Tibet_test1:=proc(d,m,l,yy) # prints various quantities calculated by Henning local n,gza0,jd; n:=Tibet_monthcount(m,l,yy); gza0:= tib_epok_806 mod 7; print("zla dag",n,"zla phro",Tibet_ix(m,yy), radix4frac(Tibet_true_month(m,yy),[1,65])); print("ril cha",radix4frac1(Tibet_anomaly_moon_month(n),1,[28,126])); print("gza bar", radix4frac1(Tibet_mean_date_end_day(d,n)-gza0,7,[60,60,6,707])); print("nyi bar",radix4frac1(Tibet_mean_sun_end_day(d,n),1,[27,60,60,6,67])); print("gza dag", radix4frac1(Tibet_true_date_end_day(d,n)-gza0,7,[60,60,6,707])); print("gza dag (67)", radix4frac1(Tibet_true_date_end_day(d,n)-gza0,7,[60,60,6,67])); print("nyi dag", radix4frac1(Tibet_true_sun_end_day(d,n),1,[27,60,60,6,67])); print("Moon, lunar day", radix4frac1(Tibet_moon_long_lunar_day(d,n),1,[27,60,60,6,67])); print("Moon, daybreak", radix4frac1(Tibet_moon_long_daybreak(d,n),1,[27,60,60,6,67])); print("spyi chag",Tibet_daycount(d,true,m,l,yy), "Julian Day",JD4Tibet1(d,true,m,l,yy)); print(Greg4JD(JD4Tibet1(d,true,m,l,yy))); #print("tithi", evalf(Tibet_mean_date_end_day(d,n))-2400000); #print("tithi", evalf(Tibet_true_date_end_day(d,n))-2400000); end; # prints various quantities tabulated by Hennings at # http://kalacakra.org/calendar/tibcal.htm Tibet_test4:=proc(d,m,l,yy) local n,gza0; n:=Tibet_monthcount(m,l,yy); gza0:= tib_epok_806 mod 7; print(Greg4JD(JD4Tibet1(d,true,m,l,yy))); print("zla dag",n,"zla phro",Tibet_ix(m,yy), radix4frac(Tibet_true_month(m,yy),[1,65])); print("gza dag, date end of lunar day", radix4frac1(Tibet_true_date_end_day(d,n)-gza0,7,[60,60,6,707])); print("zla skar, moon longitude", radix4frac1(Tibet_moon_long_daybreak(d,n),1,[27,60,60,6,67])); print("nyi dag, solar longitude (in stations)", radix4frac1(Tibet_true_sun_end_day(d,n),1,[27,60,60,6,67])); print("sbyor ba, yoga",radix4frac1(Tibet_yoga(d,n),1,[27,60,60,6,67])); print("solar day (mean longitude in signs and degrees)", radix4frac1(Tibet_mean_sun_end_day(d,n),1,[12,30,60])); print("solar day (true longitude in signs and degrees)", radix4frac1(Tibet_true_sun_end_day(d,n),1,[12,30,60])); end; Tibet_test2:=proc(d,m,l,yy) # prints various quantities calculated by Lai and Dolma # (their example is (19,4,false,1999)) # byed pa = karana? local n,gza0; n:=Tibet_monthcount(m,l,yy); gza0:= tib_epok_806 mod 7; print(Greg4JD(JD4Tibet1(d,true,m,l,yy))); print("zla dag",n,"zla phro",Tibet_ix(m,yy), radix4frac(Tibet_true_month(m,yy),[1,65])); print("gza dru",radix4frac1(Tibet_mean_date_month(n)-gza0,7,[60,60,6,707])); print("nyi dru",radix4frac1(Tibet_mean_sun_month(n),1,[27,60,60,6,67])); print("ril cha",radix4frac1(Tibet_anomaly_moon_month(n),1,[28,126])); print("rtag long",radix4frac1(d*tib_m2,7,[60,60,6,707])); print("gza bar", radix4frac1(Tibet_mean_date_end_day(d,n)-gza0,7,[60,60,6,707])); print("anomaly of the moon", radix4frac1(Tibet_anomaly_moon_end_day(d,n),1,[28,126])); print("zla rkang",radix4frac(Tibet_moon_equ(d,n),[60,60,6,707])); print("gza phyed dag", radix4frac1(Tibet_mean_date_end_day(d,n)+Tibet_moon_equ(d,n)-gza0, 7,[60,60,6,707])); print("nyi mai rtag long",radix4frac1(d*tib_s2,1,[27,60,60,6,67])); print("nyi rkang",radix4frac(Tibet_sun_equ(d,n),[60,60,6,707])); print("nyi bar",radix4frac1(Tibet_mean_sun_end_day(d,n),1,[27,60,60,6,67])); print("nyi dag",radix4frac1(Tibet_true_sun_end_day(d,n),1,[27,60,60,6,67])); print("gza dag", radix4frac1(Tibet_true_date_end_day(d,n)-gza0,7,[60,60,6,707])); print("tses khyud", radix4frac1(Tibet_moon_long_lunar_day(d,n),1,[27,60,60,6,67])); print("zla skar", radix4frac1(Tibet_moon_long_daybreak(d,n),1,[27,60,60,6,67])); print("sbyor ba",radix4frac1(Tibet_yoga(d,n),1,[27,60,60,6,67])); #print("byed ba",?????); end; Tibet_test3:=proc(d,m,l,yy) # prints lunar count and second "day factor" # and sgos zhag for planets (using E1987; otherwise the constant have # to be changed). # The sgos chag are correct for Henning's dates 8/3/1987, 14/5/1987, # 11/11/2006, 27/11/2006, but are shifted by 1 for Lai and Dolma's # 8/3/1994 (they have spyi chag = 2547 instead of 2548 local n,spyi,ldc; n:=Tibet_monthcount(m,l,yy); ldc:=30*n+d; print("lunar day count",ldc,ldc+71 mod 727); spyi:=Tibet_daycount(d,true,m,l,yy); print("spyi chag",spyi); print("Mars",spyi+115 mod 687); print("Jupiter",spyi+4246 mod 4332); print("Saturn",spyi+6696 mod 10766); print("Mercury",spyi*100+8386 mod 8797); print("Venus",spyi*10+1762 mod 2247); end; Tibet_test5:=proc(jd1,antal) # Compares two versions of tib_ano2 and stops at the first difference # Some examples found of a difference: # 2451951,2453866,2453867,2460999 local jd,t1,t2; global tib_ano2; for jd from jd1 to jd1+antal do tib_ano2:=1/28; t1:=Tibet4JD1(jd); tib_ano2:=(1+tib_ano1)/30; t2:=Tibet4JD1(jd); if not (t1=t2) then print(Greg4JD(jd)); error jd fi; od; end; Tibet_test6:=proc(jd1,antal) # Compares two versions of tib_ano2 and prints a list of jd for differences # Some examples found of a difference: # 2451951,2453866,2453867,2460999 PL # 2456934, 2459759, 2459760 TS local jd,t1,t2,l; global tib_ano2; l:=[]; for jd from jd1 to jd1+antal do tib_ano2:=1/28; t1:=Tibet4JD1(jd); tib_ano2:=(1+tib_ano1)/30; t2:=Tibet4JD1(jd); if not (t1=t2) then l:=[op(l),jd]; fi; if (jd mod 1000)=0 then print(jd) fi; od; l; end; Tibet_test7:=proc(jd1,antal,kod1,kod2) # Compares two versions of tib_ano2 and prints a list of jd for differences # Some examples found of a difference: local jd,t1,t2,l; global tib_ano2; l:=[]; for jd from jd1 to jd1+antal do Tibet_Init(kod1); t1:=Tibet4JD1(jd); Tibet_Init(kod2); t2:=Tibet4JD1(jd); if not (t1=t2) then l:=[op(l),jd]; fi; if (jd mod 1000)=0 then print(jd) fi; od; l; end; Tibet_test:=proc(yy,m) local d,n,gza0; n:=Tibet_monthcount(m,false,yy); for d to 30 do gza0:= tib_epok_806 mod 7; print(d,"gza bar", radix4frac1(Tibet_mean_date_end_day(d,n)-gza0,7,[60,60,6,707]), "gza dag", radix4frac1(Tibet_true_date_end_day(d,n)-gza0,7,[60,60,6,707])); od; end; tib_yoga_names:= ["rnam sel","mdza' bo","tshe dang ldan pa","skal bzang", "dge byed","shin tu 'grams","las bzang","'dzin byed","zug rgnu","'grams", "'phel","brtan pa","yongs bsnun","dga' ba","rdo rje","dngos grub", "phan tshun","mchog can","yongs 'joms","zhi ba","grub pa", "bsgrub bya","dge ba","dkar po","tshangs pa","dbang po","'khon 'dzin"]; # Yoga kalacakra.org (Henning) tib_yoga_names2:= ["sel ba","mdza' ba","tshe dang ldan pa","skal bzang","bzang po", "shin tu skrang","las bzang","'dzin pa","zug rngu","skrang", "'phel ba","nges pa","kun 'joms","dga' ba","rdo rje","grub pa", "shin tu lhung","mchog can","yongs 'joms","zhi ba","grub pa", "bsgrub bya","dge ba","dkar po","tshangs pa","dbang po","khon 'dzin"]; # Karanas kalacakra.org (Henning) tib_karana_names:= ["bkra shis","rkang bzhi","klu","mi sdug pa", "gdab pa","byis pa","rigs can","til rdung", "khyim skyes","tshong ba", "vishti"]; # Year names (Tibetan) in Prabhava cycle tib_year_tib:=[ "rab byung","rnam byung","dkar po","rab myos","skyes bdag", "anggi ra","dpal gdong","dngos po","na tshod ldan","'dzin byed", "dbang phyug","'bru mang po","myos ldan","rnam gnon","khyu mchog", "sna tshogs","nyi ma","nyi sgrol byed","sa skyong","mi zad", "thams cad 'dul","kun 'dzin","'gal ba","rnam 'gyur","bong bu", "dga' ba","rnam rgyal","rgyal ba","myos byed","gdong ngan", "gser 'phyang","rnam 'phyang","sgyur byed","kun ldan","'phar ba", "dge byed","mdzes byed","khro mo","sna tshogs dbyig","zil gnon", "spre'u","phur bu","zhi ba","thun mong","'gal byed", "yongs 'dzin","bag med","kun dga'","srin bu","me", "dmar ser can","dus kyi pho nya","don grub","drag po","blo ngan", "rnga chen","khrag skyug","mig dmar","khro bo","zad pa" ]; # Year names (Sanskrit) in Prabhava cycle tib_year_sanskrit:=[ "prabhava","vibhava","suklata","pramadi","prajapati", "ankira","srimukha","bhava","yuvika","dhritu", "isvara","vahudhvanya","pramadi","vikrama","brisabha", "citra","bhanu","bhanutara","virthapa","aksaya", "sarvajit","sarvadhari","virodhi","vikrita","khara", "nanda","vijaya","jaya","mada","durmukha", "hemalambha","vilambhi","vikari","sarvavati","slava", "subhakrita","sobhana","krodhi","visvabandhu","parabhava", "pravamga","kilaka","saumya","sadharana","virobhakrita", "paradhari","pramadi","ananda","raksasa","anala", "vingala","kaladuti","siddhartha","rudra","durmati", "dundubhi","rudhirura","raktaksi","krodhana","ksayaka" ]; fi;