アットウィキロゴ

SVM04

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 fx1 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

fx1 = f(alpha, beta, x, y, q)

Debug.Print fx1

End Sub
最終更新:2011年05月06日 11:06