ていおｂｎ - プログラム倉庫

Function vec(m As Integer, alpha, beta As Single, x, y, q As Single) As Single
Dim d(0 To 2) As Single
Dim e As Single

d(1) = df(1, alpha, beta, x, y, q)
d(2) = df(2, alpha, beta, x, y, q)
d(0) = db(alpha, beta, x, y, q)

e = d(1) * d(1) + d(2) * d(2) + d(0) * d(0)

e = e ^ (0.5)

vec = d(m) / e
End Function


Function df(m As Integer, alpha, beta As Single, x, y, q As Single) As Single
Dim j As Single
Dim d1 As Single
Dim d2 As Single
Dim a(1 To 2) As Single
a(1) = alpha(1)
a(2) = alpha(2)
j = 0.01
a(m) = a(m) + j
d1 = f(alpha, beta, x, y, q)
d2 = f(a, beta, x, y, q)
df = (d2 - d1) / j
End Function
Function db(alpha, beta As Single, x, y, q As Single) As Single
Dim j As Single
Dim d1 As Single
Dim d2 As Single
j = 0.01
d1 = f(alpha, beta, x, y, q)
d2 = f(alpha, beta + j, x, y, q)
db = (d2 - d1) / j
End Function



Function f(alpha, beta As Single, x, y, q As Single) As Single
Dim fx As Single
fx = f1(alpha, beta, x, y)
If f2(alpha, beta, x, y) < fx Then fx = f2(alpha, beta, x, y)
f = fx + f3(alpha, beta, x, y, q)
End Function
Function f3(alpha, beta As Single, x, y, q As Single) As Single
Dim q1 As Single
Dim q2 As Single
Dim g1 As Single
Dim qx As Single
Dim h As Integer
q1 = met(1, alpha, beta, x)
q2 = met(2, alpha, beta, x)
qx = 0
h = 0
If g(1, alpha, beta, x) > 0 Then h = h + 1
If y(1) < 0 Then h = h + 1
If h > 1 Then qx = qx + q * q1
h = 0
If g(1, alpha, beta, x) < 0 Then h = h + 1
If y(2) > 0 Then h = h + 1
If h > 1 Then qx = qx + q * q1
h = 0
If g(2, alpha, beta, x) > 0 Then h = h + 1
If y(2) < 0 Then h = h + 1
If h > 1 Then qx = qx + q * q2
h = 0
If g(2, alpha, beta, x) < 0 Then h = h + 1
If y(2) > 0 Then h = h + 1
If h > 1 Then qx = qx + q * q2
f3 = qx
End Function

Function f2(alpha, beta As Single, x, y) As Single
Dim q1 As Single
Dim q2 As Single
Dim g1 As Single
Dim qx As Single
Dim h As Integer
q1 = met(1, alpha, beta, x)
q2 = met(2, alpha, beta, x)
h = 0
If g(1, alpha, beta, x) < 0 Then h = h + 1
If y(1) < 0 Then h = h + 1
If h < 2 Then q1 = 9999
q1 = met(1, alpha, beta, x)
h = 0
If g(2, alpha, beta, x) < 0 Then h = h + 1
If y(2) < 0 Then h = h + 1
If h < 2 Then q2 = 9999
qx = q1
If q2 < qx Then qx = q2
f2 = qx
End Function


Function f1(alpha, beta As Single, x, y) As Single
Dim q1 As Single
Dim q2 As Single
Dim g1 As Single
Dim qx As Single
Dim h As Integer
q1 = met(1, alpha, beta, x)
q2 = met(2, alpha, beta, x)

h = 0
If g(1, alpha, beta, x) > 0 Then h = h + 1
If y(1) > 0 Then h = h + 1
If h < 2 Then q1 = 9999
q1 = met(1, alpha, beta, x)
h = 0
If g(2, alpha, beta, x) > 0 Then h = h + 1
If y(2) > 0 Then h = h + 1
If h < 2 Then q2 = 9999
qx = q1
If q2 < qx Then qx = q2
f1 = qx
End Function
Function g(m As Integer, alpha, beta As Single, x) As Single
g = alpha(1) * x(m, 1) + alpha(2) * x(m, 2) + beta
End Function

Function met(m As Integer, alpha, beta As Single, x) As Single
Dim m1 As Single
Dim m2 As Single
Dim t As Single
m1 = alpha(1) * alpha(1) + alpha(2) * alpha(2)
m2 = -alpha(1) * x(m, 1) - alpha(2) * x(m, 2) - beta
t = m2 / m1
met = m1 * t ^ 2
End Function
Private Sub Command1_Click()
Dim x(1 To 2, 1 To 2) As Single
Dim y(1 To 2) As Single
Dim alpha(1 To 2) As Single
Dim beta As Single
Dim q As Single
Dim c1 As Single
Dim c2 As Single
Dim c0 As Single
Dim j As Single


x(1, 1) = 2
x(1, 2) = 1
x(2, 1) = 1
x(2, 2) = 2
y(1) = 1
y(2) = -1

alpha(1) = 3
alpha(2) = 1
beta = -5

q = -10

t = 0
j = 0.01


Do While (t < 10000)

Debug.Print f(alpha, beta, x, y, q)


c1 = vec(1, alpha, beta, x, y, q)
c2 = vec(2, alpha, beta, x, y, q)
c0 = vec(0, alpha, beta, x, y, q)

alpha(1) = alpha(1) + j * c1
alpha(2) = alpha(2) + j * c2

beta = beta + j * c0

t = t + 1
Loop


End Sub