Sub Powell_Multidimensional()
Dim Lambda As Double
Dim Epsilon As Double
Dim x(3, 2) As Double
Dim v(3, 2) As Double
Dim Iteracion As Integer
Dim I As Integer
Dim n As Integer
Dim p As Integer
n = 2
p = 3
x(0, 0) = -0.5 ' Punto inicial
x(0, 1) = 0.5 ' Punto inicial
v(1, 0) = -0.5 ' Conjunto inicial de direcciones
v(1, 1) = 0
v(2, 0) = 0
v(2, 1) = 0.5
Iteracion = 0
Limpiar ' Limpio los resultados anteriores
Titulos ' Imprimo titulos de columnas
r = Imprime(p, I, x(0, 0), x(0, 1), v(0, 0), v(0, 1), Lambda, fx(x(0, 0), x(0, 1)), 0)
p = p + 1
Do
Range("A" & p).Select
ActiveCell.FormulaR1C1 = Iteracion
For I = 1 To n
Lambda = Lambda_Optimo(x(I - 1, 0), x(I - 1, 1), v(I, 0), v(I, 1))
x(I, 0) = x(I - 1, 0) + Lambda * v(I, 0)
x(I, 1) = x(I - 1, 1) + Lambda * v(I, 1)
r = Imprime(p, I, x(I, 0), x(I, 1), v(I, 0), v(I, 1), Lambda, fx(x(I, 0), x(I, 1)), 0)
p = p + 1
Next I
For I = 1 To n - 1
v(I, 0) = v(I + 1, 0)
v(I, 1) = v(I + 1, 1)
Next I
v(n, 0) = x(n, 0) - x(0, 0)
v(n, 1) = x(n, 1) - x(0, 1)
Lambda = Lambda_Optimo(x(n, 0), x(n, 1), v(n, 0), v(n, 1))
x(0, 0) = x(n, 0) + Lambda * v(n, 0)
x(0, 1) = x(n, 1) + Lambda * v(n, 1)
Distancia = v(n, 0) ^ 2 + v(n, 1) ^ 2
r = Imprime(p, 0, x(0, 0), x(0, 1), v(n, 0), v(n, 1), Lambda, fx(x(0, 0), x(0, 1)), Distancia)
Epsilon = 1
p = p + 1
Iteracion = Iteracion + 1
Loop Until Distancia <= 1 * 10 ^ (-25) Or Iteracion > 1000
End Sub
Public Function Lambda_Optimo(ByVal prmx1 As Double, ByVal prmx2 As Double, ByVal prmv1 As Double, ByVal prmv2 As Double) As Double
Dim px1k, px2k, A, B, C, Epsilon As Double
Dim fx1, fx2 As Double
Dim x1 As Double
Dim x2 As Double
Dim x1Ant, x2Ant As Double
Dim Distancia, Iteracion As Double
Dim Maxlteraciones As Boolean
Iteracion = 0
A = -10
B = 10
Epsilon = 0.000001
Maxlteraciones = False
Do
x1Ant = x1
x2Ant = x2
C = (A + B) / 2
x1 = C - Epsilon
x2 = C + Epsilon
fx1 = fp(prmx1, prmx2, prmv1, prmv2, x1)
fx2 = fp(prmx1, prmx2, prmv1, prmv2, x2)
If fx1 > fx2 Then A = x1 Else B = x2
Iteracion = Iteracion + 1
If Iteracion > 100 Then Maxlteraciones = True
Distancia = ((x1 - x1Ant) ^ 2 + (x2 - x2Ant) ^ 2) ^ (0.5)
Loop Until Distancia <= Epsilon Or MaxIteraciones
Lambda_Optimo = C
End Function
Public Function fx(x1 As Double, x2 As Double) As Double
fx = 100 * (x2 - x1 ^ 2) ^ 2 + (1 - x1) ^ 2
End Function
Public Function fp(x1k As Double, x2k, v1k As Double, v2k As Double, t As Double)
fp = fx((x1k + t * v1k), (x2k + t * v2k))
End Function
Public Function Limpiar()
Columns("A:F").Select
Selection.ClearContents
End Function
Public Function Titulos()
Range("A2").Select
ActiveCell.FormulaR1C1 = "Interación"
Range("B2").Select
ActiveCell.FormulaR1C1 = "Dirección"
Range("C2").Select
ActiveCell.FormulaR1C1 = "X1"
Range("D2").Select
ActiveCell.FormulaR1C1 = "X2"
Range("E2").Select
ActiveCell.FormulaR1C1 = "V1"
Range("F2").Select
ActiveCell.FormulaR1C1 = "V2"
Range("G2").Select
ActiveCell.FormulaR1C1 = "Lambda"
Range("H2").Select
ActiveCell.FormulaR1C1 = "Fx(x)"
Range("I2").Select
ActiveCell.FormulaR1C1 = "Distancia"
End Function
Function Imprime(ByVal p As Double, ByVal I As Double, ByVal xa As Double, ByVal xb As Double, ByVal va As Double, ByVal vb As Double, ByVal Lam As Double, ByVal fxx As Double, ByVal Dist As Double)
Range("B" & p).Select
ActiveCell.FormulaR1C1 = I
Range("C" & p).Select
ActiveCell.FormulaR1C1 = xa
Range("D" & p).Select
ActiveCell.FormulaR1C1 = xb
Range("E" & p).Select
ActiveCell.FormulaR1C1 = va
Range("F" & p).Select
ActiveCell.FormulaR1C1 = vb
Range("G" & p).Select
ActiveCell.FormulaR1C1 = Lam
Range("H" & p).Select
ActiveCell.FormulaR1C1 = fxx
Range("I" & p).Select
ActiveCell.FormulaR1C1 = Dist
End Function