• Viernes 8 de Noviembre de 2024, 11:46

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

Páginas: [1]
1
Visual Basic 6.0 e inferiores / Re: Problema de hidraulica con integrales
« en: Jueves 29 de Enero de 2009, 18:39 »
Código: Text
  1.  
  2. 'Implemento la misma funcion que en el apartado anterior aunque en este caso lo que buscamos es el calado y2
  3. Function func(y As Double) As Double
  4.  
  5. Dim Q As Double, B_y As Double, G As Double, A_y As Double, I0 As Double, n As Double, Rh As Double, P_y As Double, b As Double, m As Double, L As Double
  6.  
  7.  
  8.  
  9. Q = Hoja1.Cells(2, 1)
  10.  
  11. G = Hoja1.Cells(2, 2)
  12.  
  13. I0 = Hoja1.Cells(2, 3)
  14.  
  15. n = Hoja1.Cells(2, 4)
  16.  
  17. m = Hoja1.Cells(2, 5)
  18.  
  19. b = Hoja1.Cells(2, 6)
  20.  
  21. L = Hoja1.Cells(17, 1)
  22.  
  23.  
  24.  
  25. B_y = b + 2 * m * y
  26.  
  27. A_y = (b + m * y) * y
  28.  
  29. P_y = b + 2 * Sqr(1 + (m ^ 2) * y)
  30.  
  31. Rh = A_y / P_y
  32.  
  33.  
  34. func = ((((Q ^ 2) * B_y) / (G * A_y ^ 3)) - 1) * (I0 - ((n * Q) / (A_y * Rh ^ (2 / 3))) ^ 2) ^ (-1)
  35.  
  36. End Function
  37.  

La funcion func yo creo k esta bien implementada

Creo que el problema seguramente esta en como he implementado la integral. Normalment te definen la integral, en cambio ahora la integral esta en parte definida (de y1 conocido, a y2 que queremos conocer).
La implementacion del metodo de Newton yo creo que esta bien.

Os dejo la implementacion de la integral:

Código: Text
  1. 'Implemento el metodo de simpson
  2.  
  3. Function simpson(y() As Double, n_n As Integer) As Double
  4.  
  5. Dim i As Integer, f1 As Double, f2 As Double, f3 As Double
  6. Dim val As Double, h As Double, m_m As Integer
  7.  
  8. n_n = Hoja1.Cells(2, 8)
  9.  
  10. y1 = Hoja1.Cells(2, 9)
  11.  
  12. y2 = xk
  13.  
  14. ReDim y(n_n)
  15. h = (y2 - y1) / n_n
  16. For i = 0 To n_n
  17.     x(i) = x1 + i * h
  18. Next i
  19.  
  20. val = 0
  21. m_m = n_n / 2
  22.  
  23.  
  24. For i = 1 To m_m
  25.  
  26. f1 = func(y(2 * i - 2))
  27. f2 = func(y(2 * i - 1))
  28. f3 = func(y(2 * i))
  29.  
  30. h = y(i + 1) - y(i)
  31.  
  32. val = val + (h / 3) * (f1 + 4 * f2 + f3)
  33.  
  34. Next i
  35.  
  36.  
  37. simpson = val
  38.  
  39. End Function
  40.  
  41.  

 
Adjuntos
 Trabajo_1.doc
(198.5 KiB) 1 vez

2
Visual Basic 6.0 e inferiores / Re: Problema de hidraulica con integrales
« en: Jueves 29 de Enero de 2009, 13:23 »
El apartado 2 no me da un resultado logico. deberia darme el calado y2 y me da el valor que pongo para el calado y1.

3
Visual Basic 6.0 e inferiores / Re: Problema de hidraulica con integrales
« en: Jueves 29 de Enero de 2009, 11:54 »
Me pensaba que este era el foro de vba.

Ya que el 1º metodo aun no se como se estima el error (me lo tienen que decir), el 2º en teoria se deberia poder hacer.

He puesto una descripcion de cada parte del codigo explicando lo que hago

4
Visual Basic 6.0 e inferiores / Re: Problema de hidraulica con integrales
« en: Jueves 29 de Enero de 2009, 10:45 »
Ya esto hecho, gracias. Espero que ahora se lea mejor.

5
Visual Basic 6.0 e inferiores / Re: Problema de hidraulica con integrales
« en: Jueves 29 de Enero de 2009, 10:19 »
Etiquetas?¿ como lo hago?¿

6
Visual Basic 6.0 e inferiores / Problema de hidraulica con integrales
« en: Miércoles 28 de Enero de 2009, 19:32 »
Hola me han puesto un problema de hidaulica relacionado con integrales y ceros de funciones. Es bastante liante y querria saber si alguien podria ayudarme, tengo en el 1º apartado una duda sobre como estimar el error relativo , y el apartado dos no acavo de programarlo bien:


Os dejo lo que he programado,para el apartado 1:





Código: Text
  1. Option Explicit
  2.  
  3. Function func(y As Double) As Double
  4.  
  5. Dim Q As Double, B_y As Double, G As Double, A_y As Double, I0 As Double, n As Double, Rh As Double, P_y As Double, b As Double, m As Double
  6.  
  7.  'Implementamos la funcion que hay que integrar para encontrar la distancia
  8.  
  9. Q = Hoja1.Cells(2, 1)
  10.  
  11. G = Hoja1.Cells(2, 2)
  12.  
  13. I0 = Hoja1.Cells(2, 3)
  14.  
  15. n = Hoja1.Cells(2, 4)
  16.  
  17. m = Hoja1.Cells(2, 5)
  18.  
  19. b = Hoja1.Cells(2, 6)
  20.  
  21.  
  22.  
  23. B_y = b + 2 * m * y
  24.  
  25. A_y = (b + m * y) * y
  26.  
  27. P_y = b + 2 * Sqr(1 + (m ^ 2) * y)
  28.  
  29. Rh = A_y / P_y
  30.  
  31.  
  32. func = ((((Q ^ 2) * B_y) / (G * A_y ^ 3)) - 1) * (I0 - ((n * Q) / (A_y * Rh ^ (2 / 3))) ^ 2) ^ (-1)
  33.  
  34.  
  35.  
  36. End Function
  37.  
  38.  
  39. Sub integracion()
  40.  
  41. Dim metodo As String, y() As Double, n_n As Integer, y1 As Double, y2 As Double, i As Integer, h As Double, integral As Double
  42.  [color=#40BF00]'Utilizo una sub que llame a la function trapezio o simpson segun se quiera [/color]
  43.  
  44. metodo = Hoja1.Cells(2, 7)
  45.  
  46. n_n = Hoja1.Cells(2, 8)
  47.  
  48. y1 = Hoja1.Cells(2, 9)
  49.  
  50. y2 = Hoja1.Cells(2, 10)
  51.  
  52.  
  53.  
  54. If metodo = "simpson" And n_n Mod 2 <> 0 Then
  55.    MsgBox "Para emplear el método de Simpson el número de intervalos debe ser par"
  56.    Cells(5, 2) = "error"
  57.    Exit Sub
  58. End If
  59.  
  60.  
  61. ReDim y(n_n)
  62. h = (y2 - y1) / n_n
  63. For i = 0 To n_n
  64.     x(i) = x1 + i * h
  65. Next i
  66.  
  67.  
  68. If metodo = "trapecio" Then
  69.    integral = trapecio(x, n)
  70. ElseIf metodo = "simpson" Then
  71.    integral = simpson(x, n)
  72. End If
  73. Cells(5, 2) = integral
  74.  
  75. End Sub
  76.  
  77.  
  78. 'Implemento la funcion trapezio para calcular la integral
  79. Function trapecio(y() As Double, n_n As Integer) As Double
  80. Dim i As Integer, f1 As Double, f2 As Double
  81. Dim val As Double, h As Double
  82.  
  83. val = 0
  84.  
  85.  
  86. For i = 0 To n_n - 1
  87.  
  88. f1 = func(y(i))
  89. f2 = func(y(i + 1))
  90. h = (y(i + 1) - y(i))
  91.  
  92. val = val + (h * (f1 + f2)) / 2
  93.  
  94. Next i
  95.  
  96.  
  97.  
  98. trapecio = val
  99.  
  100. End Function
  101.  
  102.  
  103. 'Implemento simpson
  104. Function simpson(y() As Double, n_n As Integer) As Double
  105.  
  106. Dim i As Integer, f1 As Double, f2 As Double, f3 As Double
  107. Dim val As Double, h As Double, m_m As Integer
  108.  
  109.  
  110. val = 0
  111. m_m = n_n / 2
  112.  
  113.  
  114. For i = 1 To m_m
  115.  
  116. f1 = func(y(2 * i - 2))
  117. f2 = func(y(2 * i - 1))
  118. f3 = func(y(2 * i))
  119.  
  120. h = y(i + 1) - y(i)
  121.  
  122. val = val + (h / 3) * (f1 + 4 * f2 + f3)
  123.  
  124. Next i
  125.  
  126.  
  127. simpson = val
  128.  
  129. End Function
  130.  
  131.  
  132.  
  133.  
  134.  
  135. -Para el apartado 2:
  136.  
  137.  
  138. Option Explicit
  139.  
  140. 'Implemento la misma funcion que en el apartado anterior aunque en este caso lo que buscamos es el calado y2
  141. Function func(y As Double) As Double
  142.  
  143. Dim Q As Double, B_y As Double, G As Double, A_y As Double, I0 As Double, n As Double, Rh As Double, P_y As Double, b As Double, m As Double, L As Double
  144.  
  145.  
  146.  
  147. Q = Hoja1.Cells(2, 1)
  148.  
  149. G = Hoja1.Cells(2, 2)
  150.  
  151. I0 = Hoja1.Cells(2, 3)
  152.  
  153. n = Hoja1.Cells(2, 4)
  154.  
  155. m = Hoja1.Cells(2, 5)
  156.  
  157. b = Hoja1.Cells(2, 6)
  158.  
  159. L = Hoja1.Cells(17, 1)
  160.  
  161.  
  162.  
  163. B_y = b + 2 * m * y
  164.  
  165. A_y = (b + m * y) * y
  166.  
  167. P_y = b + 2 * Sqr(1 + (m ^ 2) * y)
  168.  
  169. Rh = A_y / P_y
  170.  
  171.  
  172. func = ((((Q ^ 2) * B_y) / (G * A_y ^ 3)) - 1) * (I0 - ((n * Q) / (A_y * Rh ^ (2 / 3))) ^ 2) ^ (-1)
  173.  
  174. End Function
  175.  
  176. 'Implemento el metodo de simpson
  177.  
  178. Function simpson(y() As Double, n_n As Integer) As Double
  179.  
  180. Dim i As Integer, f1 As Double, f2 As Double, f3 As Double
  181. Dim val As Double, h As Double, m_m As Integer
  182.  
  183. n_n = Hoja1.Cells(2, 8)
  184.  
  185. y1 = Hoja1.Cells(2, 9)
  186.  
  187. y2 = xk
  188.  
  189. ReDim y(n_n)
  190. h = (y2 - y1) / n_n
  191. For i = 0 To n_n
  192.     x(i) = x1 + i * h
  193. Next i
  194.  
  195. val = 0
  196. m_m = n_n / 2
  197.  
  198.  
  199. For i = 1 To m_m
  200.  
  201. f1 = func(y(2 * i - 2))
  202. f2 = func(y(2 * i - 1))
  203. f3 = func(y(2 * i))
  204.  
  205. h = y(i + 1) - y(i)
  206.  
  207. val = val + (h / 3) * (f1 + 4 * f2 + f3)
  208.  
  209. Next i
  210.  
  211.  
  212. simpson = val
  213.  
  214. End Function
  215.  
  216.  
  217.  'Utilizo una sub que llame a la sub del metodo de newton o de la biseccion
  218. Sub ceros()
  219.  
  220. Dim xk As Double, a As Double, tolx As Double, tolf As Double, maxiter As Integer, numiter As Integer
  221. Dim metodo As String
  222.  
  223. Hoja1.Activate
  224.  
  225. xk = Cells(2, 9)
  226. tolx = Hoja1.Cells(17, 2)
  227. tolf = Cells(17, 3)
  228. metodo = Cells(17, 4)
  229. maxiter = Cells(17, 6)
  230.  
  231. If metodo = "Newton" Then
  232.   Call MetodoNewton(xk, tolx, tolf, numiter, maxiter)
  233. ElseIf metodo = "Biseccion" Then
  234.     a = Cells(17, 5)
  235.     Call MetodoBiseccion(xk, a, tolx, tolf, numiter)
  236. Else
  237.   MsgBox " Método no reconocido"
  238.   numiter = 0
  239.  
  240. End If
  241.  
  242. Cells(20, 1) = xk
  243. Cells(20, 2) = numiter
  244. End Sub
  245.  
  246.  'implemento la sub del metodo de newton
  247. Sub MetodoNewton(xk As Double, tolx As Double, tolf As Double, numiter As Integer, maxiter As Integer)
  248.  
  249. Dim k As Integer, xkmas1 As Double, g_xk As Double, dg_xk As Double, errx As Double, errf As Double, L As Double, val As Double
  250.  
  251.  
  252. errx = 2 * tolx
  253. errf = 2 * tolf
  254.  
  255. k = 0
  256.  
  257. Cells(20 + k, 10) = k
  258. Cells(20 + k, 11) = xk
  259.  
  260. Do While (errf > tolf Or errx > tolx) And k <= maxiter
  261.  
  262. g_xk = L - val
  263. dg_xk = -func(xk)
  264. xkmas1 = xk - g_xk / dg_xk
  265.  
  266. errx = Abs(xkmas1 - xk) / Abs(xkmas1)
  267. errf = Abs(g_xk)
  268.  
  269. k = k + 1
  270.  
  271. xk = xkmas1
  272. Cells(20 + k, 10) = k
  273. Cells(20 + k, 11) = xk
  274. Cells(20 + k, 12) = errx
  275. Cells(20 + k, 13) = errf
  276.  
  277. Loop
  278.  
  279. numiter = k
  280. End Sub
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  
  287. 'esta sub no la he aun implementado a la espera de solucionar la del metodo de newton
  288. Sub MetodoBiseccion(xk As Double, a As Double, tolx As Double, tolf As Double, numiter As Integer)
  289.  
  290. End Sub
  291.  

Páginas: [1]