ｃｘｖｌｋｊ - プログラム倉庫

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 qx As Single
Dim h As Integer
Dim m As Integer
qx = 0
For m = 1 To 100
q1 = met(m, alpha, beta, x)
h = 0
If g(m, alpha, beta, x) > 0 Then h = h + 1
If y(m) < 0 Then h = h + 1
If h > 1 Then qx = qx + q * q1
h = 0
If g(m, alpha, beta, x) < 0 Then h = h + 1
If y(m) > 0 Then h = h + 1
If h > 1 Then qx = qx + q * q1
Next
f3 = qx
End Function

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


Function f1(alpha, beta As Single, x, y) As Single
Dim q1 As Single
Dim qx As Single
Dim h As Integer
Dim m As Integer

qx = 9999
For m = 1 To 100
q1 = met(m, alpha, beta, x)
h = 0
If g(m, alpha, beta, x) > 0 Then h = h + 1
If y(m) > 0 Then h = h + 1
If h < 2 Then q1 = 9999
If q1 < qx Then qx = q1
Next
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 100, 1 To 2) As Single
Dim y(1 To 100) As Integer
Dim m As Integer
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

For m = 1 To 50
x(m, 1) = m
x(m, 2) = m
Next

For m = 51 To 100
x(m, 1) = m + 100
x(m, 2) = m + 100
Next

For m = 1 To 50
y(m) = -1
Next

For m = 51 To 100
y(m) = 1
Next

alpha(1) = 1
alpha(2) = 1
beta = -140

q = -10
j = 0.01

t = 0

Do While (t < 101)

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

Debug.Print alpha(1)
Debug.Print alpha(2)
Debug.Print beta



End Sub