• Viernes 8 de Noviembre de 2024, 13:42

Mostrar Mensajes

Esta sección te permite ver todos los posts escritos por este usuario. Ten en cuenta que sólo puedes ver los posts escritos en zonas a las que tienes acceso en este momento.


Mensajes - 0Y0L@

Páginas: [1]
1
Visual Basic para principiantes / Re: metodo de powell
« en: Sábado 29 de Mayo de 2010, 22:04 »
No sé si sea tarde, pero, para los que lo necesiten en el futuro, :hitcomp:
 
Código: Visual Basic
  1. Sub Powell_Multidimensional()
  2.     Dim Lambda As Double
  3.     Dim Epsilon As Double
  4.     Dim x(3, 2) As Double
  5.     Dim v(3, 2) As Double
  6.     Dim Iteracion As Integer
  7.     Dim I As Integer
  8.     Dim n As Integer
  9.     Dim p As Integer
  10.    
  11.     n = 2
  12.     p = 3
  13.    
  14.     x(0, 0) = -0.5      ' Punto inicial
  15.     x(0, 1) = 0.5       ' Punto inicial
  16.    
  17.     v(1, 0) = -0.5      ' Conjunto inicial de direcciones
  18.     v(1, 1) = 0
  19.     v(2, 0) = 0
  20.     v(2, 1) = 0.5
  21.     Iteracion = 0
  22.    
  23.     Limpiar             ' Limpio los resultados anteriores
  24.     Titulos             ' Imprimo titulos de columnas
  25.     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)
  26.    
  27.     p = p + 1
  28.    
  29.     Do
  30.         Range("A" & p).Select
  31.         ActiveCell.FormulaR1C1 = Iteracion
  32.        
  33.         For I = 1 To n
  34.             Lambda = Lambda_Optimo(x(I - 1, 0), x(I - 1, 1), v(I, 0), v(I, 1))
  35.             x(I, 0) = x(I - 1, 0) + Lambda * v(I, 0)
  36.             x(I, 1) = x(I - 1, 1) + Lambda * v(I, 1)
  37.             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)
  38.             p = p + 1
  39.         Next I
  40.        
  41.         For I = 1 To n - 1
  42.             v(I, 0) = v(I + 1, 0)
  43.             v(I, 1) = v(I + 1, 1)
  44.         Next I
  45.        
  46.         v(n, 0) = x(n, 0) - x(0, 0)
  47.         v(n, 1) = x(n, 1) - x(0, 1)
  48.        
  49.         Lambda = Lambda_Optimo(x(n, 0), x(n, 1), v(n, 0), v(n, 1))
  50.        
  51.         x(0, 0) = x(n, 0) + Lambda * v(n, 0)
  52.         x(0, 1) = x(n, 1) + Lambda * v(n, 1)
  53.         Distancia = v(n, 0) ^ 2 + v(n, 1) ^ 2
  54.        
  55.         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)
  56.                
  57.         Epsilon = 1
  58.         p = p + 1
  59.         Iteracion = Iteracion + 1
  60.     Loop Until Distancia <= 1 * 10 ^ (-25) Or Iteracion > 1000
  61. End Sub
  62. Public Function Lambda_Optimo(ByVal prmx1 As Double, ByVal prmx2 As Double, ByVal prmv1 As Double, ByVal prmv2 As Double) As Double
  63.     Dim px1k, px2k, A, B, C, Epsilon As Double
  64.     Dim fx1, fx2 As Double
  65.     Dim x1 As Double
  66.     Dim x2 As Double
  67.     Dim x1Ant, x2Ant As Double
  68.     Dim Distancia, Iteracion As Double
  69.     Dim Maxlteraciones As Boolean
  70.    
  71.     Iteracion = 0
  72.     A = -10
  73.     B = 10
  74.     Epsilon = 0.000001
  75.     Maxlteraciones = False
  76.    
  77.     Do
  78.         x1Ant = x1
  79.         x2Ant = x2
  80.         C = (A + B) / 2
  81.         x1 = C - Epsilon
  82.         x2 = C + Epsilon
  83.         fx1 = fp(prmx1, prmx2, prmv1, prmv2, x1)
  84.         fx2 = fp(prmx1, prmx2, prmv1, prmv2, x2)
  85.         If fx1 > fx2 Then A = x1 Else B = x2
  86.         Iteracion = Iteracion + 1
  87.         If Iteracion > 100 Then Maxlteraciones = True
  88.         Distancia = ((x1 - x1Ant) ^ 2 + (x2 - x2Ant) ^ 2) ^ (0.5)
  89.     Loop Until Distancia <= Epsilon Or MaxIteraciones
  90.     Lambda_Optimo = C
  91. End Function
  92. Public Function fx(x1 As Double, x2 As Double) As Double
  93.     fx = 100 * (x2 - x1 ^ 2) ^ 2 + (1 - x1) ^ 2
  94. End Function
  95. Public Function fp(x1k As Double, x2k, v1k As Double, v2k As Double, t As Double)
  96.     fp = fx((x1k + t * v1k), (x2k + t * v2k))
  97. End Function
  98. Public Function Limpiar()
  99.     Columns("A:F").Select
  100.     Selection.ClearContents
  101. End Function
  102. Public Function Titulos()
  103.     Range("A2").Select
  104.     ActiveCell.FormulaR1C1 = "Interación"
  105.     Range("B2").Select
  106.     ActiveCell.FormulaR1C1 = "Dirección"
  107.     Range("C2").Select
  108.     ActiveCell.FormulaR1C1 = "X1"
  109.     Range("D2").Select
  110.     ActiveCell.FormulaR1C1 = "X2"
  111.     Range("E2").Select
  112.     ActiveCell.FormulaR1C1 = "V1"
  113.     Range("F2").Select
  114.     ActiveCell.FormulaR1C1 = "V2"
  115.     Range("G2").Select
  116.     ActiveCell.FormulaR1C1 = "Lambda"
  117.     Range("H2").Select
  118.     ActiveCell.FormulaR1C1 = "Fx(x)"
  119.     Range("I2").Select
  120.     ActiveCell.FormulaR1C1 = "Distancia"
  121. End Function
  122. 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)
  123.     Range("B" & p).Select
  124.     ActiveCell.FormulaR1C1 = I
  125.     Range("C" & p).Select
  126.     ActiveCell.FormulaR1C1 = xa
  127.     Range("D" & p).Select
  128.     ActiveCell.FormulaR1C1 = xb
  129.     Range("E" & p).Select
  130.     ActiveCell.FormulaR1C1 = va
  131.     Range("F" & p).Select
  132.     ActiveCell.FormulaR1C1 = vb
  133.     Range("G" & p).Select
  134.     ActiveCell.FormulaR1C1 = Lam
  135.     Range("H" & p).Select
  136.     ActiveCell.FormulaR1C1 = fxx
  137.     Range("I" & p).Select
  138.     ActiveCell.FormulaR1C1 = Dist
  139. End Function
  140.  
  141.  

Páginas: [1]