nl 01 - プログラム倉庫

Public Class Form1
    Function lx(ByVal th1 As Single, ByVal tl As Single, ByVal tr As Single) As Single
        Dim ls As Single
        ls = ((1 - tl) * th1 - tr) / (2 * (1 - tl) * th1)
        If ls < 0 Then ls = 0
        lx = ls
    End Function
    Function cx(ByVal th1 As Single, ByVal tl As Single, ByVal tr As Single) As Single
        Dim ls As Single
        ls = ((1 - tl) * th1 - tr) / (2 * (1 - tl) * th1)
        If ls < 0 Then ls = 0
        cx = (1 - tl) * th1 * ls + tr
    End Function

    Function tls() As Single
        Dim maxw As Single
        Dim tl As Single
        Dim tr As Single
        Dim tp As Single
        Dim w1 As Single
        Dim n As Single
        Dim th(100) As Single
        Dim s As Single
        For s = 1 To 100
            th(s) = 0.02 * s
        Next
        maxw = -999
        For n = 1 To 400
            tl = 0.001 * n
            tr = trs(tl)
            w1 = wel(tl, tr)
            If w1 > maxw Then tp = tl
            If w1 > maxw Then maxw = w1
        Next
        tls = tp
    End Function

    Function trs(ByVal tl As Single) As Single
        Dim tr1 As Single
        Dim tr2 As Single
        Dim tr3 As Single
        Dim b1 As Single
        Dim b2 As Single
        Dim t As Single
        tr1 = 0
        tr2 = 0.1
        t = 0
        Do Until t > 100
            b1 = bud(tl, tr1)
            b2 = bud(tl, tr2)
            tr3 = tr2 - b2 * (tr2 - tr1) / (b2 - b1)
            tr1 = tr2
            tr2 = tr3
            If (tr1 - tr2) ^ 2 < 10 ^ (-5) Then t = 1000
            t = t + 1
        Loop
        trs = tr2
    End Function
    Function wel(ByVal tl As Single, ByVal tr As Single) As Single
        Dim w1 As Single
        Dim s As Single
        Dim ls As Single
        Dim cs As Single
        Dim th1 As Single
        Dim th(100) As Single
        For s = 1 To 100
            th(s) = 0.02 * s
        Next
        w1 = 0
        For s = 1 To 100
            th1 = th(s)
            ls = lx(th1, tl, tr)
            If ls < 0 Then ls = 0
            cs = cx(th1, tl, tr)
            w1 = w1 + Math.Log(cs) + Math.Log(1 - ls)
        Next
        wel = w1
    End Function
    Function bud(ByVal tl As Single, ByVal tr As Single) As Single
        Dim s As Single
        Dim ls As Single
        Dim cs As Single
        Dim ys As Single
        Dim th1 As Single
        Dim th(100) As Single

        For s = 1 To 100
            th(s) = 0.02 * s
        Next
        ys = 0
        cs = 0
        For s = 1 To 100
            th1 = th(s)
            ls = lx(th1, tl, tr)
            ys = ys + th(s) * ls
            cs = cs + cx(th1, tl, tr)
        Next
        bud = ys - cs
    End Function
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim th(100) As Single
        Dim s As Single
        Dim tl As Single
        Dim tr As Single
        Dim y(100) As Single
        Dim c(100) As Single
        Dim th1 As Single
        For s = 1 To 100
            th(s) = 0.02 * s
        Next
        tl = tls()
        tr = trs(tl)
        For s = 1 To 100
            th1 = th(s)
            y(s) = th(s) * lx(th1, tl, tr)
            c(s) = cx(th1, tl, tr)
        Next

        Dim g As Graphics = PictureBox1.CreateGraphics()
        Dim x1 As Single
        Dim x2 As Single
        Dim y1 As Single
        Dim y2 As Single
        For s = 1 To 99
            x1 = 100 * y(s)
            x2 = 100 * y(s + 1)
            y1 = 100 - 100 * c(s)
            y2 = 100 - 100 * c(s + 1)
            g.DrawLine(Pens.Red, x1, y1, x2, y2)
        Next
        g.DrawLine(Pens.Black, 0, 100, 300, 100)
        g.DrawLine(Pens.Black, 0, 0, 0, 200)
    End Sub
End Class