Option Base 1
Option Explicit

Dim RawMuArray() As Double, MuArray() As Double
Dim RawMuCount As Integer
Dim RawSigmaArray() As Double, SigmaArray() As Double
Dim RawSigmaCount As Integer
Dim FactorPairCount As Integer
Dim ObservedArray() As Double
Dim ObservedCount As Integer
Dim SumLogLikelyArray() As Double

Sub Driver()

Application.ScreenUpdating = False
Mu
Sigma
PopulateFactorArrays
LoadData
LogLikely
PosteriorAndRatio
Application.ScreenUpdating = True

End Sub

Sub Mu()

Dim LowMu As Double, HighMu As Double, MuIncrement As Double
Dim i As Integer

LowMu = 200.1
HighMu = 210#
RawMuCount = 100

MuIncrement = (HighMu - LowMu) / (RawMuCount - 1)

ReDim RawMuArray(RawMuCount)

RawMuArray(1) = LowMu
For i = 2 To RawMuCount
    RawMuArray(i) = RawMuArray(i - 1) + MuIncrement
Next i

End Sub

Sub Sigma()

Dim LowSigma As Double, HighSigma As Double, SigmaIncrement As Double
Dim i As Integer

LowSigma = 39.54
HighSigma = 43.5
RawSigmaCount = 100

SigmaIncrement = (HighSigma - LowSigma) / (RawSigmaCount - 1)

ReDim RawSigmaArray(RawSigmaCount)

RawSigmaArray(1) = LowSigma
For i = 2 To RawSigmaCount
    RawSigmaArray(i) = RawSigmaArray(i - 1) + SigmaIncrement
Next i

End Sub

Sub PopulateFactorArrays()

Dim RowNum As Integer, i As Integer, j As Integer

FactorPairCount = RawMuCount * RawSigmaCount
ReDim MuArray(FactorPairCount)
ReDim SigmaArray(FactorPairCount)

RowNum = 1
For i = 1 To RawMuCount
    For j = 1 To RawSigmaCount
        MuArray(RowNum) = RawMuArray(i)
        SigmaArray(RowNum) = RawSigmaArray(j)
        RowNum = RowNum + 1
    Next j
Next i

Worksheets("出力").Activate

For RowNum = 1 To FactorPairCount
    ActiveSheet.Cells(RowNum + 1, 1) = MuArray(RowNum)
    ActiveSheet.Cells(RowNum + 1, 2) = SigmaArray(RowNum)
Next RowNum

ActiveSheet.Cells(1, 1) = "μ"
ActiveSheet.Cells(1, 2) = "σ"
ActiveSheet.Cells(1, 3) = "対数尤度"
ActiveSheet.Cells(1, 4) = "事後分布"
ActiveSheet.Cells(1, 5) = "対最大値比"

End Sub

Sub LoadData()

Dim ObservedValues As Range
Dim i As Integer

' 300の部分は実際の観測値の数に合わせて変更してください
ObservedCount = 300
ReDim ObservedArray(ObservedCount)

Worksheets("入力").Activate
Set ObservedValues = ActiveSheet.Range(Cells(2, 1), Cells(ObservedCount + 1, 1))

For i = 1 To ObservedCount
   ObservedArray(i) = ObservedValues(i)
Next i

End Sub

Sub LogLikely()

Dim i As Integer, j As Integer
Dim CurrentMu As Double, CurrentSigma As Double
Dim CurrentLikely As Double
ReDim SumLogLikelyArray(FactorPairCount)

Worksheets("出力").Activate

For j = 1 To FactorPairCount
    CurrentMu = MuArray(j)
    CurrentSigma = SigmaArray(j)
    For i = 1 To ObservedCount
        CurrentLikely = Application.WorksheetFunction.Norm_Dist(ObservedArray(i), CurrentMu, CurrentSigma, False)
        SumLogLikelyArray(j) = SumLogLikelyArray(j) + Log(CurrentLikely)
    Next i
    ActiveSheet.Cells(j + 1, 3) = SumLogLikelyArray(j)
Next j

End Sub

Sub PosteriorAndRatio()

Dim i As Integer
Dim PriorCount As Integer
Dim PosteriorArray() As Double
Dim MaxPosterior As Double, RatioToMax As Double

ReDim PosteriorArray(FactorPairCount)

' 1995の部分は事前分布のデータ数に合わせて変更してください
PriorCount = 1995

For i = 1 To FactorPairCount
    PosteriorArray(i) = Log(Application.WorksheetFunction.Norm_Dist(MuArray(i), 203.6, 40.7, False)) * PriorCount + SumLogLikelyArray(i)
    ActiveSheet.Cells(i + 1, 4) = PosteriorArray(i)
Next i

MaxPosterior = WorksheetFunction.Max(PosteriorArray)

For i = 1 To FactorPairCount
    RatioToMax = Exp(PosteriorArray(i) - MaxPosterior)
    ActiveSheet.Cells(i + 1, 5) = RatioToMax
Next i

End Sub
