saigo - プログラム倉庫

Function seeky(s As Single, th, wp As Single, bp As Single) As Single
Dim ls As Single
Dim cs As Single
Dim us As Single
Dim ys As Single
Dim ws As Single
Dim l1 As Single
Dim c1 As Single
Dim u1 As Single
Dim l2 As Single
Dim y2 As Single
Dim y1 As Single
Dim c2 As Single
Dim u2 As Single
Dim h As Single
Dim lp As Single
Dim t1 As Single
Dim t2 As Single
Dim e As Single
e = 10 ^ (-5)
h = 0.1
ls = (bp + 0.01) / th(s)
If ls < 0 Then ls = 0
ys = th(s) * ls
cs = ys - bp
us = Log(cs) + Log(1 - ls)
ws = Log(cs) + Log(1 - ys / th(s + 1))
If ws > wp Then us = -999
t2 = 0
Do Until t2 > 10
t1 = 0
Do Until t1 > 100
l1 = ls + h
If l1 > 0.99 Then l1 = ls
c1 = th(s) * l1 - bp
y1 = th(s) * l1
u1 = Log(c1) + Log(1 - l1)
w1 = Log(c1) + Log(1 - y1 / th(s + 1))
If w1 > wp Then u1 = -999
l2 = ls - h
If l2 < 0 Then l2 = ls
c2 = th(s) * l2 - bp
If c2 < 0.01 Then l2 = ls
c2 = th(s) * l2 - bp
y2 = th(s) * l2
u2 = Log(c2) + Log(1 - l2)
w2 = Log(c2) + Log(1 - y2 / th(s + 1))
If w2 > wp Then u2 = -999
If u1 > us Then ls = l1
If u1 > us Then us = u1
If u2 > us Then ls = l2
If u2 > us Then us = u2
If (lp - ls) ^ 2 < e Then t1 = 1000
lp = ls
t1 = t1 + 1
Loop
h = h / 2
t2 = t2 + 1
Loop
seeky = th(s) * ls
End Function
Function seekc(s As Single, th, wp As Single, bp As Single) As Single
Dim ls As Single
Dim cs As Single
Dim us As Single
Dim ys As Single
Dim ws As Single
Dim l1 As Single
Dim c1 As Single
Dim u1 As Single
Dim l2 As Single
Dim y2 As Single
Dim y1 As Single
Dim c2 As Single
Dim u2 As Single
Dim h As Single
Dim lp As Single
Dim t1 As Single
Dim t2 As Single
Dim e As Single
e = 10 ^ (-5)
h = 0.1
ls = (bp + 0.01) / th(s)
If ls < 0.01 Then ls = 0.01
ys = th(s) * ls
cs = ys - bp
us = Log(cs) + Log(1 - ls)
ws = Log(cs) + Log(1 - ys / th(s + 1))
If ws > wp Then us = -999
t2 = 0
Do Until t2 > 10
t1 = 0
Do Until t1 > 100
l1 = ls + h
If l1 > 0.99 Then l1 = ls
c1 = th(s) * l1 - bp
y1 = th(s) * l1
u1 = Log(c1) + Log(1 - l1)
w1 = Log(c1) + Log(1 - y1 / th(s + 1))
If w1 > wp Then u1 = -999
l2 = ls - h
If l2 < 0.01 Then l2 = ls
c2 = th(s) * l2 - bp
If c2 < 0.01 Then l2 = ls
c2 = th(s) * l2 - bp
y2 = th(s) * l2
u2 = Log(c2) + Log(1 - l2)
w2 = Log(c2) + Log(1 - y2 / th(s + 1))
If w2 > wp Then u2 = -999
If u1 > us Then ls = l1
If u1 > us Then us = u1
If u2 > us Then ls = l2
If u2 > us Then us = u2
If (lp - ls) ^ 2 < e Then t1 = 1000
lp = ls
t1 = t1 + 1
Loop
h = h / 2
t2 = t2 + 1
Loop
seekc = th(s) * ls - bp
End Function
Function seeku(s As Single, th, wp As Single, bp As Single) As Single
Dim ls As Single
Dim cs As Single
Dim us As Single
Dim ys As Single
Dim ws As Single
Dim l1 As Single
Dim c1 As Single
Dim u1 As Single
Dim l2 As Single
Dim y2 As Single
Dim y1 As Single
Dim c2 As Single
Dim u2 As Single
Dim h As Single
Dim lp As Single
Dim t1 As Single
Dim t2 As Single
Dim e As Single
e = 10 ^ (-5)
h = 0.1
ls = (bp + 0.01) / th(s)
If ls < 0 Then ls = 0
ys = th(s) * ls
cs = ys - bp
us = Log(cs) + Log(1 - ls)
ws = Log(cs) + Log(1 - ys / th(s + 1))
If ws > wp Then us = -999
t2 = 0
Do Until t2 > 10
t1 = 0
Do Until t1 > 100
l1 = ls + h
If l1 > 0.99 Then l1 = ls
c1 = th(s) * l1 - bp
y1 = th(s) * l1
u1 = Log(c1) + Log(1 - l1)
w1 = Log(c1) + Log(1 - y1 / th(s + 1))
If w1 > wp Then u1 = -999
l2 = ls - h
If l2 < 0 Then l2 = ls
c2 = th(s) * l2 - bp
If c2 < 0.01 Then l2 = ls
c2 = th(s) * l2 - bp
y2 = th(s) * l2
u2 = Log(c2) + Log(1 - l2)
w2 = Log(c2) + Log(1 - y2 / th(s + 1))
If w2 > wp Then u2 = -999
If u1 > us Then ls = l1
If u1 > us Then us = u1
If u2 > us Then ls = l2
If u2 > us Then us = u2
If (lp - ls) ^ 2 < e Then t1 = 1000
lp = ls
t1 = t1 + 1
Loop
h = h / 2
t2 = t2 + 1
Loop
seeku = us
End Function
Function seekw(wp As Single) As Single
Dim x1 As Single
Dim x2 As Single
Dim x3 As Single
Dim w1 As Single
Dim w2 As Single
Dim t As Single
x1 = 0.3
x2 = 0.7
Do Until t > 100
w1 = 2 * Log(x1)
w2 = 2 * Log(x2)
x3 = x2 + (wp - w2) * (x2 - x1) / (w2 - w1)
x1 = x2
x2 = x3
If (wp - w2) ^ 2 < 10 ^ (-5) Then t = 1000
t = t + 1
Loop
seekw = x2
End Function
Private Sub Command1_Click()
Dim th(1 To 100) As Single
Dim s As Single
Dim tl As Single
Dim tr As Single
Dim bs(1 To 100) As Single
Dim ws(1 To 100) As Single
Dim c(1 To 99) As Single
Dim y(1 To 99) As Single
Dim w1 As Single
Dim wp As Single
Dim bp As Single
Dim rate As Single
Open "c:/101.txt" For Input As #2
Do Until EOF(2)
Input #2, a1, a2, a3
s = a1
ws(s) = a2
bs(s) = a3
Loop
Close #2
For s = 1 To 100
th(s) = 0.02 * s
Next
h = 10 ^ (-2)
For s = 1 To 99
wp = 2 * Log(ws(s))
bp = bs(s)
c(s) = seekc(s, th, wp, bp)
y(s) = seeky(s, th, wp, bp)
Next
For s = 1 To 98
c1 = c(s + 1) - c(s)
y1 = y(s + 1) - y(s)
pp = 0
If y1 < 0.0001 Then pp = 1
If y1 < 0.0001 Then y1 = 1
If y1 = 0.0001 Then pp = 1
If y1 = 0.0001 Then y1 = 1
rate = 100 * (1 - c1 / y1)
If pp = 1 Then rate = 0
Debug.Print s, rate
Next