Project Euler Problem 60

解法

Nまでの素数を求めたときで全探索する,
結果が無いもしくは,Nより大きいとき,Nは小さすぎ,
Nより小さい時はNより大きい数について探索する必要は無いことからそれが答となる.

Nの値をある程度の大きい数値にしてだんだん小さくしていく.

実装(Visual Basic.NET)

この実装だと自分の環境では59.782sec

Imports System
Imports System.IO
Imports System.Text
Imports System.Collections
Imports System.Collections.Generic
Imports System.Math
Imports System.Diagnostics

Public Class Algorithm
    Public Shared Function Mod_Pow(ByVal a As Long, ByVal n As Long, ByVal M As Long) As Long
        If n = 0 Then Return 1
        Dim Res As Long = Mod_Pow((a * a) Mod M, Int(n / 2), M)
        If n And 1 Then Res = (Res * a) Mod M
        Return Res
    End Function

    Public Shared Function Miller_Rabin(ByVal n As Long) As Boolean
        If n = 2 Then Return True
        If (n Mod 2) = 0 Or n <= 1 Then Return False
        If n Mod 3 = 0 Then Return False
        If n Mod 5 = 0 Then Return False
        If n Mod 7 = 0 Then Return False
        If n Mod 11 = 0 Then Return False
        If n Mod 13 = 0 Then Return False
        If n Mod 17 = 0 Then Return False
        If n Mod 19 = 0 Then Return False

        Dim i As Integer = 0, a As Integer() = New Integer() {2, 7, 61, -1}, r As Integer, s As Long = 0, d As Long, x As Long
        d = n - 1
        Do While (d Mod 2) = 0
            s += 1 : d >>= 1
        Loop
        Do While a(i) <> -1 And a(i) < n
            x = Mod_Pow(a(i), d, n)
            If x <> 1 Then
                For r = 0 To s - 1
                    If x = n - 1 Then Exit For
                    x = (x * x) Mod n
                Next
                If r = s Then Return False
            End If
            i += 1
        Loop
        Return True
    End Function

    Public Shared Function Eratosthenes_Sieve(ByVal N As Integer) As Boolean()
        Eratosthenes_Sieve = New Boolean(N) {}
        Dim Res As Boolean() = Eratosthenes_Sieve, i As Integer, j As Integer, m As Integer = CInt(Math.Floor(Math.Sqrt(N) + 0.000000001))
        Res(0) = False : Res(1) = False : Res(2) = True
        For i = 3 To N Step 2
            If i <= m And Res(i) = False Then
                For j = i * 3 To N Step i * 2
                    Res(j) = True
                Next j
            End If
            Res(i) = Not Res(i)
        Next i
    End Function
    Public Shared Function Prime_List(ByVal N As Integer) As Generic.List(Of Integer)
        Prime_List = Prime_List(Eratosthenes_Sieve(N))
    End Function
    Public Shared Function Prime_List(ByRef Is_Prime As Boolean()) As Generic.List(Of Integer)
        Prime_List = New Generic.List(Of Integer)
        For i As Integer = 2 To UBound(Is_Prime)
            If Is_Prime(i) Then Prime_List.Add(i)
        Next
    End Function
End Class

Module Module1
    Public Const MAX_PRIME As Integer = 27000
    Public Answer As Integer
    Public Primes As List(Of Integer)
    Public PreAnswer(4) As Integer '現在の候補
    Public PreSum As Integer '現在の和
    Public IsPrime As New HashSet(Of Long)
    '数値を文字列同士の和として扱う
    Public Function Add(ByVal a As Integer, ByVal b As Integer) As Long
        Add = b + a * 10 ^ Int(Log10(b) + 1)
    End Function
    Public Sub MakePrimeList()
        Primes = Algorithm.Prime_List(MAX_PRIME)
        For Each a As Integer In Primes
            For Each b As Integer In Primes
                If Algorithm.Miller_Rabin(Add(a, b)) Then
                    IsPrime.Add(Add(a, b))
                End If
            Next
        Next
    End Sub
    Public Sub Solve(ByVal V As Integer, ByVal N As Integer)
        If PreSum > Answer Then Exit Sub
        If V < Primes.Count Then
            If PreSum > Answer + Primes(V) * (5 - N) Then Exit Sub
        End If
        If N = 5 Then
            For i As Integer = 0 To 4
                Console.Write("{0} ", PreAnswer(i))
            Next
            Console.WriteLine()
            Console.WriteLine("{0}", PreSum)
            Console.WriteLine()
            Answer = Min(Answer, PreSum)
        Else
            For i As Integer = V To Primes.Count - 1
                Dim Check As Boolean = True
                For j As Integer = 0 To N - 1
                    If IsPrime.Contains(Add(PreAnswer(j), Primes(i))) = False Then
                        Check = False
                        Exit For
                    End If
                    If IsPrime.Contains(Add(Primes(i), PreAnswer(j))) = False Then
                        Check = False
                        Exit For
                    End If
                Next
                If Check Then
                    PreAnswer(N) = Primes(i)
                    PreSum += Primes(i)
                    Solve(i, N + 1)
                    PreSum -= Primes(i)
                End If
            Next
        End If
    End Sub
    Sub Main()
        Dim TimeCounter As New Stopwatch
        TimeCounter.Start()
        Answer = MAX_PRIME

        MakePrimeList()
        Console.WriteLine("Prime Generated")
        Solve(0, 0)

        TimeCounter.Stop()

        Console.WriteLine("----")
        Console.WriteLine("Answer:{0}", Answer)
        Debug.WriteLine("Answer:{0}", Answer)
        Console.WriteLine("Calculate Time:{0}sec", TimeCounter.ElapsedMilliseconds / 1000)

        '-----
        Console.WriteLine()
        Console.WriteLine("Press Any Key.")
        Console.ReadKey()
    End Sub
End Module