(* :Name: ChineseLeapMonths.m *) (* :Context: ChineseLeapMonths` *) (* :Title: Chinese leap months and the date of Chinese New Year *) (* :Author: Helmer Aslaksen Department of Mathematics National University of Singapore Singapore 117543 Republic of Singapore http://www.math.nus.edu.sg/aslaksen/ *) (* :Mathematica Version: 3.0 *) (* :Package Version: 1.03, June 11, 1999 *) (* :History: 1.0, June 8, 1999 1.01, June 9, 1999: liChuen added 1.02, June 10, 1999: chineseNewYearData and daysToLiChuen added 1.03, June 11, 1999: m* and t* functions and timeToLiChuen added *) (* :Keywords: Chinese calendar, calendar, leap months, intercalation, Chinese New Year *) (* :Summary: ChineseLeapMonths is a package for computing information about Chinese leap months and the date of Chinese New Year. It is written by Helmer Aslaksen, Department of Mathematics, National University of Singapore, , http://www.math.nus.edu.sg/aslaksen/. It uses the functions written by Nachum Dershowitz and Edward M. Reingold for their book Calendrical Calculations, published by Cambridge University Press, ISBN 0-521-56474-3. Their Lisp functions were translated into the Mathematica package Calendrica by Robert C. McNally , which is available from their web site http://emr.cs.uiuc.edu/home/reingold/calendar-book/. *) (* :Warnings: The names of my functions have lower case initials to distinguish them from the functions of Robert C. McNally. I describe Chinese months by {gYear, cMonth}. I number a Chinese year by the Gregorian year in which it starts. So {1999,12} starts on January 7, 2000. *) (* :Copyright: Copyright 1999, Helmer Aslaksen *) (*********************** START OF PUBLIC CODE ***********************) BeginPackage["ChineseLeapMonths`",{"Calendrica`","Graphics`Graphics`", "Graphics`Common`GraphicsCommon`"}] ChineseLeapMonths::usage="ChineseLeapMonths is a package for computing information about Chinese leap months and the date of Chinese New Year. It is written by Helmer Aslaksen, Department of Mathematics, National University of Singapore, , http://www.math.nus.edu.sg/aslaksen/. It uses the functions written by Nachum Dershowitz and Edward M. Reingold for their book Calendrical Calculations, published by Cambridge University Press, ISBN 0-521-56474-3. Their Lisp functions were translated into the Mathematica package Calendrica by Robert C. McNally , which is available from their web site http://emr.cs.uiuc.edu/home/reingold/calendar-book/."; nthNewMoonOnOrAfterNewYear::usage="nthNewMoonOnOrAfterNewYear[gYear, n] gives the fixed date for the nth new moon on or after Chinese New Year in the given Gregorian year."; nthChineseMonth::usage="nthChineseMonth[gYear, n, leap] gives the Gregorian date for the new moon that starts the nth Chinese month in the Chinese year that starts in the given Gregorian year. If it is a leap month, add an extra variable equal to 1."; chineseNewMoonsInYear::usage="chineseNewMoonsInYear[gYear] lists the new moons in the Chinese year starting in the given Gregorian year."; majorSolarTermsInYear::usage="majorSolarTermsInYear[gYear] lists the major solar terms (zhongqi's) in the Chinese year starting in the given Gregorian year."; chineseLeapYearQ::usage="chineseLeapYearQ[gYear] returns True if the Chinese year starting in the given Gregorian year is a leap year."; chineseLeapSolsticeYearQ::usage="chineseLeapSolsticeYearQ[gYear] returns True if the Chinese solstice year starting in the year before the given Gregorian year has 13 months."; chineseLeapMonth::usage="chineseLeapMonth[gYear] gives the number of the month that is repeated if the Chinese year starting in the given Gregorian year is a Chinese leap year, and returns nothing if the given Gregorian year is not a Chinese leap year."; chineseLeapMonthQ::usage="chineseLeapMonthQ[gYear, n] returns True if the nth month of the Chinese year starting in the given Gregorian year has a leap month."; winterSolstice::usage="winterSolstice[gYear] gives the Gregorian date of the winter solstice of the given Gregorian year."; z12::usage="z12[gYear] gives the Gregorian date of the 12th zhongqi (major solar term) of the given Gregorian year."; liChuen::usage="liChuen[gYear] gives the Gregorian date of the lichuen (first minor solar term) of the given Gregorian year."; z1::usage="z1[gYear] gives the Gregorian date of the 1st zhongqi (major solar term) of the given Gregorian year."; z2::usage="z2[gYear] gives the Gregorian date of the 2nd zhongqi (major solar term) of the given Gregorian year."; chineseNewYearData::usage="chineseNewYearData[gYear] gives the Gregorian date of the astronomical events necessary to determine the date of Chinese New Year of the given Gregorian year and any possible leap months for months 11, 12 and 1."; mChineseNewYear::usage="mtChineseNewYear[gYear] gives the moment (fixed day with fractional part indicating time of day) for ChineseNewYear[gYear]."; tChineseNewYear::usage="tChineseNewYear[gYear] gives the Gregorian day and time for ChineseNewYear[gYear]."; mChineseNewMoonOnOrAfter::usage="mChineseNewMoonOnOrAfter[date] gives the moment (fixed day with fractional part indicating time of day) for ChineseNewMoonOnOrAfter[date]."; tChineseNewMoonOnOrAfter::usage="tChineseNewMoonOnOrAfter[date] gives the Gregorian day and time for ChineseNewMoonOnOrAfter[date]."; mChineseDateNextSolarLongitude::usage="mChineseDateNextSolarLongitude[d, l] gives the moment (fixed day with fractional part indicating time of day) for ChineseDateNextSolarLongitude[d, l]."; tChineseDateNextSolarLongitude::usage="tChineseDateNextSolarLongitude[d, l] gives the Gregorian day and time for ChineseDateNextSolarLongitude[d, l]."; mMajorSolarTermOnOrAfter::usage="mMajorSolarTermOnOrAfter[date] gives the moment (fixed day with fractional part indicating time of day) for MajorSolarTermOnOrAfter[date]."; tMajorSolarTermOnOrAfter::usage="tMajorSolarTermOnOrAfter[date] gives the Gregorian day and time for MajorSolarTermOnOrAfter[date]."; mMinorSolarTermOnOrAfter::usage="mMinorSolarTermOnOrAfter[date] gives the moment (fixed day with fractional part indicating time of day) for MinorSolarTermOnOrAfter[date]."; tMinorSolarTermOnOrAfter::usage="tMinorSolarTermOnOrAfter[date] gives the Gregorian day and time for MinorSolarTermOnOrAfter[date]."; daysToLiChuen::usage="daysToLiChuen[gYear] gives the number of days between lichuen (the first minor solar term) and Chinese New Year of the given Gregorian and the new moons before and after New Year."; timeToLiChuen::usage="timeToLiChuen[gYear] gives the time between lichuen (the first minor solar term) and Chinese New Year of the given Gregorian and the new moons before and after New Year."; chineseLeapYearsBetween::usage="chineseLeapYearsBetween[gYear1, gYear2] lists all the the years between the two given Gregorian years that are Chinese leap years."; chineseLeapMonthsBetween::usage="chineseLeapMonthsBetween[gYear1, gYear2] lists the year and the month number for the months that have a leap month between the two Gregorian years, and the total number of repeats for each month."; nthChineseLeapMonthsBetween::usage="nthChineseLeapMonthsBetween[gYear1, gYear2, n] counts the number of time the nth month is repeated between the two Gregorian years."; chineseNewYearsBetween::usage="chineseNewYearsBetween[gYear1, gYear2] displays the dates of Chinese New Year between the years gYear1 and gYear2 and gives a list and a table showing the number of times Chinese New Year falls on the days between January 20 and February 21 between the two Gregorian years."; (*********************** START OF PRIVATE CODE ***********************) Begin["`Private`"] nthNewMoonOnOrAfterNewYear[gYear_, n_]:= Fold[ (Calendrica`Private`ChineseNewMoonOnOrAfter[#1+#2])&, Calendrica`Private`ChineseNewYear[gYear], Table[1, {n-1}] ] (* This does not take into account a possible leap month *) nthChineseMonth[gYear_, n_, leap_:0]:= Gregorian[ If[chineseLeapYearQ[gYear], If[leap == 1, nthNewMoonOnOrAfterNewYear[gYear, n + 1], If[Calendrica`Private`PriorLeapMonthQ[ Calendrica`Private`ChineseNewYear[gYear], nthNewMoonOnOrAfterNewYear[gYear, n] ], nthNewMoonOnOrAfterNewYear[gYear, n + 1], nthNewMoonOnOrAfterNewYear[gYear, n] ] ], nthNewMoonOnOrAfterNewYear[gYear, n] ] ] (* This takes into account a possible leap month *) chineseNewMoonsInYear[gYear_]:= Map[Gregorian, FoldList[ (Calendrica`Private`ChineseNewMoonOnOrAfter[#1+#2])&, Calendrica`Private`ChineseNewYear[gYear], Table[1, {If[chineseLeapYearQ[gYear], 12, 11]}] ] ] majorSolarTermsInYear[gYear_]:= Map[Gregorian, Rest[ FoldList[ (Calendrica`Private`MajorSolarTermOnOrAfter[#1+#2])&, Calendrica`Private`ChineseNewYear[gYear], Table[1, {12}] ] ] ] chineseLeapYearQ[gYear_]:= Round[ (Calendrica`Private`ChineseNewYear[gYear+1] - Calendrica`Private`ChineseNewYear[gYear] ) / Calendrica`Private`MeanSynodicMonth[] ] == 13 chineseLeapSolsticeYearQ[gYear_]:= Round[ (Calendrica`Private`ChineseNewMoonOnOrAfter[ Calendrica`Private`MajorSolarTermOnOrAfter[ ToFixed[Gregorian[December[],15,gYear]] ] + 1 ] -Calendrica`Private`ChineseNewMoonOnOrAfter[ Calendrica`Private`MajorSolarTermOnOrAfter[ ToFixed[Gregorian[December[],15,gYear-1]] ] + 1 ] ) / Calendrica`Private`MeanSynodicMonth[] ] == 13 chineseLeapMonth[gYear_]:= Module[{i}, If[chineseLeapYearQ[gYear], If[chineseLeapSolsticeYearQ[gYear], For[i=2, i<= 11, i++, If[Calendrica`Private`NoMajorSolarTermQ[ nthNewMoonOnOrAfterNewYear[gYear, i]], Return[i-1] ] ], For[i=12, i<= 13, i++, If[Calendrica`Private`NoMajorSolarTermQ[ nthNewMoonOnOrAfterNewYear[gYear, i]], Return[i-1] ] ] ] ] ] chineseLeapMonthQ[gYear_, n_]:= (chineseLeapYearQ[gYear] && If[n < 11, chineseLeapSolsticeYearQ[gYear], chineseLeapSolsticeYearQ[gYear + 1] ] && Calendrica`Private`NoMajorSolarTermQ[ nthNewMoonOnOrAfterNewYear[gYear, n + 1] ] && If[n > 1,!chineseLeapMonthQ[gYear, n - 1],True] ) winterSolstice[gYear_]:= Gregorian[ Calendrica`Private`MajorSolarTermOnOrAfter[ ToFixed[Gregorian[December[],1,gYear]] ] ] z12[gYear_]:= Gregorian[ Calendrica`Private`MajorSolarTermOnOrAfter[ ToFixed[Gregorian[January[],1,gYear]] ] ] liChuen[gYear_]:= Gregorian[ Calendrica`Private`MinorSolarTermOnOrAfter[ ToFixed[Gregorian[February[],1,gYear]] ] ] z1[gYear_]:= Gregorian[ Calendrica`Private`MajorSolarTermOnOrAfter[ ToFixed[Gregorian[February[],1,gYear]] ] ] z2[gYear_]:= Gregorian[ Calendrica`Private`MajorSolarTermOnOrAfter[ ToFixed[Gregorian[March[],1,gYear]] ] ] chineseNewYearData[gYear_]:= (Print["Winter solstice:"winterSolstice[gYear-1]]; Print["Month 11+:"Gregorian[nthNewMoonOnOrAfterNewYear[gYear-1,12]]]; Print["zhongqi 12:"z12[gYear-1]]; If[(chineseLeapYearQ[gYear-1] && chineseLeapSolsticeYearQ[gYear]), Print["Month 11++: "Gregorian[nthNewMoonOnOrAfterNewYear[gYear-1,13]]]]; Print["Chinese New Year: "Gregorian[nthNewMoonOnOrAfterNewYear[gYear,1]]]; Print["Lichuen:"liChuen[gYear]]; Print["zhongqi 1:"z1[gYear]]; Print["Month 1+:"Gregorian[nthNewMoonOnOrAfterNewYear[gYear,2]]]; Print["zhongqi 2:"z2[gYear]]; Print["Month 1++:"Gregorian[nthNewMoonOnOrAfterNewYear[gYear,3]]] ) mChineseNewYear[gYear_]:= Module[{s1, s2, m1, m2, m11}, s1=Calendrica`Private`MajorSolarTermOnOrAfter[ ToFixed[Gregorian[December[], 15, gYear - 1]]]; s2=Calendrica`Private`MajorSolarTermOnOrAfter[ ToFixed[Gregorian[December[], 15, gYear]]]; m1=Calendrica`Private`ChineseNewMoonOnOrAfter[s1 + 1]; m2=Calendrica`Private`ChineseNewMoonOnOrAfter[m1 + 1]; m11=Calendrica`Private`ChineseNewMoonBefore[s2 + 1]; If[Round[(m11 - m1) / Calendrica`Private`MeanSynodicMonth[]] == 12 && (Calendrica`Private`NoMajorSolarTermQ[m1] || Calendrica`Private`NoMajorSolarTermQ[m2] ), mChineseNewMoonOnOrAfter[m2 + 1], mChineseNewMoonOnOrAfter[m1 + 1] ] ] tChineseNewYear[gYear_]:= Print[ Gregorian[Floor[mChineseNewYear[gYear]]], TimeOfDay[mChineseNewYear[gYear]] ] mChineseNewMoonOnOrAfter[date_]:= N[MomentFromJD[ LocalFromUniversal[ NewMoonAtOrAfter[ UniversalFromLocal[ JDFromMoment[date], Calendrica`Private`ChineseTimeZone[date] ] ], Calendrica`Private`ChineseTimeZone[date] ] ],10] tChineseNewMoonOnOrAfter[date_]:= Print[ Gregorian[Floor[mChineseNewMoonOnOrAfter[date]]], TimeOfDay[mChineseNewMoonOnOrAfter[date]] ] mChineseDateNextSolarLongitude[d_, l_]:= N[MomentFromJD[ LocalFromUniversal[ DateNextSolarLongitude[ UniversalFromLocal[ JDFromMoment[d], Calendrica`Private`ChineseTimeZone[d] ], l ], Calendrica`Private`ChineseTimeZone[d] ]],10 ] tChineseDateNextSolarLongitude[d_, l_]:= Print[ Gregorian[Floor[mChineseDateNextSolarLongitude[d, l]]], TimeOfDay[mChineseDateNextSolarLongitude[d, l]] ] mMajorSolarTermOnOrAfter[date_]:= mChineseDateNextSolarLongitude[date, 30] tMajorSolarTermOnOrAfter[date_]:= tChineseDateNextSolarLongitude[date, 30] mMinorSolarTermOnOrAfter[date_]:= Module[{d, s}, d=Calendrica`Private`ChineseDateNextSolarLongitude[date, 15]; s=SolarLongitude[ UniversalFromLocal[ JDFromMoment[d], Calendrica`Private`ChineseTimeZone[d] ] ]; If[Mod[Round[s], 30] == 0, mChineseDateNextSolarLongitude[d+1, 15], mChineseDateNextSolarLongitude[date, 15] ] ] tMinorSolarTermOnOrAfter[date_]:= Print[ Gregorian[Floor[mMinorSolarTermOnOrAfter[date]]], TimeOfDay[mMinorSolarTermOnOrAfter[date]] ] daysToLiChuen[gYear_]:= Module[{C,L,next,last}, C=Calendrica`Private`ChineseNewYear[gYear]; L=Calendrica`Private`MinorSolarTermOnOrAfter[ ToFixed[Gregorian[February[],1,gYear]]]; next=Calendrica`Private`ChineseNewMoonOnOrAfter[C+1]; last=Calendrica`Private`ChineseNewMoonOnOrAfter[C-35]; Print[gYear,": CNY-1 to LC: ",L-last,", CNY to LC: ",Abs[L-C],", CNY+1 to LC: ",next-L] ] timeToLiChuen[gYear_]:= Module[{C,L,next,last}, C=mChineseNewYear[gYear]; L=mMinorSolarTermOnOrAfter[ToFixed[Gregorian[February[],1,gYear]]]; next=mChineseNewMoonOnOrAfter[C+1]; last=mChineseNewMoonOnOrAfter[C-35]; Print[gYear,": CNY-1 to LC: ",L-last,", CNY to LC: ",Abs[L-C], ", CNY+1 to LC: ",next-L] ] chineseLeapYearsBetween[gYear1_, gYear2_]:= Module[{c=0}, For[i=gYear1, i<=gYear2, i++, If[chineseLeapYearQ[i], Print[i]; c++ ] ]; Print[c] ] chineseLeapMonthsBetween[gYear1_, gYear2_]:= Module[{L=Table[0, {12}]}, For[i=gYear1, i<= gYear2, i++, If[chineseLeapYearQ[i], j=chineseLeapMonth[i]; Print[i, ":", j]; L[[j]]++ ] ]; L ] nthChineseLeapMonthsBetween[gYear1_, gYear2_, n_]:= Module[{c=0}, For[i=gYear1, i<=gYear2, i++, If[chineseLeapMonthQ[i, n], Print[i]; c++; ] ]; Print[c] ] chineseNewYearsBetween[gYear1_, gYear2_]:= Module[{L=Table[0, {33}], M=Table[0, {33}], N=Table[0, {33}]}, For[i=gYear1, i<= gYear2, i++, (If[CMonth[Gregorian[Calendrica`Private`ChineseNewYear[i]]]==1, L[[CDay[Gregorian[Calendrica`Private`ChineseNewYear[i]]]-19]]++, L[[CDay[Gregorian[Calendrica`Private`ChineseNewYear[i]]]+12]]++ ]; j=Gregorian[Calendrica`Private`ChineseNewYear[i]]; Print[i, ":", j] ) ]; For[k=1,k<=12,k++, M[[k]]=ToString[k+19]<>"/1:"<>ToString[L[[k]]] ]; For[k=13,k<=33,k++, M[[k]]=ToString[k-12]<>"/2:"<>ToString[L[[k]]] ]; For[k=1,k<=12,k++, N[[k]]=ToString[k+19]<>"/1" ]; For[k=13,k<=33,k++, N[[k]]=ToString[k-12]<>"/2" ]; Print[M]; BarChart[L, BarOrientation->Horizontal, BarLabels->N, BarSpacing->0.3]; ] End[] EndPackage[]