Date subclass: #GregorianDate instanceVariableNames: 'mjd ' classVariableNames: '' poolDictionaries: '' category: 'SS-Date'! GregorianDate comment: '標準のDateクラスより精度の高い日付計算を行うために作成した、グレゴリオ暦を計算する日付クラス。インスタンスは特定の日付を修正ユリウス日で表わす。休日に関するメソッドは抽象メソッド。インスタンス変数 mjd 修正ユリウス日 Dateクラスのインスタンス変数dayとyearは使わない。'! !GregorianDate methodsFor: 'accessing'! day "年のはじめからの日数を返す。" "(GregorianDate fromString: '2 Jan 1997') day" ^self dayOfYear! dayOfYear "年のはじめからの日数を返す。" "(GregorianDate fromString: '2 Jan 1997') dayOfYear" ^(self mjd - (self class year: self year month: 1 newDay: 0) mjd) asInteger! leap "レシーバの年が閏年なら１を、さもなければ０を返す。" "GregorianDate today leap" ^self class leapYear: self year! month "return the month of self" ^self monthAux < 14 ifTrue: [^self monthAux - 1] ifFalse: [^self monthAux - 13]! monthIndex ^self month! year "return the year of self" ^self monthAux < 14 ifTrue: [^self yearAux - 4800] ifFalse: [^self yearAux - 4799]! ! !GregorianDate methodsFor: 'aspects'! mjdHolder ^self mjd1 isNil ifTrue: [self mjd1: nil asValue] ifFalse: [self mjd1]! ! !GregorianDate methodsFor: 'arithmetic'! addDays: dayCount "レシーバーにdayCount日数を足した日を返す。" "GregorianDate today addDays: 31" ^self class new mjd: self mjd + dayCount! addWeekDays: dayCount "レシーバーにウィークデーdayCount日数を足した日を返す。" "JapaneseDate today addWeekDays: 31" | beforeDate sign | sign := dayCount negated sign. beforeDate := self subtractWeekDaysAux: dayCount negated. beforeDate isDayOff ifTrue: [^beforeDate subtractWeekDaysAux: sign] ifFalse: [^beforeDate]! age "レシーバーが誕生日と考えて、年齢を返す。" "(GregorianDate fromString: '29 Sep 1951') age" | today | today := self class today. (today month < self month or: [today month = self month and: [today dayOfMonth < self dayOfMonth]]) ifTrue: [^self class today year - self year - 1] ifFalse: [^self class today year - self year]! elapsedDaysSince: aDate "Answer the number of elapsed days between the receiver and ." ^self mjd - aDate mjd! subtractDate: aDate "レシーバーとaDateの間の日数を返す。" "GregorianDate today subtractDate: (GregorianDate fromString: '29 Sep 1951')" ^(self mjd - aDate mjd) asInteger! subtractDays: dayCount "レシーバーのdayCount日前の日を返す。" "GregorianDate today subtractDays: 31" ^self class new mjd: self mjd - dayCount! subtractWeekDate: aDate "レシーバーとaDateの間のウィークデーの日数を返す。" "JapaneseDate today subtractWeekDate: (JapaneseDate fromString: '97-3-31')" | sign days absDays | days := self subtractDate: aDate. sign := days sign. absDays := days abs - (self occurrencesOfDayOffsBetween: aDate). ^absDays * sign! subtractWeekDays: dayCount "レシーバーのウィークデーでdayCount日前の日を返す。" "JapaneseDate today subtractWeekDays: 31" | beforeDate sign | sign := dayCount sign. beforeDate := self subtractWeekDaysAux: dayCount. beforeDate isDayOff ifTrue: [^beforeDate subtractWeekDaysAux: sign] ifFalse: [^beforeDate]! ! !GregorianDate methodsFor: 'comparing'! < aDate "Answer if the receiver is before ." ^self mjd < aDate mjd! = aDate "Answer whether the argument, aDate, is the same day as the receiver. " self species = aDate species ifTrue: [^self mjd asInteger = aDate mjd asInteger] ifFalse: [^false]! hash ^self mjd hash! ! !GregorianDate methodsFor: 'converting'! dayAsFloat ^self dateToYmdAux + 122.1d - (365.25d * self yearAux) truncated - (30.6001d * self monthAux) truncated! time ^Time fromSeconds: ((self dayAsFloat - self dayOfMonth) * 86400) truncated! toJST ^self addDays: 9 / 24! ! !GregorianDate methodsFor: 'inquiries'! dayNumber "曜日を数字で返す。日曜日＝０、土曜日＝６。" "GregorianDate today dayNumber" ^(self mjd truncated - 4) \\ 7! dayOfMonth "レシーバーが月の何日目かを返す。" "GregorianDate today dayOfMonth" ^self dayAsFloat truncated! firstDayOf: aDayNumber "レシーバーの月の、指定された＜aDayNumber＞曜日の最初の日を返す。" "GregorianDate today firstDayOf: 0" ^self class firstDayOf: aDayNumber year: self year month: self monthIndex! holiday "レシーバーの年の、休日をSortedCollectionとして返す。" "JapaneseDate today holiday" ^self class holidayAt: self year! holidaysBetween: aDate "レシーバとaDateの間の休日をSortedCollectionとして返す。" "JapaneseDate today holidaysBetween: (JapaneseDate fromString: '97-1-1')" | holidays | holidays := self holidaysBetweenAux: aDate. ^holidays select: [:holiday | holiday >= (self min: aDate) and: [holiday <= (self max: aDate)]]! lastDayOfWeek: dayOfTheWeek "レシーバーの月の、指定された＜aDayNumber＞曜日の最終日を返す。" "GregorianDate today lastDayOfWeek: #Friday" ^self class year: self year month: self monthIndex lastDayOfWeek: dayOfTheWeek! nthDayNumber: aDayNumber at: anInteger "レシーバーの月の、第＜anInteger＞曜日＜aDayNumber＞の日を返す。" "GregorianDate today nthDayNumber: 5 at: 3" ^self class nthDayNumber: aDayNumber year: self year month: self monthIndex at: anInteger! occurrencesOfDayOffsBetween: aDate "レシーバーとaDateの間の休みの日（日曜日＋休日）の日数を返す。レシーバーとaDateも休みであれば勘定に入れる。" "'97-1-1' asJapaneseDate occurrencesOfDayOffsBetween: (JapaneseDate fromString: '97-1-15')" "事後条件 -- S∈日曜日の集合・レシーバー≦S≦aDate、H∈休日の集合・レシーバー≦H≦aDateとして、 card(S) + card(H) - card(S∩H)を求める。" | sundays holidayNotSunday | sundays := self occurrencesOfSundaysBetween: aDate. holidayNotSunday := (self holidaysBetween: aDate) inject: 0 into: [:count :holiday | count + (holiday isSunday ifTrue: [0] ifFalse: [1])]. ^sundays + holidayNotSunday! occurrencesOfDayOfTheWeek: aDayNumber Between: aDate "レシーバーとaDateの間の＜aDayNumber＞曜日の日数を返す。レシーバーとaDateも指定された曜日であれば勘定に入れる。" "'97-2-21' asJapaneseDate occurrencesOfDayOfTheWeek: 5 Between:(JapaneseDate fromString: '97-2-28')" "事前条件 -- type R = {|rng [n → n / 7 | n∈Int]} /* 7で割った商の集合 */ f, t∈Int, w∈R, 0≦f≦t, h: Int → R /* 環準同型（ring homomorphism） */" "事後条件 -- S = dom h(w) ∩ {f..t}・A ≡ card(S) /* Aが答え */" | date fromDate toDate | fromDate := self min: aDate. toDate := self max: aDate. date := fromDate. [date dayNumber = (aDayNumber \\ 7)] whileFalse: [date := date addDays: 1]. ^(toDate subtractDate: date) // 7 + 1! occurrencesOfHolidaysBetween: aDate "レシーバーとaDateの間の休日の日数を返す。レシーバーとaDateも休日であれば勘定に入れる。" "JapaneseDate today occurrencesOfHolidaysBetween: (GregorianDate fromString: '1 Jan 1997')" | holidays | self = aDate ifTrue: [^0]. holidays := self holidaysBetween: aDate. ^holidays size! occurrencesOfSundaysBetween: aDate "レシーバーとaDateの間の日曜日の日数を返す。レシーバーとaDateも日曜日であれば勘定に入れる。" "GregorianDate today occurrencesOfSundaysBetween: (GregorianDate fromString: '1 Jan 1997')" ^self occurrencesOfDayOfTheWeek: 0 Between: aDate! ! !GregorianDate methodsFor: 'private'! dateToYmdAux "Private" | jd century | jd := self class mjdToJd: self mjd. jd > 2.29916d6 ifTrue: [century := (jd + 32044.9d) // 36524.25d. ^jd + 32044.9d + century - (century // 4.0d) + 0.5d] ifFalse: [^jd + 32082.9d + 0.5d]! holidaysBetweenAux: aDate "Private" | holidays | holidays := OrderedCollection new. (self year min: aDate year) to: (self year max: aDate year) do: [:y | holidays addAll: (self class holidayAt: y)]. ^holidays asSortedCollection! mjd "Private -- return the mjd = Modified Julian Day" ^self mjdHolder value! mjd1 ^mjd! mjd1: anObject ^mjd := anObject! mjd: aDouble self mjdHolder value: aDouble! monthAux "Private" ^(self dateToYmdAux + 122.1d - (365.25d * self yearAux) truncated) // 30.6001d! subtractWeekDaysAux: dayCount "Private" | beforeDate beforeDate2 sign count | sign := dayCount sign. beforeDate := self subtractDays: dayCount. count := (self occurrencesOfDayOffsBetween: beforeDate) * sign. beforeDate2 := beforeDate. [count abs > 0] whileTrue: [beforeDate2 := beforeDate subtractDays: count. count := (beforeDate occurrencesOfDayOffsBetween: beforeDate2) * sign. beforeDate := beforeDate2]. ^beforeDate2! yearAux "Private" ^self dateToYmdAux // 365.25d! ! !GregorianDate methodsFor: 'testing'! isDayOff "レシーバが休みの日（日曜＋休日）かどうかを返す。" ^self isSunday or: [self isHoliday]! isHoliday "レシーバーが休日かどうかを返す。" ^(self class holidayAt: self year) includes: self! isSaturday "レシーバーが土曜日かどうかを返す。" ^self dayNumber = 6! isSunday "レシーバーが日曜日かどうかを返す。" ^self dayNumber = 0! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! GregorianDate class instanceVariableNames: ''! !GregorianDate class methodsFor: 'private'! holidayAt: year self subclassResponsibility! jdMinusMjd "Private -- ユリウス日と修正ユリウス日との差を返す" ^24000005 / 10! ! !GregorianDate class methodsFor: 'displaying'! calendarForMonth: month year: year "year年month月のカレンダーを文字列として返す。" "GregorianDate calendarForMonth: 2 year: 1997" "GregorianDate calendarForMonth: 6 year: 2002" | aDate lastDate output firstDayIndex | output := WriteStream on: (String new: 200). #(0 1 2 3 4 5 6) do: [:i | output nextPutAll: ((self nameOfDay: i) asString copyFrom: 1 to: 2)] andBetweenDo: [output space]. output cr. aDate := self year: year month: month newDay: 1. firstDayIndex := aDate dayNumber. lastDate := self year: year month: month + 1 newDay: 0. output cr. 0 to: firstDayIndex - 1 do: [:i | output nextPutAll: ' ']. 0 to: (lastDate subtractDate: aDate) do: [:i | aDate dayOfMonth < 10 ifTrue: [output space]. aDate dayOfMonth printOn: output. output space. aDate := aDate addDays: 1. i \\ 7 = 0 ifTrue: [output cr]]. ^output contents! ! !GregorianDate class methodsFor: 'inquiries'! autumnalEquinoxDate: year "秋分の日を返す。参考文献Jean Meeus,「Astronomical Formulae for Calculators」(3ed Ed.,Willmann-Bell,1985)" "GregorianDate autumnalEquinoxDate: 1997" | y | y := year / 1000. ^self jdToMjd: 1.7213256978d6 + (365.2425055d * year) - (y * y * (0.126689d - (0.0019401d * y)))! autumnalEquinoxDay: year "秋分の日を返す。9月23日だったら２３を返す。" "GregorianDate autumnalEquinoxDay: 1997" ^(23.2488d + (0.242194d * (year - 1980)) - ((year - 1980) // 4)) floor! dayOfWeek: dayName "Answer the index in a week, 0-6, of the day named dayName. Provide an error notification if no such day exists." "GregorianDate dayOfWeek: #Sunday" | result | result := WeekDayNames indexOf: dayName ifAbsent: [self error: dayName asString , ' is not a day of the week']. result = 7 ifTrue: [^0] ifFalse: [^result]! firstDayOf: aDayNumber year: aYear month: aMonth "aYear年aMonth月のaDayNumberで指定された曜日の最初の日を返す。" "GregorianDate firstDayOf: 1 year: 1997 month: 2" | aDate | aDate := self year: aYear month: aMonth newDay: 1. [aDate dayNumber = aDayNumber] whileFalse: [aDate := aDate addDays: 1]. ^aDate! nameOfDay: dayNumber "dayNumber(0..6)で指定された曜日をシンボルとして返す。" "GregorianDate nameOfDay: 0" "GregorianDate nameOfDay: 6" "DateクラスのdayNumber(1..7)との変換を行う。" ^super nameOfDay: (dayNumber = 0 ifTrue: [7] ifFalse: [dayNumber])! nthDayNumber: aDayNumber year: aYear month: aMonth at: anInteger "aYear年aMonth月のaDayNumber（0..6）で指定された第anInteger曜日を返す。" "GregorianDate nthDayNumber: 5 year: 1997 month: 2 at: 4" | aDate resultDate | anInteger <= 0 ifTrue: [^nil]. aDate := self firstDayOf: aDayNumber year: aYear month: aMonth. resultDate := aDate addDays: 7 * (anInteger - 1). resultDate monthIndex = aDate monthIndex ifTrue: [^resultDate] ifFalse: [^nil]! summerSolstice: year "夏至の日を返す。参考文献Jean Meeus,「Astronomical Formulae for Calculators」(3ed Ed.,Willmann-Bell,1985)" "GregorianDate summerSolstice: 1997" | y | y := year / 1000. ^self jdToMjd: 1.7212332486d6 + (365.2417284d * year) - (y * y * (0.053018d - (0.009332d * y)))! vernalEquinoxDate: year "春分の日を返す。参考文献Jean Meeus,「Astronomical Formulae for Calculators」(3ed Ed.,Willmann-Bell,1985) " "GregorianDate vernalEquinoxDate: 1997" | y | y := year / 1000. ^self jdToMjd: 1.7211392855d6 + (365.2421376d * year) + (y * y * (0.067919d - (0.0027879d * y)))! vernalEquinoxDay: year "春分の日を返す。３月２１日だったら２１を返す。" "GregorianDate vernalEquinoxDay: 1997" ^(20.8431d + (0.242194d * (year - 1980)) - ((year - 1980) // 4)) floor! winterSolstice: year "冬至の日を返す。参考文献Jean Meeus,「Astronomical Formulae for Calculators」(3ed Ed.,Willmann-Bell,1985)" "GregorianDate winterSolstice: 1995" | y | y := year / 1000. ^self jdToMjd: 1.721414392d6 + (365.2428898d * year) - (y * y * (0.010965d - (0.0084855d * y)))! year: year month: month firstDayOfWeek: dayOfTheWeek "year年month月の最初の指定された曜日（#Mondayなどと指定）の日を返す。" "GregorianDate year: 1997 month: 2 lastDayOfWeek: #Monday" | dayNumber startDate result | dayNumber := self dayOfWeek: dayOfTheWeek. startDate := self year: year month: month newDay: 0. 1 to: 7 do: [:i | (result := startDate addDays: i) dayNumber = dayNumber ifTrue: [^result]]. ^nil! year: year month: month index: weekCount dayOfWeek: dayOfTheWeek "year年month月のdayOfTheWeek（#Sundayなど）で指定される曜日の第month曜日を返す。" "GregorianDate year: 1997 month: 2 index: 4 dayOfWeek: #Friday" | result | result := self year: year month: month firstDayOfWeek: dayOfTheWeek. result := result addDays: 7 * (weekCount - 1). result monthIndex = month ifTrue: [^result] ifFalse: [^nil]. ^nil! year: year month: month lastDayOfWeek: dayOfTheWeek "year年month月のdayOfTheWeek（#Sundayなど）で指定される曜日の最後の日を返す。" "GregorianDate year: 1997 month: 2 lastDayOfWeek: #Friday" | dayNumber startDate result | dayNumber := self dayOfWeek: dayOfTheWeek. startDate := self year: year month: month + 1 newDay: 1. 1 to: 7 do: [:i | (result := startDate subtractDays: i) dayNumber = dayNumber ifTrue: [^result]]. ^nil! ! !GregorianDate class methodsFor: 'instance creation'! fromString: dateString | aDate | aDate := super fromString: dateString. ^self year: aDate year month: aDate monthIndex newDay: aDate dayOfMonth! today "今日を返す。" "GregorianDate today" | today | today := self dateAndTimeNow first. ^self year: today year month: today monthIndex newDay: today dayOfMonth! year: year month: month newDay: day "year年month月day日を返す" "GregorianDate year: 1997 month: 2 newDay: 26" | y m century cc date | month > 2 ifTrue: [y := year + 4800. m := month + 1] ifFalse: [y := year + 4799. m := month + 13]. century := y // 100. (self dateToYear: year month: month day: day) > 1582.78d ifTrue: [cc := century // 4 - century - 32167.0d] ifFalse: [cc := -32205.0d]. date := self new. date mjd: (365.25d * y) truncated + (30.6001d * m) truncated + day + cc - 0.5d - self jdMinusMjd. ^date! ! !GregorianDate class methodsFor: 'converting'! dateToYear: year month: month day: day "year年month月day日を実数の年で表わす。" "GregorianDate dateToYear: 1997 month: 12 day: 1" ^year + ((month - 1) / 12.0) + ((day - 1.0) / 365.25)! jdToMjd: jd "ユリウス日を修正ユリウス日に変換する。" "GregorianDate jdToMjd: 2450000" ^self new mjd: jd - self jdMinusMjd! mjdToJd: mjd "修正ユリウス日をユリウス日に変換する。" "GregorianDate mjdToJd: 0" ^mjd + self jdMinusMjd! ! !GregorianDate class methodsFor: 'examples'! example1 "GregorianDate example1" ^self calendarForMonth: 5 year: 1996! example2 "GregorianDate example2" ^'97-1-1' asJapaneseDate occurrencesOfDayOffsBetween: (JapaneseDate fromString: '97-1-15')! example3 "GregorianDate example3" ^(self fromString: '10 October 1995') = '10 October 1995' asGregorianDate! ! GregorianDate subclass: #JapaneseDate instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SS-Date'! JapaneseDate comment: '日本の休日を考慮したグレゴリオ暦日付クラス。'! !JapaneseDate methodsFor: 'converting'! toUT ^self subtractDays: 0.375! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! JapaneseDate class instanceVariableNames: ''! !JapaneseDate class methodsFor: 'private'! holidayAt: year "1948年以後の日本の休日をインスタンス変数holidayへセットする。1948年以前については、現在不明。" | holiday additionalHoliday | holiday := OrderedCollection new: 30. year >= 1948 ifTrue: [holiday add: (self year: year month: 1 newDay: 1). "正月" "成人の日" holiday add: (self year: year month: 1 newDay: 15). year >= 1966 ifTrue: [holiday add: (self year: year month: 2 newDay: 11)]. "建国記念日" holiday add: (self year: year month: 3 newDay: (self vernalEquinoxDay: year)). "春分" holiday add: (self year: year month: 4 newDay: 29). "緑の日" holiday add: (self year: year month: 5 newDay: 3). "憲法記念日" holiday add: (self year: year month: 5 newDay: 5). year >= 1996 ifTrue: ["海の日" holiday add: (self year: year month: 7 newDay: 20)]. year >= 1966 ifTrue: [holiday add: (self year: year month: 9 newDay: 15)]. "敬老の日" holiday add: (self year: year month: 9 newDay: (self autumnalEquinoxDay: year)). year >= 1966 ifTrue: ["秋分" holiday add: (self year: year month: 10 newDay: 10)]. "体育の日" holiday add: (self year: year month: 11 newDay: 3). "文化の日" holiday add: (self year: year month: 11 newDay: 23). year >= 1989 ifTrue: ["天皇誕生日" "kinrou kansya no hi" holiday add: (self year: year month: 12 newDay: 23)]]. additionalHoliday := OrderedCollection new: 13. additionalHoliday add: (self year: year month: 5 newDay: 4). holiday do: [:eachHoliday | eachHoliday isSunday ifTrue: [additionalHoliday add: (eachHoliday addDays: 1)]]. "振替休日" ^(holiday addAll: additionalHoliday; yourself) asSortedCollection! monthNames "Private" "Answer a Dictionary mapping month names to indexes." ^MonthNames! ! !JapaneseDate class methodsFor: 'examples'! example1 "JapaneseDate example1" ^self year: 1996 month: 5 newDay: 1! example100 "JapaneseDate example100" | result1 | result1 := List new. 1980 to: 2099 do: [:year | result1 add: (self autumnalEquinoxDay: year). result1 add: (self autumnalEquinoxDate: year)]. ^result1! example101 "JapaneseDate example101" | result1 day1 day2 | result1 := List new. 1980 to: 2099 do: [:year | day1 := self autumnalEquinoxDay: year. day2 := (self autumnalEquinoxDate: year) dayOfMonth. day1 = day2 ifFalse: [result1 add: (Association key: year value: day1). result1 add: (Association key: year value: day2)]]. ^result1! example102 "JapaneseDate example102" | result1 | result1 := List new. 1980 to: 2099 do: [:year | result1 add: (self vernalEquinoxDay: year). result1 add: (self vernalEquinoxDate: year)]. ^result1! example103 "JapaneseDate example103" | result1 day1 day2 | result1 := List new. 1980 to: 2099 do: [:year | day1 := self vernalEquinoxDay: year. day2 := (self vernalEquinoxDate: year) dayOfMonth. day1 = day2 ifFalse: [result1 add: (Association key: year value: day1). result1 add: (Association key: year value: day2)]]. ^result1! example2 "JapaneseDate example2" ^self holidayAt: 1998! example3 "JapaneseDate example3" ^(self fromString: '1996-6-30') = '1996-6-30' asJapaneseDate! example4 "JapaneseDate example4" ^'1995 5 3' asJapaneseDate holidaysBetween: '1995 5 3' asJapaneseDate! example5 "JapaneseDate example5" ^'1995/5/3' asJapaneseDate occurrencesOfHolidaysBetween: '1995/5/5' asJapaneseDate! example6 "JapaneseDate example6" ^'1996 6 1' asJapaneseDate occurrencesOfDayOfTheWeek: 0 Between: '1996 6 30' asJapaneseDate! ! !JapaneseDate class methodsFor: 'inquiries'! autumnalEquinoxDate: year "algorithm from Jean Meeus, Astronomical Formulae for Calculators(3ed Ed.,Willmann-Bell,1985)" ^(super autumnalEquinoxDate: year) toJST! summerSolstice: year ^(super summerSolstice: year) toJST! vernalEquinoxDate: year ^(super vernalEquinoxDate: year) toJST! winterSolstice: year ^(super winterSolstice: year) toJST! ! !JapaneseDate class methodsFor: 'instance creation'! readFrom: aStream "Answer a JapaneseDate read from the argument aStream in the forms: (1996/6/30, 1996-6-30, 1996 6 30)" | year month day | [aStream peek isAlphaNumeric] whileFalse: [aStream skip: 1]. aStream peek isDigit ifTrue: [| today | year := Integer readFrom: aStream. today := self today. (year < 100 and: [today year >= 100]) ifTrue: [year := today year // 100 * 100 + year]]. [aStream peek isAlphaNumeric] whileFalse: [aStream skip: 1]. aStream peek isDigit ifTrue: [month := Integer readFrom: aStream]. [aStream peek isAlphaNumeric] whileFalse: [aStream skip: 1]. aStream peek isDigit ifTrue: [day := Integer readFrom: aStream]. ^self year: year month: month newDay: day! !