Occam's Razor

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

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.

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"

'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.

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.

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...

Find the greatest product of five consecutive digits in the 1000-digit number.

73167176531330624919225119674426574742355349194934
96983520312774506326239578318016984801869478851843
85861560789112949495459501737958331952853208805511
12540698747158523863050715693290963295227443043557
66896648950445244523161731856403098711121722383113
62229893423380308135336276614282806444486645238749
30358907296290491560440772390713810515859307960866
70172427121883998797908792274921901699720888093776
65727333001053367881220235421809751254540594752243
52584907711670556013604839586446706324415722155397
53697817977846174064955149290862569321978468622482
83972241375657056057490261407972968652414535100474
82166370484403199890008895243450658541227588666881
16427171479924442928230863465674813919123162824586
17866458359124566529476545682848912883142607690042
24219022671055626321111109370544217506941658960408
07198403850962455444362981230987879927244284909188
84580156166097919133875499200524063689912560717606
05886116467109405077541002256983155200055935729725
71636269561882670428252483600823257530420752963450

Solution:
Function Prob008() As Long
Dim strInput As New System.Text.StringBuilder
strInput.Append("73167176531330624919225119674426574742355349194934")
strInput.Append("96983520312774506326239578318016984801869478851843")
strInput.Append("85861560789112949495459501737958331952853208805511")
strInput.Append("12540698747158523863050715693290963295227443043557")
strInput.Append("66896648950445244523161731856403098711121722383113")
strInput.Append("62229893423380308135336276614282806444486645238749")
strInput.Append("30358907296290491560440772390713810515859307960866")
strInput.Append("70172427121883998797908792274921901699720888093776")
strInput.Append("65727333001053367881220235421809751254540594752243")
strInput.Append("52584907711670556013604839586446706324415722155397")
strInput.Append("53697817977846174064955149290862569321978468622482")
strInput.Append("83972241375657056057490261407972968652414535100474")
strInput.Append("82166370484403199890008895243450658541227588666881")
strInput.Append("16427171479924442928230863465674813919123162824586")
strInput.Append("17866458359124566529476545682848912883142607690042")
strInput.Append("24219022671055626321111109370544217506941658960408")
strInput.Append("07198403850962455444362981230987879927244284909188")
strInput.Append("84580156166097919133875499200524063689912560717606")
strInput.Append("05886116467109405077541002256983155200055935729725")
strInput.Append("71636269561882670428252483600823257530420752963450")
Dim Group1 As Integer = 0
Dim Group2 As Integer = 0
Dim Group3 As Integer = 0
Dim Group4 As Integer = 0
Dim Group5 As Integer = 0
Dim StringPos As Integer = 0
Do While StringPos < strInput.Length - 4
Group1 = strInput.ToString.Substring(StringPos, 1)
Group2 = strInput.ToString.Substring(StringPos + 1, 1)
Group3 = strInput.ToString.Substring(StringPos + 2, 1)
Group4 = strInput.ToString.Substring(StringPos + 3, 1)
Group5 = strInput.ToString.Substring(StringPos + 4, 1)
If Group1 * Group2 * Group3 * Group4 * Group5 > Prob008 Then Prob008 = Group1 * Group2 * Group3 * Group4 * Group5
StringPos += 1
Loop
End Function

Summary:
It isn’t pretty, but it works

By listing the first six prime numbers: 2, 3, 5, 7, 11, and 13, we can see that the 6^(th) prime is 13.

What is the 10001^(st) prime number?

Solution:
Function Prob007() As Long
Dim k As Integer = 1
Dim PrimeCount As Integer = 0
Dim TargetPrime As Integer = 10001
While PrimeCount < = TargetPrime
k += 1
If IsPrime(k) Then PrimeCount += 1
If PrimeCount = TargetPrime Then Return k
End While
End Function

The sum of the squares of the first ten natural numbers is,
1^(2) + 2^(2) + … + 10^(2) = 385

The square of the sum of the first ten natural numbers is,
(1 + 2 + … + 10)^(2) = 55^(2) = 3025

Hence the difference between the sum of the squares of the first ten natural numbers and the square of the sum is 3025 − 385 = 2640.

Find the difference between the sum of the squares of the first one hundred natural numbers and the square of the sum.

Solution:
Function Prob006() As Long
Dim SumOfSquares As Long = 0
For k As Integer = 1 To 100
SumOfSquares += System.Math.Pow(k, 2)
Next
Dim Sum As Long = 0
For k As Integer = 1 To 100
Sum += k
Next
Dim SquareOfSum As Long = System.Math.Pow(Sum, 2)
Return SquareOfSum - SumOfSquares
End Function

Summary:

2520 is the smallest number that can be divided by each of the numbers from 1 to 10 without any remainder.

What is the smallest positive number that is evenly divisible by all of the numbers from 1 to 20?

Solution:
Function Prob005() As Integer
Dim FoundResult As Boolean = False
Dim k As Integer = 0
While FoundResult = False
k += 1
FoundResult = True
For f As Integer = 1 To 20
If k Mod f <> 0 Then
FoundResult = False
End If
Next
If FoundResult = True Then Return k
End While
End Function

Summary:
This was pretty easy, but it seems like the problems are building upon each other, so I’m sure the next few are going to be a major pain…

A palindromic number reads the same both ways. The largest palindrome made from the product of two 2-digit numbers is 9009 = 91 × 99.

Find the largest palindrome made from the product of two 3-digit numbers.

Solution:
Function Prob004() As Integer
For k As Integer = 100 To 999
For f As Integer = 100 To 999
Dim intResult As Integer = k * f
Dim strResult As String = intResult.ToString
If strResult = StrReverse(strResult) AndAlso intResult > Prob004 Then
Prob004 = intResult
End If
Next
Next
End Function

Summary:
This one was pretty quick and fun.