Month: March 2010

Problem 019

Posted by – March 16, 2010

You are given the following information, but you may prefer to do some research for yourself.

* 1 Jan 1900 was a Monday.
* Thirty days has September,
April, June and November.
All the rest have thirty-one,
Saving February alone,
Which has twenty-eight, rain or shine.
And on leap years, twenty-nine.
* A leap year occurs on any year evenly divisible by 4, but not on a century unless it is divisible by 400.

How many Sundays fell on the first of the month during the twentieth century (1 Jan 1901 to 31 Dec 2000)?

Solution:
Function Prob019() As Long
Dim dt As Date = CDate("01/01/1901")
While dt < = CDate("12/31/2000")
If dt.DayOfWeek = System.DayOfWeek.Sunday Then Prob019 += 1
dt = dt.AddMonths(1)
End While
End Function

Summary:
I'm not above cheating by using built-in functions ;)

Problem 014

Posted by – March 16, 2010

The following iterative sequence is defined for the set of positive integers:

n → n/2 (n is even)
n → 3n + 1 (n is odd)

Using the rule above and starting with 13, we generate the following sequence:
13 → 40 → 20 → 10 → 5 → 16 → 8 → 4 → 2 → 1

It can be seen that this sequence (starting at 13 and finishing at 1) contains 10 terms. Although it has not been proved yet (Collatz Problem), it is thought that all starting numbers finish at 1.

Which starting number, under one million, produces the longest chain?

NOTE: Once the chain starts the terms are allowed to go above one million.

Solution:
Function Prob014() As Long
Prob014 = 0
Dim NumWithLargestChain As Long = 0
Dim ChainCount As Long = 0
For StartNumber As Long = 999999 To 1 Step -1
Dim tmpNum As Long = StartNumber
Dim tmpCount As Long = 0
Do
tmpCount += 1
If tmpCount > ChainCount Then
ChainCount = tmpCount
NumWithLargestChain = StartNumber
End If
If tmpNum = 1 Then Exit Do
If tmpNum Mod 2 = 0 Then
tmpNum = tmpNum / 2
Else
tmpNum = (tmpNum * 3) + 1
End If
Loop
Next
Return NumWithLargestChain
End Function

Summary:
Thankfully, this was a lot easier than the previous problem I did. I skipped problem 12 and 13, but I’ll probably come back to them at some point. Problem 12 dealt with triangle numbers, which I’m not really familiar with. Problem 13 dealt with adding up a hundred 50-digit numbers, which seems like it would be easy, but I either would need a crazy-big numeric datatype or I’d need to come up with a new way to add the stuff up through some other fashion.

Problem 011

Posted by – March 13, 2010

In the 20×20 grid below, four numbers along a diagonal line have been marked in red.

08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08
49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00
81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65
52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91
22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80
24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50
32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70
67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21
24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72
21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95
78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92
16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57
86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58
19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40
04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66
88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69
04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36
20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16
20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54
01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48

The product of these numbers is 26 × 63 × 78 × 14 = 1788696.

What is the greatest product of four adjacent numbers in any direction (up, down, left, right, or diagonally) in the 20×20 grid?

Solution:
Function Prob011() As Long
Prob011 = 0
Dim strGrid = ""
strGrid &= " 08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08"
strGrid &= " 49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00"
strGrid &= " 81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65"
strGrid &= " 52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91"
strGrid &= " 22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80"
strGrid &= " 24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50"
strGrid &= " 32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70"
strGrid &= " 67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21"
strGrid &= " 24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72"
strGrid &= " 21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95"
strGrid &= " 78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92"
strGrid &= " 16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57"
strGrid &= " 86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58"
strGrid &= " 19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40"
strGrid &= " 04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66"
strGrid &= " 88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69"
strGrid &= " 04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36"
strGrid &= " 20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16"
strGrid &= " 20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54"
strGrid &= " 01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48"

Dim CharPerLine As Integer = 60
Dim Offset As Integer = 3

'Across
For f As Integer = 0 To 19
Dim Val1 As Integer = 0
Dim Val2 As Integer = 0
Dim Val3 As Integer = 0
Dim Val4 As Integer = 0
Dim StartPos As Integer = (f * CharPerLine)
Dim GroupCount As Integer = 1
While GroupCount < = 17
Val1 = CInt(strGrid.Substring(StartPos, Offset).Trim)
Val2 = CInt(strGrid.Substring(StartPos + (Offset), Offset).Trim)
Val3 = CInt(strGrid.Substring(StartPos + (Offset * 2), Offset).Trim)
Val4 = CInt(strGrid.Substring(StartPos + (Offset * 3), Offset).Trim)
If Val1 * Val2 * Val3 * Val4 > Prob011 Then Prob011 = Val1 * Val2 * Val3 * Val4
StartPos += Offset
GroupCount += 1
End While
Next

'Down
For f As Integer = 0 To 16
Dim Val1 As Integer = 0
Dim Val2 As Integer = 0
Dim Val3 As Integer = 0
Dim Val4 As Integer = 0
Dim StartPos As Integer = (f * CharPerLine)
Dim GroupCount As Integer = 1
While GroupCount < = 20
Val1 = CInt(strGrid.Substring(StartPos, Offset).Trim)
Val2 = CInt(strGrid.Substring(StartPos + CharPerLine, Offset).Trim)
Val3 = CInt(strGrid.Substring(StartPos + (CharPerLine * 2), Offset).Trim)
Val4 = CInt(strGrid.Substring(StartPos + (CharPerLine * 3), Offset).Trim)
If Val1 * Val2 * Val3 * Val4 > Prob011 Then Prob011 = Val1 * Val2 * Val3 * Val4
StartPos += Offset
GroupCount += 1
End While
Next

'Diag-Left
For f As Integer = 0 To 16
Dim Val1 As Integer = 0
Dim Val2 As Integer = 0
Dim Val3 As Integer = 0
Dim Val4 As Integer = 0
Dim StartPos As Integer = (f * CharPerLine)
Dim GroupCount As Integer = 1
While GroupCount < = 17
Val1 = CInt(strGrid.Substring(StartPos, Offset).Trim)
Val2 = CInt(strGrid.Substring(StartPos + CharPerLine + Offset, Offset).Trim)
Val3 = CInt(strGrid.Substring(StartPos + (CharPerLine * 2) + (Offset * 2), Offset).Trim)
Val4 = CInt(strGrid.Substring(StartPos + (CharPerLine * 3) + (Offset * 3), Offset).Trim)
If Val1 * Val2 * Val3 * Val4 > Prob011 Then Prob011 = Val1 * Val2 * Val3 * Val4
StartPos += Offset
GroupCount += 1
End While
Next

'Diag-Right
For f As Integer = 0 To 16
Dim Val1 As Integer = 0
Dim Val2 As Integer = 0
Dim Val3 As Integer = 0
Dim Val4 As Integer = 0
Dim StartPos As Integer = (Offset * 3) + (f * CharPerLine)
Dim GroupCount As Integer = 1
While GroupCount < = 17
Val1 = CInt(strGrid.Substring(StartPos, Offset).Trim)
Val2 = CInt(strGrid.Substring(StartPos + CharPerLine - Offset, Offset).Trim)
Val3 = CInt(strGrid.Substring(StartPos + (CharPerLine * 2) - (Offset * 2), Offset).Trim)
Val4 = CInt(strGrid.Substring(StartPos + (CharPerLine * 3) - (Offset * 3), Offset).Trim)
If Val1 * Val2 * Val3 * Val4 > Prob011 Then Prob011 = Val1 * Val2 * Val3 * Val4
StartPos += Offset
GroupCount += 1
End While
Next
End Function

Summary:
I had a LOT of fun figuring out a solution to this one! I was pretty sure there was a way to use a Matrix for this, but — mainly because I can’t remember the last time I’ve actually used one — I skipped the matrix and went with a slightly less elegant way.

Problem 010

Posted by – March 11, 2010

The sum of the primes below 10 is 2 + 3 + 5 + 7 = 17.

Find the sum of all the primes below two million.

Solution:
Function Prob010() As Long
For k As Integer = 2 To 2000000
If IsPrime(k) Then Prob010 += k
Next
End Function

Summary:
They are making this WAY too easy. I’m not sure if it’s just the nature of this sort of problem or whether my IsPrime routine needs some tweaking, but this problem takes the longest compared to all of the others I’ve done up to this point. Even so, it’s only 10-seconds, which is well within the target range allowed by Project Euler.

Problem 009

Posted by – March 11, 2010

A Pythagorean triplet is a set of three natural numbers, a < b < c, for which,
a^(2) + b^(2) = c^(2)

For example, 3^(2) + 4^(2) = 9 + 16 = 25 = 5^(2).

There exists exactly one Pythagorean triplet for which a + b + c = 1000.
Find the product abc.

Solution:
Function Prob009() As Long
For a As Integer = 0 To 1000
For b As Integer = 0 To 1000
For c As Integer = 0 To 1000
If (a + b + c) = 1000 AndAlso a < b AndAlso b < c AndAlso System.Math.Pow(a, 2) + System.Math.Pow(b, 2) = System.Math.Pow(c, 2) Then Return a * b * c
Next
Next
Next
End Function

Summary:
Pretty easy...