elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Rompecabezas de Bitcoin, Medio millón USD en premios


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [SRC] Triangulo Pascal [by *PsYkE1*]		0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [SRC] Triangulo Pascal [by *PsYkE1*]  (Leído 3,023 veces)
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
[SRC] Triangulo Pascal [by *PsYkE1*]
« en: 24 Mayo 2010, 12:04 pm »
Hola a todos, tras darle muchas vueltas he conseguido hacer un Triangulo de Pascal desde VB6.
Para que veais que no es un C&P os dire como llegue a la conclusion y os explicare cada paso que doy en los comentarios que aparecen en el code.

Deduccion:

Sabia que habia que resolverlo con una matriz, asi que hice una de 5x5 introduciendo los números que me deberian salir, algo asi:

Código:
1 0 0 0 0
1 1 0 0 0
1 2 1 0 0 
1 3 3 1 0
1 4 6 4 1

Bien, una vez aqui pense cual era la logica de los numeros una vez dentro de la matriz...
Llegue a la conclusion de que todo elemento viene dado de la suma del que tiene encima con el de la izquierda del que tiene encima (que mal me explico)... :-\
Unos ejemplos:
*El numero 4 sale de la suma del que tiene envima ( el 1) y el de la izquierda al que tiene encima (el 3)
*El numero 2 sale de la suma del que tiene envima ( el 1) y el de la izquierda al que tiene encima (otro 1)

Una vez aqui, os resultara muy facil entender la siguiente formula:

Código:
Matriz(x,y) = Matriz(x-1,y) + Martiz(x-1,y-1)

Me dejo de rodeos y os dejo el code:
Código
  1. ' ////////////////////////////////////////////////////////////////
  2. ' // *Autor: *PsYkE1* (miguelin.majo@gmail.com)                 //
  3. ' // *Podeis agrandar o reducir el codigo, siempre y cuando se  //
  4. ' // respete la autoria y se me comuniquen esos cambios.        //
  5. ' // *Visita http://foro.rthacker.net                           //
  6. ' ////////////////////////////////////////////////////////////////
  7.  
  8. Rem Insertar TextBox con la propiedad Multiline = True y ScrollBars = Both
  9.  
  10. Option Explicit
  11.  
  12. Public Sub Generate_Pascal_Triangle(ByVal tTextBox As TextBox, ByVal iPotency As Integer)
  13.     '//Declaro variables
  14.     Dim lNumbersArray()          As Double
  15.     Dim dNumber                  As Double
  16.     Dim x                        As Long
  17.     Dim y                        As Long
  18.  
  19.     '//Si la Potencia es menor a 3 sale del procedimiento
  20.     If iPotency > 2 Then
  21.         '//Redimensiono mi matriz con tantas filas y columnas como me indique la potencia
  22.         ReDim lNumbersArray(iPotency, iPotency)
  23.  
  24.         '//Edito la primera linea de mi matriz puesto que la necesito como base
  25.         lNumbersArray(1, 1) = 1
  26.         For x = 2 To iPotency
  27.             lNumbersArray(x, 1) = 0
  28.         Next
  29.  
  30.         For x = 2 To iPotency
  31.             For y = 1 To iPotency
  32.                 '//Si estoy en la primera columna no podria sumar otro elemento de mi matriz que
  33.                 'este más a la izquierda, si ocurre eso asigo a mi variable dNumber el valor 0
  34.                 If (y - 1) < 1 Then
  35.                     dNumber = 0
  36.                 Else
  37.                     dNumber = lNumbersArray(x - 1, y - 1)
  38.                 End If
  39.                 '//Utilizo la fórmula que puse antes
  40.                 lNumbersArray(x, y) = dNumber + lNumbersArray(x - 1, y)
  41.             Next
  42.         Next
  43.  
  44.         With tTextBox
  45.             .Text = vbNullString    '//Limpio el TextBox
  46.             .Alignment = 2          '//Pongo el texto centrado para que se aprecie mejor la piramide
  47.             For x = 1 To iPotency
  48.                 For y = 1 To iPotency
  49.                     '//Represento la matriz ya editada prescindiendo de los ceros
  50.                     If lNumbersArray(x, y) <> 0 Then .Text = .Text & lNumbersArray(x, y) & Chr$(32)
  51.                 Next
  52.                 '//Nueva linea despues de acabar una fila
  53.                 .Text = .Text & vbCrLf
  54.             Next
  55.         End With
  56.         '//Borro mi matriz
  57.         Erase lNumbersArray '//Esto es prescindible ;)
  58.     End If
  59. End Sub

Un ejemplito:

Código
  1. Private Sub Form_Load()
  2.     Call Generate_Pascal_Triangle(Text1, 10)
  3. End Sub

Obtenriamos este resultado en el TextBox:
Código:
1 
1 1 
1 2 1 
1 3 3 1 
1 4 6 4 1 
1 5 10 10 5 1 
1 6 15 20 15 6 1 
1 7 21 35 35 21 7 1 
1 8 28 56 70 56 28 8 1 
1 9 36 84 126 126 84 36 9 1

Esto es todo, espero que os sirva...  :P
Espero el siguiente reto

Salu2!  ;)
« Última modificación: 6 Julio 2010, 19:10 pm por *PsYkE1* » En línea
http://foro.h-sec.org/
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [SRC] Triangulo Pascal [by *PsYkE1*]
« Respuesta #1 en: 27 Mayo 2010, 08:52 am »
MMM se me hace familiar...

http://foro.elhacker.net/programacion_visual_basic/source_triangulo_pascal-t279857.0.html;msg1379201

Cita de: BlackZeroX▓▓▒▒░░ en  3 Enero 2010, 22:36 pm
bueno andaba aburrido e hice el codigo para generar el triangulo de pascal

se nesesitan

2 textBox (textbox 2 en propiedad multilinea = true)
1 CommandButton

Código
  1.  
  2. '
  3. ' ////////////////////////////////////////////////////////////////
  4. ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
  5. ' //                                                            //
  6. ' // Web: http://InfrAngeluX.Sytes.Net/                         //
  7. ' //                                                            //
  8. ' // |-> Pueden Distribuir Este Codigo siempre y cuando         //
  9. ' // no se eliminen los creditos originales de este codigo      //
  10. ' // No importando que sea modificado/editado o engrandesido    //
  11. ' // o achicado, si es en base a este codigo                    //
  12. ' ////////////////////////////////////////////////////////////////
  13.  
  14. Option Explicit
  15.  
  16. Public Function GenerateTrianglePascal(ByVal nLineas As Long) As String
  17. On Error GoTo 1
  18. Dim a                       As Long
  19. Dim b                       As Long
  20. Dim CelVar()                As Double
  21.     If nLineas > 0 Then
  22.         ReDim CelVar(nLineas, nLineas)
  23.         For a = 1 To nLineas
  24.             For b = 1 To a: DoEvents
  25.                 CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b))))
  26.                 GenerateTrianglePascal = GenerateTrianglePascal & CelVar(a, b) & IIf(Not b = a, String(3, " "), "")
  27.             Next b
  28.             If a <> nLineas Then GenerateTrianglePascal = GenerateTrianglePascal & vbCrLf
  29.         Next a
  30. 1:      Erase CelVar
  31.     End If
  32. End Function
  33.  
  34. Private Sub Form_Load()
  35.     Text2.Alignment = 2 '   //  Modo centralizado
  36. End Sub
  37.  
  38. Private Sub Command1_Click()
  39.     Text2.Text = GenerateTrianglePascal(Val(Text1.Text))
  40. End Sub
  41.  
  42.  

con dowhile y doevents

Código
  1.  
  2. '
  3. ' ////////////////////////////////////////////////////////////////
  4. ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
  5. ' //                                                            //
  6. ' // Web: http://InfrAngeluX.Sytes.Net/                         //
  7. ' //                                                            //
  8. ' // |-> Pueden Distribuir Este Codigo siempre y cuando         //
  9. ' // no se eliminen los creditos originales de este codigo      //
  10. ' // No importando que sea modificado/editado o engrandesido    //
  11. ' // o achicado, si es en base a este codigo                    //
  12. ' ////////////////////////////////////////////////////////////////
  13.  
  14. Option Explicit
  15.  
  16. Public Function GenerateTrianglePascal(ByVal nLineas As Long) As String
  17. On Error GoTo 1
  18. Dim a                           As Long
  19. Dim b                           As Long
  20. Dim CelVar()                    As Double
  21.     If nLineas > 0 Then
  22.         ReDim CelVar(nLineas, nLineas)
  23.         a = 1: Do While a <= nLineas
  24.             b = 1: Do While b <= a: DoEvents
  25.                 CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b))))
  26.                 GenerateTrianglePascal = GenerateTrianglePascal & CelVar(a, b) & IIf(Not b = a, String(2, " "), "")
  27.             b = b + 1: Loop
  28.             If a <> nLineas Then GenerateTrianglePascal = GenerateTrianglePascal & vbCrLf
  29.         a = a + 1: Loop
  30. 1:      Erase CelVar
  31.     End If
  32. End Function
  33.  
  34. Private Sub Form_Load()
  35.     Text2.Alignment = 2 '   //  Modo centralizado
  36. End Sub
  37.  
  38. Private Sub Command1_Click()
  39.     Text2.Text = GenerateTrianglePascal(Val(Text1.Text))
  40. End Sub
  41.  
  42.  


Código ligeramente mejorado ya se se queda tanto tiempo muerto!¡.

Código
  1.  
  2. '
  3. ' ////////////////////////////////////////////////////////////////
  4. ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
  5. ' //                                                            //
  6. ' // Web: http://InfrAngeluX.Sytes.Net/                         //
  7. ' //                                                            //
  8. ' // |-> Pueden Distribuir Este Codigo siempre y cuando         //
  9. ' // no se eliminen los creditos originales de este codigo      //
  10. ' // No importando que sea modificado/editado o engrandesido    //
  11. ' // o achicado, si es en base a este codigo                    //
  12. ' ////////////////////////////////////////////////////////////////
  13.  
  14. Option Explicit
  15.  
  16. Public Sub GenerateTrianglePascal(ByVal nLineas As Long, ByRef OutData As String)
  17. 'On Error GoTo 1
  18. Dim a                       As Long
  19. Dim b                       As Long
  20. Dim Puntero                 As Long
  21. Dim Longitud                As Long
  22. Dim Temporal                As String
  23. Dim CelVar()                As Double
  24. Dim OutDataTemp             As String
  25. Const KiloByte              As Long = 5120
  26.     If nLineas > 0 Then
  27.         ReDim CelVar(nLineas, nLineas)
  28.         Puntero = 1
  29.         OutDataTemp = Space(KiloByte)
  30.         Temporal = Space(255)
  31.         For a = 1 To nLineas
  32.             For b = 1 To a: DoEvents
  33.                 CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b))))
  34.                 Temporal = CelVar(a, b) & IIf(a <> b, " ", "")
  35.                 Longitud = Len(Temporal)
  36.                 Mid(OutDataTemp, Puntero, Longitud) = Temporal
  37.                 Puntero = Puntero + Longitud
  38.                 If Puntero > KiloByte Then
  39.                     OutData = OutData & OutDataTemp
  40.                     OutDataTemp = Space(KiloByte)
  41.                     Puntero = 2
  42.                 End If
  43.             Next b
  44.             If a <> nLineas Then
  45.                 Puntero = Puntero
  46.                 Mid(OutDataTemp, Puntero, 2) = vbCrLf
  47.                 Puntero = Puntero + 2
  48.             End If
  49.             Caption = a
  50.         Next a
  51. 1:      Erase CelVar
  52.     End If
  53.     OutData = OutData & Trim$(OutDataTemp)
  54. End Sub
  55. Private Sub Form_Load()
  56.     Text2.Alignment = 2 '   //  Modo centralizado
  57. End Sub
  58. Private Sub Command1_Click()
  59. Dim datas                   As String
  60.     Call GenerateTrianglePascal(Val(Text1.Text), datas)
  61.     Text2.Text = datas
  62. End Sub
  63.  
  64.  

la longitud de los números esta limitada por el buffer que solo le asigne 255 caracteres.

El limite de lineas es de 932 si es que no se aumentan los buffers de memoria


P.D.: El código en lugar de hacerle un redim a celvar(x,x) puede hacerse de esta forma Celver(1,x) pero decidí dejar los registros anteriores por si alguien deseaba hacerles cambios aun que de esta forma en la que lo deje gasta mas memoria ram en el modo celvar(1,x) no gastaría tanta pero tendría que estarse usando copymemori (API) para mover el de 1 a 0 y sacar los nuevos valores.



Dulces Lunas!¡
En línea
The Dark Shadow is my passion.
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [SRC] Triangulo Pascal [by *PsYkE1*]
« Respuesta #2 en: 27 Mayo 2010, 09:05 am »

Este es el MAS RAPIDO y "OPTIMO" (Solo se debe sustituir el iif() por un If Then y  unos cuantos Val en los iff() aqui mismo debajo del original lo pongo corregido) solo por si se me confunden con mi cita:

Código
  1.  
  2. '
  3. ' ////////////////////////////////////////////////////////////////
  4. ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
  5. ' //                                                            //
  6. ' // Web: http://InfrAngeluX.Sytes.Net/                         //
  7. ' //                                                            //
  8. ' // |-> Pueden Distribuir Este Codigo siempre y cuando         //
  9. ' // no se eliminen los creditos originales de este codigo      //
  10. ' // No importando que sea modificado/editado o engrandesido    //
  11. ' // o achicado, si es en base a este codigo                    //
  12. ' ////////////////////////////////////////////////////////////////
  13.  
  14. Option Explicit
  15.  
  16. Public Sub GenerateTrianglePascal(ByVal nLineas As Long, ByRef OutData As String)
  17. 'On Error GoTo 1
  18. Dim a                       As Long
  19. Dim b                       As Long
  20. Dim Puntero                 As Long
  21. Dim Longitud                As Long
  22. Dim Temporal                As String
  23. Dim CelVar()                As Double
  24. Dim OutDataTemp             As String
  25. Const KiloByte              As Long = 5120
  26.     If nLineas > 0 Then
  27.         ReDim CelVar(nLineas, nLineas)
  28.         Puntero = 1
  29.         OutDataTemp = Space(KiloByte)
  30.         Temporal = Space(255)
  31.         For a = 1 To nLineas
  32.             For b = 1 To a: DoEvents
  33.                 CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b))))
  34.                 Temporal = CelVar(a, b) & IIf(a <> b, " ", "")
  35.                 Longitud = Len(Temporal)
  36.                 Mid(OutDataTemp, Puntero, Longitud) = Temporal
  37.                 Puntero = Puntero + Longitud
  38.                 If Puntero > KiloByte Then
  39.                     OutData = OutData & OutDataTemp
  40.                     OutDataTemp = Space(KiloByte)
  41.                     Puntero = 2
  42.                 End If
  43.             Next b
  44.             If a <> nLineas Then
  45.                 Puntero = Puntero
  46.                 Mid(OutDataTemp, Puntero, 2) = vbCrLf
  47.                 Puntero = Puntero + 2
  48.             End If
  49.             Caption = a
  50.         Next a
  51. 1:      Erase CelVar
  52.     End If
  53.     OutData = OutData & Trim$(OutDataTemp)
  54. End Sub
  55. Private Sub Form_Load()
  56.     Text2.Alignment = 2 '   //  Modo centralizado
  57. End Sub
  58. Private Sub Command1_Click()
  59. Dim datas                   As String
  60.     Call GenerateTrianglePascal(Val(Text1.Text), datas)
  61.     Text2.Text = datas
  62. End Sub
  63.  
  64.  

Codigo Optimo a mi Criterio Visto.

Código
  1.  
  2. '
  3. ' ////////////////////////////////////////////////////////////////
  4. ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
  5. ' //                                                            //
  6. ' // Web: http://InfrAngeluX.Sytes.Net/                         //
  7. ' //                                                            //
  8. ' // |-> Pueden Distribuir Este Codigo siempre y cuando         //
  9. ' // no se eliminen los creditos originales de este codigo      //
  10. ' // No importando que sea modificado/editado o engrandesido    //
  11. ' // o achicado, si es en base a este codigo                    //
  12. ' ////////////////////////////////////////////////////////////////
  13.  
  14. Option Explicit
  15.  
  16. Public Sub GenerateTrianglePascal(ByVal nLineas As Long, ByRef OutData As String)
  17. 'On Error GoTo 1
  18. Dim a                       As Long
  19. Dim b                       As Long
  20. Dim Puntero                 As Long
  21. Dim Longitud                As Long
  22. Dim Temporal                As String
  23. Dim CelVar()                As Double
  24. Dim OutDataTemp             As String
  25. Const KiloByte              As Long = 5120      '   //  Buffer Limite
  26.     If nLineas > 0 Then
  27.         ReDim CelVar(nLineas, nLineas)
  28.         Puntero = 1
  29.         OutDataTemp = Space(KiloByte)
  30.         Temporal = Space(255)
  31.         For a = 1 To nLineas
  32.             For b = 1 To a: DoEvents
  33.                 Rem     Start CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b))))
  34.                 If b = 1 Then
  35.                     CelVar(a, b) = 1
  36.                 Else
  37.                     CelVar(a, b) = CelVar(a - 1, b - 1) + CelVar(a - 1, b)
  38.                 End If
  39.                 Rem     End CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b))))
  40.                 Rem     Start Temporal = CelVar(a, b) & IIf(a <> b, " ", "")
  41.                 Temporal = CelVar(a, b)
  42.                 If a <> b Then
  43.                     Temporal = Temporal & " "
  44.                 End If
  45.                 Rem     End Temporal = CelVar(a, b) & IIf(a <> b, " ", "")
  46.                 Longitud = Len(Temporal)
  47.                 Mid(OutDataTemp, Puntero, Longitud) = Temporal
  48.                 Puntero = Puntero + Longitud
  49.                 If Puntero > KiloByte Then
  50.                     OutData = OutData & OutDataTemp
  51.                     OutDataTemp = Space(KiloByte)
  52.                     Puntero = 2
  53.                 End If
  54.             Next b
  55.             If a <> nLineas Then
  56.                 Puntero = Puntero
  57.                 Mid(OutDataTemp, Puntero, 2) = vbCrLf
  58.                 Puntero = Puntero + 2
  59.             End If
  60.             Caption = a
  61.         Next a
  62. 1:      Erase CelVar
  63.     End If
  64.     OutData = OutData & Trim$(OutDataTemp)
  65. End Sub
  66. Private Sub Form_Load()
  67.     Text2.Alignment = 2 '   //  Modo centralizado
  68. End Sub
  69. Private Sub Command1_Click()
  70. Dim datas                   As String
  71.     Call GenerateTrianglePascal(Val(Text1.Text), datas)
  72.     Text2.Text = datas
  73. End Sub
  74.  
  75.  

Dulce Infierno Lunar!¡.
En línea
The Dark Shadow is my passion.
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [SRC] Triangulo Pascal [by *PsYkE1*]
« Respuesta #3 en: 27 Mayo 2010, 09:14 am »
Gracias Black! ;) :D
No tenia ni idea que habias hecho uno tu!!
Voy a estudiarlo con detenimiento
Una vez mas:
Gracias! ;D
En línea
http://foro.h-sec.org/
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Triangulo De Sierpinsky
Java 		zaico 3 5,341 Último mensaje 2 Mayo 2012, 03:31 am
por _teiki
[C] Imprimir Triangulo de Pascal
Programación C/C++ 		edr89 3 16,526 Último mensaje 7 Junio 2013, 09:27 am
por leosansan
Binomio de Newton, y triángulo de Pascal « 1 2 3 4 »
Programación C/C++ 		Yoel Alejandro 36 41,101 Último mensaje 21 Marzo 2014, 16:54 pm
por Yoel Alejandro
Forma triangulo de pascal
Programación C/C++ 		shulpeca 0 1,836 Último mensaje 1 Diciembre 2017, 22:47 pm
por shulpeca
Necesito ayuda con un programa en c
Programación C/C++ 		jorgito19998 1 1,816 Último mensaje 23 Febrero 2018, 23:41 pm
por dijsktra
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines