lp13 - プログラム倉庫

Function seekx(n As Single, x, b) As Single
Dim m As Single
Dim opx As Single
Dim h As Single
Dim sx As Single
sx = 0
h = 0
For m = 1 To 405
If x(m, n) > 10 ^ (-5) Then h = h + 1
If x(m, n) > 10 ^ (-5) Then opx = m
Next
If h = 1 Then sx = b(opx) / x(opx, n)
seekx = sx
End Function


Function seekpibot(target As Single, x, b) As Single
Dim m As Single
Dim under As Single
Dim c(1 To 405) As Single
Dim px As Single
For m = 1 To 405
under = x(m, target)
c(m) = 999
If under > 10 ^ (-5) Then c(m) = b(m) / under
Next
px = 999
minc = 999
For m = 1 To 405
If c(m) < minc Then px = m
If c(m) < minc Then minc = c(m)
Next
seekpibot = px
End Function

Function seektarget(x) As Single
Dim n As Single
Dim tx As Single
tx = 999
For n = 1 To 809
If x(0, n) > 0 Then tx = n
Next
seektarget = tx
End Function

Private Sub Command1_Click()
Dim m As Single
Dim n As Single
Dim x(0 To 405, 1 To 809) As Single
Dim b(0 To 405) As Single
Dim target As Single
Dim pibot As Single
Dim z As Single
Dim theta As Single
For n = 1 To 100
x(0, n) = Log(0.01 * (n + 1)) - Log(0.01 * n)
x(0, 100 + n) = Log(0.01 * (n + 1)) - Log(0.01 * n)
x(0, 200 + n) = Log(0.01 * (n + 1)) - Log(0.01 * n)
x(0, 300 + n) = Log(0.01 * (n + 1)) - Log(0.01 * n)
Next
For m = 1 To 400
x(m, m) = 1
Next
For m = 1 To 405
x(m, m + 404) = 1
Next
For n = 1 To 100
x(401, n) = 1
x(402, n + 100) = 1
x(403, n + 200) = 1
x(404, n + 300) = 1
Next
x(401, 401) = -1
x(402, 402) = -1
x(403, 403) = -1
x(404, 404) = -1
x(405, 401) = 1
x(405, 402) = 1
x(405, 403) = 1
x(405, 404) = 1
b(0) = 0
For n = 1 To 400
b(n) = 1
Next
b(405) = 200
target = seektarget(x)
Do Until target > 900
pibot = seekpibot(target, x, b)
For m = 0 To 405
z = x(m, target) / x(pibot, target)
If m = pibot Then z = 0
For n = 1 To 809
x(m, n) = x(m, n) - z * x(pibot, n)
Next
b(m) = b(m) - z * b(pibot)
Next
Debug.Print target, pibot, b(0)
target = seektarget(x)
Loop
For n = 401 To 405
Debug.Print n, seekx(n, x, b)
Next

End Sub