LTD Puzzle 13: Calculate the moon phase

[chrissie1]

Calculate the phase of the moon as accurately as possible.

We all know that a moon month is not as long as a normal month. It is about 29.53 days long, but that is an average and not very accurate. SO you will have to find a better implementation than this one: http://www.voidware.com/moon_phase.htm

And for those having fun, once you have that, the calculation of Easter is easy.

This can take some research.

So you enter a date and get a % visibility, the calculation (the number that specifies the moon month / phase time corresponding to the "normal" time) and your calculation transformed to a time in days/hours and minutes.

Here is the test data and some results.

Dates are (dd/mm/yyyy)

Date	Visibility	Moon Phase Number	Moon Phase Time
29/08/2008 13:56:00	9 %	28.275	28d 6h 36m
30/08/2008 13:56:00	2 %	29.276	29d 6u 37m
31/08/2008 13:56:00	5 %	0.745	0d 17h 53m

[chrissie1]

So here is my implementation in VB.Net

Class: Moonday

vbnetLine number Off | Show | Select all

1. Namespace Moonphase
2.     ''' <summary>
3.     '''
4.     ''' </summary>
5.     ''' <remarks></remarks>
6.     <CLSCompliant(True)> _
7.     Public Class MoonDay
8.  
9. #Region " Private members "
10.         ''' <summary>
11.         '''
12.         ''' </summary>
13.         ''' <remarks></remarks>
14.         Private _Day As DateTime
15.         ''' <summary>
16.         '''
17.         ''' </summary>
18.         ''' <remarks></remarks>
19.         Private _Visibility As Integer
20.         ''' <summary>
21.         '''
22.         ''' </summary>
23.         ''' <remarks></remarks>
24.         Private _Age As String
25.         ''' <summary>
26.         '''
27.         ''' </summary>
28.         ''' <remarks></remarks>
29.         Private _MoonNumber As Double
30.         ''' <summary>
31.         '''
32.         ''' </summary>
33.         ''' <remarks></remarks>
34.         Private _SmallestQuarter As Quarter
35. #End Region
36.  
37. #Region " Constants "
38.         ''' <summary>
39.         '''
40.         ''' </summary>
41.         ''' <remarks></remarks>
42.         Const _MoonConstant As Double = 29.53058868
43. #End Region
44.  
45. #Region " Constructors "
46.         ''' <summary>
47.         '''
48.         ''' </summary>
49.         ''' <param name="Day"></param>
50.         ''' <param name="SmallestQuarter"></param>
51.         ''' <remarks></remarks>
52.         Public Sub New(ByVal Day As DateTime, ByVal SmallestQuarter As Quarter)
53.             _SmallestQuarter = SmallestQuarter
54.             _Day = Day
55.             _MoonNumber = CalculateMonday()
56.             _Age = CalculateAge()
57.             _Visibility = CalculateVisibility()
58.         End Sub
59. #End Region
60.  
61. #Region " Public properties "
62.         ''' <summary>
63.         '''
64.         ''' </summary>
65.         ''' <value></value>
66.         ''' <returns></returns>
67.         ''' <remarks></remarks>
68.         Public Property Day() As DateTime
69.             Get
70.                 Return _Day
71.             End Get
72.             Set(ByVal Value As Date)
73.                 _Day = Value
74.                 _MoonNumber = CalculateMonday()
75.                 _Age = CalculateAge()
76.             End Set
77.         End Property
78.  
79.         ''' <summary>
80.         '''
81.         ''' </summary>
82.         ''' <value></value>
83.         ''' <returns></returns>
84.         ''' <remarks></remarks>
85.         Public ReadOnly Property MoonNumber() As Double
86.             Get
87.                 Return _MoonNumber
88.             End Get
89.         End Property
90.  
91.         ''' <summary>
92.         '''
93.         ''' </summary>
94.         ''' <value></value>
95.         ''' <returns></returns>
96.         ''' <remarks></remarks>
97.         Public ReadOnly Property Visibility() As Integer
98.             Get
99.                 Return _Visibility
100.             End Get
101.         End Property
102.  
103.         ''' <summary>
104.         '''
105.         ''' </summary>
106.         ''' <value></value>
107.         ''' <returns></returns>
108.         ''' <remarks></remarks>
109.         Public ReadOnly Property Age() As String
110.             Get
111.                 Return _Age
112.             End Get
113.         End Property
114. #End Region
115.  
116. #Region " Private methods "
117.         ''' <summary>
118.         '''
119.         ''' </summary>
120.         ''' <returns></returns>
121.         ''' <remarks></remarks>
122.         Private Function CalculateMonday() As Double
123.             Dim result As Double = 0
124.             If _SmallestQuarter.Name.ToLower = "new moon" Then
125.                 result = DateDiff(DateInterval.Second, _SmallestQuarter.QuarterDate, _Day)
126.                 result = result / 60 / 60 / 24
127.                 If result < 0 Then
128.                     result = GetSynodicPeriod(_Day) + result
129.                 End If
130.             End If
131.             Return result
132.         End Function
133.  
134.         ''' <summary>
135.         '''
136.         ''' </summary>
137.         ''' <param name="datum"></param>
138.         ''' <returns></returns>
139.         ''' <remarks></remarks>
140.         Private Function GetSynodicPeriod(ByVal datum As Date) As Double
141.             Dim t As Double = (GetJuliandate(datum) - 2451545) / 36525
142.             Return _MoonConstant + (0.00000021621 * t) - 3.64 * (10 ^ -10 * t ^ 2)
143.         End Function
144.  
145.         ''' <summary>
146.         '''
147.         ''' </summary>
148.         ''' <param name="dt"></param>
149.         ''' <returns></returns>
150.         ''' <remarks></remarks>
151.         Private Function GetJuliandate(ByVal dt As DateTime) As Double
152.             Dim a As Double = Math.Floor(dt.Year / 100)
153.             Dim b As Double = Math.Floor(a / 4)
154.             Dim c As Double = 2 - a + b
155.             Dim d As Double = dt.Day
156.             Dim e As Double = Math.Floor(365.25 * (dt.Year + 4716))
157.             Dim f As Double = Math.Floor(30.6001 * (dt.Month + 1))
158.             Dim jd As Double = c + d + e + f - 1521.5
159.             Return jd
160.         End Function
161.  
162.         ''' <summary>
163.         '''
164.         ''' </summary>
165.         ''' <returns></returns>
166.         ''' <remarks></remarks>
167.         Private Function CalculateAge() As String
168.             Dim dagen As Double = 0
169.             Dim uren As Double = 0
170.             Dim minuten As Double = 0
171.             dagen = Fix(_MoonNumber)
172.             uren = (_MoonNumber - dagen) * 24
173.             minuten = (uren - Fix(uren)) * 60
174.             Return dagen & "d " & Fix(uren) & "u " & Fix(minuten) & "m"
175.         End Function
176.  
177.         ''' <summary>
178.         '''
179.         ''' </summary>
180.         ''' <returns></returns>
181.         ''' <remarks></remarks>
182.         Private Function CalculateVisibility() As Integer
183.             If _MoonNumber > (_MoonConstant / 2) Then
184.                 Return Convert.ToInt32((_MoonConstant - _MoonNumber) / _MoonConstant * 100 * 2)
185.             Else
186.                 Return Convert.ToInt32((_MoonNumber) / _MoonConstant * 100 * 2)
187.             End If
188.         End Function
189. #End Region
190.  
191.     End Class
192. End Namespace
193.  

Code is hidden, SHOW

Class Quarter

vbnetLine number Off | Show | Select all

1. Namespace Moonphase
2.     ''' <summary>
3.     '''
4.     ''' </summary>
5.     ''' <remarks></remarks>
6.     Public Class Quarter
7.  
8. #Region " Private members "
9.         ''' <summary>
10.         '''
11.         ''' </summary>
12.         ''' <remarks></remarks>
13.         Private _QuarterDate As Date
14.         ''' <summary>
15.         '''
16.         ''' </summary>
17.         ''' <remarks></remarks>
18.         Private _Name As String
19. #End Region
20.  
21. #Region " Constructors "
22.         ''' <summary>
23.         '''
24.         ''' </summary>
25.         ''' <remarks></remarks>
26.         Public Sub New(ByVal Name As String, ByVal QuarterDate As Date)
27.             _Name = Name
28.             _QuarterDate = QuarterDate
29.         End Sub
30. #End Region
31.  
32. #Region " Public properties "
33.         ''' <summary>
34.         '''
35.         ''' </summary>
36.         ''' <value></value>
37.         ''' <returns></returns>
38.         ''' <remarks></remarks>
39.         Public Property QuarterDate() As Date
40.             Get
41.                 Return _QuarterDate
42.             End Get
43.             Set(ByVal Value As Date)
44.                 _QuarterDate = Value
45.             End Set
46.         End Property
47.  
48.         ''' <summary>
49.         '''
50.         ''' </summary>
51.         ''' <value></value>
52.         ''' <returns></returns>
53.         ''' <remarks></remarks>
54.         Public Property Name() As String
55.             Get
56.                 Return _Name
57.             End Get
58.             Set(ByVal Value As String)
59.                 _Name = Value
60.             End Set
61.         End Property
62. #End Region
63.  
64.     End Class
65. End Namespace

Code is hidden, SHOW

Class Quarters

vbnetLine number Off | Show | Select all

1. Namespace Moonphase
2.     ''' <summary>
3.     '''
4.     ''' </summary>
5.     ''' <remarks></remarks>
6.     Public Class Quarters
7.  
8. #Region " Private members "
9.         ''' <summary>
10.         '''
11.         ''' </summary>
12.         ''' <remarks></remarks>
13.         Private _Quarters As New Collection
14. #End Region
15.  
16. #Region " Constructors "
17.         ''' <summary>
18.         '''
19.         ''' </summary>
20.         ''' <param name="Year"></param>
21.         ''' <param name="Month"></param>
22.         ''' <remarks></remarks>
23.         Public Sub New(ByVal Year As Integer, ByVal Month As Integer)
24.             Me.MakeYear(Year, Month)
25.         End Sub
26. #End Region
27.  
28. #Region " Public properties "
29.         ''' <summary>
30.         '''
31.         ''' </summary>
32.         ''' <value></value>
33.         ''' <returns></returns>
34.         ''' <remarks></remarks>
35.         Public ReadOnly Property Quarters() As Collection
36.             Get
37.                 Return _Quarters
38.             End Get
39.         End Property
40. #End Region
41.  
42. #Region " Private methods "
43.         ''' <summary>
44.         '''
45.         ''' </summary>
46.         ''' <param name="Julian"></param>
47.         ''' <returns></returns>
48.         ''' <remarks></remarks>
49.         Private Function ToGregorian(ByVal Julian As Double) As DateTime
50.             Dim _Date(2) As Integer
51.             Dim _Time(2) As Integer
52.             Dim _JulianRounded As Double = 0
53.             Dim dbla, dblb, dblc, dbld, dble, dblf, dblalpha As Double
54.             Dim _MoonNumber As Double
55.             Dim _Seconds As Double
56.  
57.             Julian += 0.5
58.             _JulianRounded = Math.Floor(Julian)
59.             dblf = Julian - _JulianRounded
60.  
61.             If (_JulianRounded < 2299161.0) Then
62.                 dbla = _JulianRounded
63.             Else
64.                 dblalpha = Math.Floor((_JulianRounded - 1867216.25) / 36524.25)
65.                 dbla = _JulianRounded + 1 + dblalpha - Math.Floor(dblalpha / 4)
66.             End If
67.  
68.             dblb = dbla + 1524
69.             dblc = Math.Floor((dblb - 122.1) / 365.25)
70.             dbld = Math.Floor(365.25 * dblc)
71.             dble = Math.Floor((dblb - dbld) / 30.6001)
72.             If dble < 14 Then
73.                 _MoonNumber = Math.Floor(dble - 1)
74.             Else
75.                 _MoonNumber = Math.Floor(dble - 13)
76.             End If
77.             If _MoonNumber > 2 Then
78.                 _Date(0) = Convert.ToInt32(Format(Math.Floor(dblb - dbld - Math.Floor(30.6001 * dble) + dblf), "00"))
79.                 _Date(1) = Convert.ToInt32(Format(_MoonNumber, "00"))
80.                 _Date(2) = Convert.ToInt32(Format(Math.Floor(dblc - 4716), "00"))
81.             Else
82.                 _Date(0) = Convert.ToInt32(Format(Math.Floor(dblb - dbld - Math.Floor(30.6001 * dble) + dblf), "00"))
83.                 _Date(1) = Convert.ToInt32(Format(_MoonNumber, "00"))
84.                 _Date(2) = Convert.ToInt32(Format(Math.Floor(dblc - 4715), "00"))
85.             End If
86.             _Seconds = (Julian - Math.Floor(Julian)) * 86400.0
87.             _Time(0) = Convert.ToInt32(Format(Math.Floor(_Seconds / 3600), "00"))
88.             _Time(1) = Convert.ToInt32(Format(Math.Floor((_Seconds / 60) Mod 60), "00"))
89.             _Time(2) = Convert.ToInt32(Format(Math.Floor(_Seconds Mod 60), "00"))
90.             Return CDate(_Date(0) & "/" & _Date(1) & "/" & _Date(2) & " " & _Time(0) & ":" & _Time(1) & ":" & _Time(2))
91.         End Function
92.  
93.         ''' <summary>
94.         '''
95.         ''' </summary>
96.         ''' <param name="x"></param>
97.         ''' <returns></returns>
98.         ''' <remarks></remarks>
99.         Private Function dsin(ByVal x As Double) As Double
100.             Return Math.Sin(dtr(x))
101.         End Function
102.  
103.         ''' <summary>
104.         '''
105.         ''' </summary>
106.         ''' <param name="x"></param>
107.         ''' <returns></returns>
108.         ''' <remarks></remarks>
109.         Private Function dcos(ByVal x As Double) As Double
110.             Return Math.Cos(dtr(x))
111.         End Function
112.  
113.         ''' <summary>
114.         '''
115.         ''' </summary>
116.         ''' <param name="d"></param>
117.         ''' <returns></returns>
118.         ''' <remarks></remarks>
119.         Private Function dtr(ByVal d As Double) As Double
120.             Return (d * Math.PI) / 180.0
121.         End Function
122.  
123.         ''' <summary>
124.         '''
125.         ''' </summary>
126.         ''' <param name="k"></param>
127.         ''' <param name="phase"></param>
128.         ''' <returns></returns>
129.         ''' <remarks></remarks>
130.         Private Function truephase(ByVal k As Double, ByVal phase As Double) As Double
131.  
132.             Dim t, t2, t3, pt, m, mprime, f As Double
133.             Const SynMonth As Double = 29.53058868
134.  
135.             k += phase
136.             t = k / 1236.85
137.             t2 = t * t
138.             t3 = t2 * t
139.             pt = 2415020.75933 + SynMonth * k + 0.0001178 * t2 - 0.000000155 * t3 + 0.00033 * dsin(166.56 + 132.87 * t - 0.009173 * t2)
140.  
141.             m = 359.2242 + 29.10535608 * k - 0.0000333 * t2 - 0.00000347 * t3
142.             mprime = 306.0253 + 385.81691806 * k + 0.0107306 * t2 + 0.00001236 * t3
143.             f = 21.2964 + 390.67050646 * k - 0.0016528 * t2 - 0.00000239 * t3
144.             If ((phase < 0.01) Or (Math.Abs(phase - 0.5) < 0.01)) Then
145.                 pt += (0.1734 - 0.000393 * t) * dsin(m) + 0.0021 * dsin(2 * m) - 0.4068 * dsin(mprime) + 0.0161 * dsin(2 * mprime) - 0.0004 * dsin(3 * mprime) + 0.0104 * dsin(2 * f) - 0.0051 * dsin(m + mprime) - 0.0074 * dsin(m - mprime) + 0.0004 * dsin(2 * f + m) - 0.0004 * dsin(2 * f - m) - 0.0006 * dsin(2 * f + mprime) + 0.001 * dsin(2 * f - mprime) + 0.0005 * dsin(m + 2 * mprime)
146.             ElseIf ((Math.Abs(phase - 0.25) < 0.01 Or (Math.Abs(phase - 0.75) < 0.01))) Then
147.                 pt += (0.1721 - 0.0004 * t) * dsin(m) + 0.0021 * dsin(2 * m) - 0.628 * dsin(mprime) + 0.0089 * dsin(2 * mprime) - 0.0004 * dsin(3 * mprime) + 0.0079 * dsin(2 * f) - 0.0119 * dsin(m + mprime) - 0.0047 * dsin(m - mprime) + 0.0003 * dsin(2 * f + m) - 0.0004 * dsin(2 * f - m) - 0.0006 * dsin(2 * f + mprime) + 0.0021 * dsin(2 * f - mprime) + 0.0003 * dsin(m + 2 * mprime) + 0.0004 * dsin(m - 2 * mprime) - 0.0003 * dsin(2 * m + mprime)
148.             End If
149.             If (phase < 0.5) Then
150.                 pt += 0.0028 - 0.0004 * dcos(m) + 0.0003 * dcos(mprime)
151.             Else
152.                 ' Last quarter correction */
153.                 pt += -0.0028 + 0.0004 * dcos(m) - 0.0003 * dcos(mprime)
154.             End If
155.             Return pt
156.         End Function
157.  
158.         ''' <summary>
159.         '''
160.         ''' </summary>
161.         ''' <remarks></remarks>
162.         Private Sub MakeYear(ByVal Year As Integer, ByVal Month As Integer)
163.             Dim _Exit As Boolean = False
164.             Dim _Quarter As Quarter = Nothing
165.             Dim _FirstYear As Double = 0
166.             Dim _Time As Double = 0
167.             Dim _Year As Double = 0
168.             Dim _DatTime As DateTime
169.             Dim _Phases As Integer = 0
170.             Dim _NumberOfFullMoons As Integer = 0
171.             _Quarters = New Collection
172.  
173.             For _Phases = 0 To 3
174.                 _FirstYear = Math.Floor((Year - 1900) * 12.3685) - 4
175.                 _Exit = False
176.                 Do While _Exit = False
177.                     _Time = truephase(_FirstYear, _Phases / 4)
178.                     _Year = Me.ToGregorian(_Time).Year
179.                     If _Year >= Year Then
180.                         If _Time < 0 Then
181.                             _DatTime = Me.ToGregorian(-_Time)
182.                         Else
183.                             _DatTime = Me.ToGregorian(_Time)
184.                         End If
185.                         If _DatTime.Year = Year And _DatTime.Month = Month Then
186.                             Select Case _Phases
187.                                 Case Is = 0
188.                                     _Quarter = New Quarter("New moon", _DatTime)
189.                                 Case 1
190.                                     _Quarter = New Quarter("First quarter", _DatTime)
191.                                 Case 2
192.                                     _Quarter = New Quarter("Full moon", _DatTime)
193.                                     _NumberOfFullMoons += 1
194.                                 Case 3
195.                                     _Quarter = New Quarter("Last quarter", _DatTime)
196.                             End Select
197.                             _Quarters.Add(_Quarter)
198.                         End If
199.                     End If
200.                     If (_Year > Year) Then
201.                         _Exit = True
202.                     Else
203.                         _FirstYear += 1
204.                     End If
205.                 Loop
206.             Next
207.             SortCollection()
208.         End Sub
209. #End Region
210.  
211. #Region " Public methods "
212.         ''' <summary>
213.         '''
214.         ''' </summary>
215.         ''' <remarks></remarks>
216.         Public Sub SortCollection()
217.             Dim a, b As Quarter
218.             Dim i, i2 As Integer
219.             Dim Max As Integer = Me._Quarters.Count
220.             For i = 2 To Max
221.                 For i2 = 1 To _Quarters.Count - 1
222.                     a = CType(_Quarters.Item(i2), Quarter)
223.                     b = CType(_Quarters.Item(i2 + 1), Quarter)
224.                     If a.QuarterDate > b.QuarterDate Then
225.                         _Quarters.Remove(i2)
226.                         _Quarters.Add(b, , i2)
227.                         _Quarters.Remove(i2 + 1)
228.                         _Quarters.Add(a, , i2 + 1)
229.                     End If
230.                 Next
231.             Next
232.             Max -= 1
233.         End Sub
234. #End Region
235.  
236.     End Class
237. End Namespace

Code is hidden, SHOW

Class Moonmonth

vbnetLine number Off | Show | Select all

1. Namespace Moonphase
2.     Public Class MoonMonth
3.  
4. #Region " Private methods "
5.         ''' <summary>
6.         '''
7.         ''' </summary>
8.         ''' <remarks></remarks>
9.         Private _Month As DateTime
10.         ''' <summary>
11.         '''
12.         ''' </summary>
13.         ''' <remarks></remarks>
14.         Private _Days As New Dictionary(Of Integer, MoonDay)
15.         ''' <summary>
16.         '''
17.         ''' </summary>
18.         ''' <remarks></remarks>
19.         Private _Quarters As New Collection
20. #End Region
21.  
22. #Region " Constructors "
23.         ''' <summary>
24.         '''
25.         ''' </summary>
26.         ''' <param name="Month"></param>
27.         ''' <remarks></remarks>
28.         Public Sub New(ByVal Month As DateTime)
29.             _Month = Month
30.             FillQuarters()
31.             MakeCollection()
32.         End Sub
33. #End Region
34.  
35. #Region " Public properties "
36.         ''' <summary>
37.         '''
38.         ''' </summary>
39.         ''' <value></value>
40.         ''' <returns></returns>
41.         ''' <remarks></remarks>
42.         Public Property Month() As DateTime
43.             Get
44.                 Return _Month
45.             End Get
46.             Set(ByVal Value As Date)
47.                 _Month = Value
48.                 FillQuarters()
49.                 MakeCollection()
50.             End Set
51.         End Property
52.  
53.         ''' <summary>
54.         '''
55.         ''' </summary>
56.         ''' <value></value>
57.         ''' <returns></returns>
58.         ''' <remarks></remarks>
59.         Public ReadOnly Property Days() As Dictionary(Of Integer, MoonDay)
60.             Get
61.                 Return _Days
62.             End Get
63.         End Property
64.  
65.         ''' <summary>
66.         '''
67.         ''' </summary>
68.         ''' <value></value>
69.         ''' <returns></returns>
70.         ''' <remarks></remarks>
71.         Public ReadOnly Property Quarters() As Collection
72.             Get
73.                 Return _Quarters
74.             End Get
75.         End Property
76. #End Region
77.  
78. #Region " Private methods "
79.         ''' <summary>
80.         '''
81.         ''' </summary>
82.         ''' <remarks></remarks>
83.         Private Sub FillQuarters()
84.             _Quarters = New Quarters(_Month.Year, _Month.Month).Quarters
85.         End Sub
86.  
87.         ''' <summary>
88.         '''
89.         ''' </summary>
90.         ''' <remarks></remarks>
91.         Private Sub MakeCollection()
92.             'Kijk waar de nieuwe maan zit
93.             Dim intnieuwemaan As Integer = 0
94.             For inttemp As Integer = 1 To _Quarters.Count
95.                 If CType(_Quarters(inttemp), Quarter).Name.ToLower = "new moon" Then
96.                     intnieuwemaan = inttemp
97.                 End If
98.             Next
99.             'Omdat er niet altijd een nieuwe maan is nemen we de niewe maan van de vorige maand
100.             If intnieuwemaan = 0 Then
101.                 Dim _Quarters2 As New Collection
102.                 _Quarters2 = New Quarters(_Month.Year, _Month.Month - 1).Quarters
103.                 For inttemp As Integer = 1 To _Quarters2.Count
104.                     If CType(_Quarters2(inttemp), Quarter).Name.ToLower = "new moon" Then
105.                         intnieuwemaan = inttemp
106.                     End If
107.                 Next
108.                 'maak voor elke dag in deze maand een dag in de collectie
109.                 For inttemp As Integer = 1 To DateTime.DaysInMonth(_Month.Year, _Month.Month)
110.                     _Days.Add(inttemp, New MoonDay(Convert.ToDateTime(inttemp & "/" & _Month.Month & "/" & _Month.Year & " " & _Month.Hour & ":" & _Month.Minute & ":" & _Month.Second), CType(_Quarters2(intnieuwemaan), Quarter)))
111.                 Next
112.             Else
113.                 'maak voor elke dag in deze maand een dag in de collectie
114.                 For inttemp As Integer = 1 To DateTime.DaysInMonth(_Month.Year, _Month.Month)
115.                     _Days.Add(inttemp, New MoonDay(Convert.ToDateTime(inttemp & "/" & _Month.Month & "/" & _Month.Year & " " & _Month.Hour & ":" & _Month.Minute & ":" & _Month.Second), CType(_Quarters(intnieuwemaan), Quarter)))
116.                 Next
117.             End If
118.         End Sub
119. #End Region
120.     End Class
121. End Namespace

Code is hidden, SHOW

Main

vbnetLine number Off | Show | Select all

1. Module Module1
2.  
3.     Sub Main()
4.         Dim _MoonMonth As New Moonphase.MoonMonth(New Date(2008, 8, 28, 13, 56, 0))
5.         Dim _Moonday As Moonphase.MoonDay = _MoonMonth.Days(29)
6.         Console.WriteLine("Date: " & _Moonday.Day)
7.         Console.WriteLine("Moon Number: " & _Moonday.MoonNumber)
8.         Console.WriteLine("Moon Age: " & _Moonday.Age)
9.         Console.WriteLine("Moon Visibility: " & _Moonday.Visibility)
10.         _Moonday = _MoonMonth.Days(30)
11.         Console.WriteLine("Date: " & _Moonday.Day)
12.         Console.WriteLine("Moon Number: " & _Moonday.MoonNumber)
13.         Console.WriteLine("Moon Age: " & _Moonday.Age)
14.         Console.WriteLine("Moon Visibility: " & _Moonday.Visibility)
15.         _Moonday = _MoonMonth.Days(31)
16.         Console.WriteLine("Date: " & _Moonday.Day)
17.         Console.WriteLine("Moon Number: " & _Moonday.MoonNumber)
18.         Console.WriteLine("Moon Age: " & _Moonday.Age)
19.         Console.WriteLine("Moon Visibility: " & _Moonday.Visibility)
20.         Console.ReadLine()
21.     End Sub
22.  
23. End Module

Code is hidden, SHOW

You'll have to run it to see the result. But let's just say they are very close

[rizzo]

-takes a bow-
This should be accurate to within a second or so. (i hope )

vbnetLine number Off | Show | Select all

1. Module MoonTimer
2.     Public Const TicksPerDay As Long = 864000000000
3.     Public Const LunarMonth As Long = 25514429760000 'Number of microseconds / ticks in a lunar month to the nearest millisecond.
4.     Public Const NewMoonMark As Long = 632409553800000000 'New moon on 10th of january 2005 @ 12:03:00.
5.  
6.     Sub Main()
7.         Dim dtMoonDates(99) As DateTime
8.         Dim i As Integer
9.         For i = 0 To 99
10.             dtMoonDates(i) = DateTime.Now.AddDays(-49 + i)
11.         Next
12.         Console.WriteLine("+---------------------+--------+-----------+-----------------+")
13.         Console.WriteLine("|        Date         |  Vis   | Phase No. | Moon Phase Time |")
14.         Console.WriteLine("+---------------------+--------+-----------+-----------------+")
15.         For Each d As DateTime In dtMoonDates
16.             Dim MoonStrings As String() = GetMoonByDateTime(d)
17.             Console.WriteLine("| " & d.ToString("dd/MM/yyyy HH:mm:ss") & _
18.                               " | " & MoonStrings(0).PadRight(6) & _
19.                               " | " & MoonStrings(1).PadRight(9) & _
20.                               " | " & MoonStrings(2).PadRight(15) & _
21.                               " |")
22.         Next
23.         Console.WriteLine("+---------------------+--------+-----------+-----------------+")
24.     End Sub
25.  
26.     Public Function GetMoonByDateTime(ByVal dtMoonDate As DateTime) As String()
27.  
28.         Dim TimeSince1st As Long = dtMoonDate.Ticks - NewMoonMark
29.         Dim TimeSinceLast As Long = TimeSince1st Mod LunarMonth
30.         Dim TimeToNext As Long = LunarMonth - TimeSinceLast
31.         Dim TimeToFull As Long = IIf(TimeToNext > TimeSinceLast, TimeToNext - (LunarMonth / 2), TimeSinceLast - (LunarMonth / 2))
32.         Dim tsLast As TimeSpan = TimeSpan.FromTicks(TimeSinceLast)
33.         Dim tsNext As TimeSpan = TimeSpan.FromTicks(TimeToNext)
34.         Dim VisPerc As Decimal = Nothing
35.  
36.         Dim o As String() = New String() { _
37.         Math.Round(100 - (100 / (LunarMonth / 2)) * TimeToFull, 2) & "%", _
38.         Math.Round(tsLast.TotalDays, 3), _
39.         tsLast.Days & "d " & tsLast.Hours & "h " & tsLast.Minutes & "m "}
40.  
41.         Return o
42.     End Function
43.  
44. End Module
45.  

Code is hidden, SHOW

And the result...

textLine number Off | Show | Select all

1. +---------------------+--------+-----------+-----------------+
2. |        Date         |  Vis   | Phase No. | Moon Phase Time |
3. +---------------------+--------+-----------+-----------------+
4. | 12/12/2008 00:26:44 | 95.14% | 14.048    | 14d 1h 9m       |
5. | 13/12/2008 00:26:44 | 98.08% | 15.048    | 15d 1h 9m       |
6. | 14/12/2008 00:26:44 | 91.31% | 16.048    | 16d 1h 9m       |
7. | 15/12/2008 00:26:44 | 84.54% | 17.048    | 17d 1h 9m       |
8. | 16/12/2008 00:26:44 | 77.77% | 18.048    | 18d 1h 9m       |
9. | 17/12/2008 00:26:44 | 70.99% | 19.048    | 19d 1h 9m       |
10. | 18/12/2008 00:26:44 | 64.22% | 20.048    | 20d 1h 9m       |
11. | 19/12/2008 00:26:44 | 57.45% | 21.048    | 21d 1h 9m       |
12. | 20/12/2008 00:26:44 | 50.68% | 22.048    | 22d 1h 9m       |
13. | 21/12/2008 00:26:44 | 43.9%  | 23.048    | 23d 1h 9m       |
14. | 22/12/2008 00:26:44 | 37.13% | 24.048    | 24d 1h 9m       |
15. | 23/12/2008 00:26:44 | 30.36% | 25.048    | 25d 1h 9m       |
16. | 24/12/2008 00:26:44 | 23.59% | 26.048    | 26d 1h 9m       |
17. | 25/12/2008 00:26:44 | 16.81% | 27.048    | 27d 1h 9m       |
18. | 26/12/2008 00:26:44 | 10.04% | 28.048    | 28d 1h 9m       |
19. | 27/12/2008 00:26:44 | 3.27%  | 29.048    | 29d 1h 9m       |
20. | 28/12/2008 00:26:44 | 3.51%  | 0.518     | 0d 12h 25m      |
21. | 29/12/2008 00:26:44 | 10.28% | 1.518     | 1d 12h 25m      |
22. | 30/12/2008 00:26:44 | 17.05% | 2.518     | 2d 12h 25m      |
23. | 31/12/2008 00:26:44 | 23.82% | 3.518     | 3d 12h 25m      |
24. | 01/01/2009 00:26:44 | 30.6%  | 4.518     | 4d 12h 25m      |
25. | 02/01/2009 00:26:44 | 37.37% | 5.518     | 5d 12h 25m      |
26. | 03/01/2009 00:26:44 | 44.14% | 6.518     | 6d 12h 25m      |
27. | 04/01/2009 00:26:44 | 50.91% | 7.518     | 7d 12h 25m      |
28. | 05/01/2009 00:26:44 | 57.69% | 8.518     | 8d 12h 25m      |
29. | 06/01/2009 00:26:44 | 64.46% | 9.518     | 9d 12h 25m      |
30. | 07/01/2009 00:26:44 | 71.23% | 10.518    | 10d 12h 25m     |
31. | 08/01/2009 00:26:44 | 78%    | 11.518    | 11d 12h 25m     |
32. | 09/01/2009 00:26:44 | 84.78% | 12.518    | 12d 12h 25m     |
33. | 10/01/2009 00:26:44 | 91.55% | 13.518    | 13d 12h 25m     |
34. | 11/01/2009 00:26:44 | 98.32% | 14.518    | 14d 12h 25m     |
35. | 12/01/2009 00:26:44 | 94.91% | 15.518    | 15d 12h 25m     |
36. | 13/01/2009 00:26:44 | 88.13% | 16.518    | 16d 12h 25m     |
37. | 14/01/2009 00:26:44 | 81.36% | 17.518    | 17d 12h 25m     |
38. | 15/01/2009 00:26:44 | 74.59% | 18.518    | 18d 12h 25m     |
39. | 16/01/2009 00:26:44 | 67.81% | 19.518    | 19d 12h 25m     |
40. | 17/01/2009 00:26:44 | 61.04% | 20.518    | 20d 12h 25m     |
41. | 18/01/2009 00:26:44 | 54.27% | 21.518    | 21d 12h 25m     |
42. | 19/01/2009 00:26:44 | 47.5%  | 22.518    | 22d 12h 25m     |
43. | 20/01/2009 00:26:44 | 40.72% | 23.518    | 23d 12h 25m     |
44. | 21/01/2009 00:26:44 | 33.95% | 24.518    | 24d 12h 25m     |
45. | 22/01/2009 00:26:44 | 27.18% | 25.518    | 25d 12h 25m     |
46. | 23/01/2009 00:26:44 | 20.41% | 26.518    | 26d 12h 25m     |
47. | 24/01/2009 00:26:44 | 13.63% | 27.518    | 27d 12h 25m     |
48. | 25/01/2009 00:26:44 | 6.86%  | 28.518    | 28d 12h 25m     |
49. | 26/01/2009 00:26:44 | 0.09%  | 29.518    | 29d 12h 25m     |
50. | 27/01/2009 00:26:44 | 6.68%  | 0.987     | 0d 23h 41m      |
51. | 28/01/2009 00:26:44 | 13.46% | 1.987     | 1d 23h 41m      |
52. | 29/01/2009 00:26:44 | 20.23% | 2.987     | 2d 23h 41m      |
53. | 30/01/2009 00:26:44 | 27%    | 3.987     | 3d 23h 41m      |
54. | 31/01/2009 00:26:44 | 33.78% | 4.987     | 4d 23h 41m      |
55. | 01/02/2009 00:26:44 | 40.55% | 5.987     | 5d 23h 41m      |
56. | 02/02/2009 00:26:44 | 47.32% | 6.987     | 6d 23h 41m      |
57. | 03/02/2009 00:26:44 | 54.09% | 7.987     | 7d 23h 41m      |
58. | 04/02/2009 00:26:44 | 60.87% | 8.987     | 8d 23h 41m      |
59. | 05/02/2009 00:26:44 | 67.64% | 9.987     | 9d 23h 41m      |
60. | 06/02/2009 00:26:44 | 74.41% | 10.987    | 10d 23h 41m     |
61. | 07/02/2009 00:26:44 | 81.18% | 11.987    | 11d 23h 41m     |
62. | 08/02/2009 00:26:44 | 87.96% | 12.987    | 12d 23h 41m     |
63. | 09/02/2009 00:26:44 | 94.73% | 13.987    | 13d 23h 41m     |
64. | 10/02/2009 00:26:44 | 98.5%  | 14.987    | 14d 23h 41m     |
65. | 11/02/2009 00:26:44 | 91.73% | 15.987    | 15d 23h 41m     |
66. | 12/02/2009 00:26:44 | 84.95% | 16.987    | 16d 23h 41m     |
67. | 13/02/2009 00:26:44 | 78.18% | 17.987    | 17d 23h 41m     |
68. | 14/02/2009 00:26:44 | 71.41% | 18.987    | 18d 23h 41m     |
69. | 15/02/2009 00:26:44 | 64.64% | 19.987    | 19d 23h 41m     |
70. | 16/02/2009 00:26:44 | 57.86% | 20.987    | 20d 23h 41m     |
71. | 17/02/2009 00:26:44 | 51.09% | 21.987    | 21d 23h 41m     |
72. | 18/02/2009 00:26:44 | 44.32% | 22.987    | 22d 23h 41m     |
73. | 19/02/2009 00:26:44 | 37.54% | 23.987    | 23d 23h 41m     |
74. | 20/02/2009 00:26:44 | 30.77% | 24.987    | 24d 23h 41m     |
75. | 21/02/2009 00:26:44 | 24%    | 25.987    | 25d 23h 41m     |
76. | 22/02/2009 00:26:44 | 17.23% | 26.987    | 26d 23h 41m     |
77. | 23/02/2009 00:26:44 | 10.45% | 27.987    | 27d 23h 41m     |
78. | 24/02/2009 00:26:44 | 3.68%  | 28.987    | 28d 23h 41m     |
79. | 25/02/2009 00:26:44 | 3.09%  | 0.456     | 0d 10h 57m      |
80. | 26/02/2009 00:26:44 | 9.86%  | 1.456     | 1d 10h 57m      |
81. | 27/02/2009 00:26:44 | 16.64% | 2.456     | 2d 10h 57m      |
82. | 28/02/2009 00:26:44 | 23.41% | 3.456     | 3d 10h 57m      |
83. | 01/03/2009 00:26:44 | 30.18% | 4.456     | 4d 10h 57m      |
84. | 02/03/2009 00:26:44 | 36.95% | 5.456     | 5d 10h 57m      |
85. | 03/03/2009 00:26:44 | 43.73% | 6.456     | 6d 10h 57m      |
86. | 04/03/2009 00:26:44 | 50.5%  | 7.456     | 7d 10h 57m      |
87. | 05/03/2009 00:26:44 | 57.27% | 8.456     | 8d 10h 57m      |
88. | 06/03/2009 00:26:44 | 64.04% | 9.456     | 9d 10h 57m      |
89. | 07/03/2009 00:26:44 | 70.82% | 10.456    | 10d 10h 57m     |
90. | 08/03/2009 00:26:44 | 77.59% | 11.456    | 11d 10h 57m     |
91. | 09/03/2009 00:26:44 | 84.36% | 12.456    | 12d 10h 57m     |
92. | 10/03/2009 00:26:44 | 91.14% | 13.456    | 13d 10h 57m     |
93. | 11/03/2009 00:26:44 | 97.91% | 14.456    | 14d 10h 57m     |
94. | 12/03/2009 00:26:44 | 95.32% | 15.456    | 15d 10h 57m     |
95. | 13/03/2009 00:26:44 | 88.55% | 16.456    | 16d 10h 57m     |
96. | 14/03/2009 00:26:44 | 81.77% | 17.456    | 17d 10h 57m     |
97. | 15/03/2009 00:26:44 | 75%    | 18.456    | 18d 10h 57m     |
98. | 16/03/2009 00:26:44 | 68.23% | 19.456    | 19d 10h 57m     |
99. | 17/03/2009 00:26:44 | 61.46% | 20.456    | 20d 10h 57m     |
100. | 18/03/2009 00:26:44 | 54.68% | 21.456    | 21d 10h 57m     |
101. | 19/03/2009 00:26:44 | 47.91% | 22.456    | 22d 10h 57m     |
102. | 20/03/2009 00:26:44 | 41.14% | 23.456    | 23d 10h 57m     |
103. | 21/03/2009 00:26:44 | 34.37% | 24.456    | 24d 10h 57m     |
104. +---------------------+--------+-----------+-----------------+ 

Code is hidden, SHOW