[SRC] Triangulo Pascal [by *PsYkE1*]

Psyke1 · 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 [Seleccionar]

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 [Seleccionar]


Matriz(x,y) = Matriz(x-1,y) + Martiz(x-1,y-1)

Me dejo de rodeos y os dejo el code:

Código (vb) [Seleccionar]


' ////////////////////////////////////////////////////////////////
' // *Autor: *PsYkE1* (miguelin.majo@gmail.com)                 //
' // *Podeis agrandar o reducir el codigo, siempre y cuando se  //
' // respete la autoria y se me comuniquen esos cambios.        //
' // *Visita http://foro.rthacker.net                           //
' ////////////////////////////////////////////////////////////////

Rem Insertar TextBox con la propiedad Multiline = True y ScrollBars = Both

Option Explicit

Public Sub Generate_Pascal_Triangle(ByVal tTextBox As TextBox, ByVal iPotency As Integer)
    '//Declaro variables
    Dim lNumbersArray()          As Double
    Dim dNumber                  As Double
    Dim x                        As Long
    Dim y                        As Long
    
    '//Si la Potencia es menor a 3 sale del procedimiento
    If iPotency > 2 Then
        '//Redimensiono mi matriz con tantas filas y columnas como me indique la potencia
        ReDim lNumbersArray(iPotency, iPotency)
    
        '//Edito la primera linea de mi matriz puesto que la necesito como base
        lNumbersArray(1, 1) = 1
        For x = 2 To iPotency
            lNumbersArray(x, 1) = 0
        Next
    
        For x = 2 To iPotency
            For y = 1 To iPotency
                '//Si estoy en la primera columna no podria sumar otro elemento de mi matriz que
                'este más a la izquierda, si ocurre eso asigo a mi variable dNumber el valor 0
                If (y - 1) < 1 Then
                    dNumber = 0
                Else
                    dNumber = lNumbersArray(x - 1, y - 1)
                End If
                '//Utilizo la fórmula que puse antes
                lNumbersArray(x, y) = dNumber + lNumbersArray(x - 1, y)
            Next
        Next
    
        With tTextBox
            .Text = vbNullString    '//Limpio el TextBox
            .Alignment = 2          '//Pongo el texto centrado para que se aprecie mejor la piramide
            For x = 1 To iPotency
                For y = 1 To iPotency
                    '//Represento la matriz ya editada prescindiendo de los ceros
                    If lNumbersArray(x, y) <> 0 Then .Text = .Text & lNumbersArray(x, y) & Chr$(32)
                Next
                '//Nueva linea despues de acabar una fila
                .Text = .Text & vbCrLf
            Next
        End With
        '//Borro mi matriz
        Erase lNumbersArray '//Esto es prescindible ;)
    End If
End Sub

Un ejemplito:

Código (vb) [Seleccionar]


Private Sub Form_Load()
    Call Generate_Pascal_Triangle(Text1, 10)
End Sub

Obtenriamos este resultado en el TextBox:

Código [Seleccionar]


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

Espero el siguiente reto

Salu2!

BlackZeroX · 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 (vb) [Seleccionar] Expandir
' ' //////////////////////////////////////////////////////////////// ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) // ' // // ' // Web: http://InfrAngeluX.Sytes.Net/ // ' // // ' // |-> Pueden Distribuir Este Codigo siempre y cuando // ' // no se eliminen los creditos originales de este codigo // ' // No importando que sea modificado/editado o engrandesido // ' // o achicado, si es en base a este codigo // ' //////////////////////////////////////////////////////////////// Option Explicit Public Function GenerateTrianglePascal(ByVal nLineas As Long) As String On Error GoTo 1 Dim a As Long Dim b As Long Dim CelVar() As Double If nLineas > 0 Then ReDim CelVar(nLineas, nLineas) For a = 1 To nLineas For b = 1 To a: DoEvents CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b)))) GenerateTrianglePascal = GenerateTrianglePascal & CelVar(a, b) & IIf(Not b = a, String(3, " "), "") Next b If a <> nLineas Then GenerateTrianglePascal = GenerateTrianglePascal & vbCrLf Next a 1: Erase CelVar End If End Function Private Sub Form_Load() Text2.Alignment = 2 ' // Modo centralizado End Sub Private Sub Command1_Click() Text2.Text = GenerateTrianglePascal(Val(Text1.Text)) End Sub

con dowhile y doevents

Código (vb) [Seleccionar] Expandir
' ' //////////////////////////////////////////////////////////////// ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) // ' // // ' // Web: http://InfrAngeluX.Sytes.Net/ // ' // // ' // |-> Pueden Distribuir Este Codigo siempre y cuando // ' // no se eliminen los creditos originales de este codigo // ' // No importando que sea modificado/editado o engrandesido // ' // o achicado, si es en base a este codigo // ' //////////////////////////////////////////////////////////////// Option Explicit Public Function GenerateTrianglePascal(ByVal nLineas As Long) As String On Error GoTo 1 Dim a As Long Dim b As Long Dim CelVar() As Double If nLineas > 0 Then ReDim CelVar(nLineas, nLineas) a = 1: Do While a <= nLineas b = 1: Do While b <= a: DoEvents CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b)))) GenerateTrianglePascal = GenerateTrianglePascal & CelVar(a, b) & IIf(Not b = a, String(2, " "), "") b = b + 1: Loop If a <> nLineas Then GenerateTrianglePascal = GenerateTrianglePascal & vbCrLf a = a + 1: Loop 1: Erase CelVar End If End Function Private Sub Form_Load() Text2.Alignment = 2 ' // Modo centralizado End Sub Private Sub Command1_Click() Text2.Text = GenerateTrianglePascal(Val(Text1.Text)) End Sub

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

Código (vb) [Seleccionar] Expandir
' ' //////////////////////////////////////////////////////////////// ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) // ' // // ' // Web: http://InfrAngeluX.Sytes.Net/ // ' // // ' // |-> Pueden Distribuir Este Codigo siempre y cuando // ' // no se eliminen los creditos originales de este codigo // ' // No importando que sea modificado/editado o engrandesido // ' // o achicado, si es en base a este codigo // ' //////////////////////////////////////////////////////////////// Option Explicit Public Sub GenerateTrianglePascal(ByVal nLineas As Long, ByRef OutData As String) 'On Error GoTo 1 Dim a As Long Dim b As Long Dim Puntero As Long Dim Longitud As Long Dim Temporal As String Dim CelVar() As Double Dim OutDataTemp As String Const KiloByte As Long = 5120 If nLineas > 0 Then ReDim CelVar(nLineas, nLineas) Puntero = 1 OutDataTemp = Space(KiloByte) Temporal = Space(255) For a = 1 To nLineas For b = 1 To a: DoEvents CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b)))) Temporal = CelVar(a, b) & IIf(a <> b, " ", "") Longitud = Len(Temporal) Mid(OutDataTemp, Puntero, Longitud) = Temporal Puntero = Puntero + Longitud If Puntero > KiloByte Then OutData = OutData & OutDataTemp OutDataTemp = Space(KiloByte) Puntero = 2 End If Next b If a <> nLineas Then Puntero = Puntero Mid(OutDataTemp, Puntero, 2) = vbCrLf Puntero = Puntero + 2 End If Caption = a Next a 1: Erase CelVar End If OutData = OutData & Trim$(OutDataTemp) End Sub Private Sub Form_Load() Text2.Alignment = 2 ' // Modo centralizado End Sub Private Sub Command1_Click() Dim datas As String Call GenerateTrianglePascal(Val(Text1.Text), datas) Text2.Text = datas End Sub

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!¡

BlackZeroX · 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 (vb) [Seleccionar]



'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Codigo siempre y cuando         //
' // no se eliminen los creditos originales de este codigo      //
' // No importando que sea modificado/editado o engrandesido    //
' // o achicado, si es en base a este codigo                    //
' ////////////////////////////////////////////////////////////////
 
Option Explicit
 
Public Sub GenerateTrianglePascal(ByVal nLineas As Long, ByRef OutData As String)
'On Error GoTo 1
Dim a                       As Long
Dim b                       As Long
Dim Puntero                 As Long
Dim Longitud                As Long
Dim Temporal                As String
Dim CelVar()                As Double
Dim OutDataTemp             As String
Const KiloByte              As Long = 5120
    If nLineas > 0 Then
        ReDim CelVar(nLineas, nLineas)
        Puntero = 1
        OutDataTemp = Space(KiloByte)
        Temporal = Space(255)
        For a = 1 To nLineas
            For b = 1 To a: DoEvents
                CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b))))
                Temporal = CelVar(a, b) & IIf(a <> b, " ", "")
                Longitud = Len(Temporal)
                Mid(OutDataTemp, Puntero, Longitud) = Temporal
                Puntero = Puntero + Longitud
                If Puntero > KiloByte Then
                    OutData = OutData & OutDataTemp
                    OutDataTemp = Space(KiloByte)
                    Puntero = 2
                End If
            Next b
            If a <> nLineas Then
                Puntero = Puntero
                Mid(OutDataTemp, Puntero, 2) = vbCrLf
                Puntero = Puntero + 2
            End If
            Caption = a
        Next a
1:      Erase CelVar
    End If
    OutData = OutData & Trim$(OutDataTemp)
End Sub
Private Sub Form_Load()
    Text2.Alignment = 2 '   //  Modo centralizado
End Sub
Private Sub Command1_Click()
Dim datas                   As String
    Call GenerateTrianglePascal(Val(Text1.Text), datas)
    Text2.Text = datas
End Sub

Codigo Optimo a mi Criterio Visto.

Código (vb) [Seleccionar]



'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Codigo siempre y cuando         //
' // no se eliminen los creditos originales de este codigo      //
' // No importando que sea modificado/editado o engrandesido    //
' // o achicado, si es en base a este codigo                    //
' ////////////////////////////////////////////////////////////////
 
Option Explicit
 
Public Sub GenerateTrianglePascal(ByVal nLineas As Long, ByRef OutData As String)
'On Error GoTo 1
Dim a                       As Long
Dim b                       As Long
Dim Puntero                 As Long
Dim Longitud                As Long
Dim Temporal                As String
Dim CelVar()                As Double
Dim OutDataTemp             As String
Const KiloByte              As Long = 5120      '   //  Buffer Limite
    If nLineas > 0 Then
        ReDim CelVar(nLineas, nLineas)
        Puntero = 1
        OutDataTemp = Space(KiloByte)
        Temporal = Space(255)
        For a = 1 To nLineas
            For b = 1 To a: DoEvents
                Rem     Start CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b))))
                If b = 1 Then
                    CelVar(a, b) = 1
                Else
                    CelVar(a, b) = CelVar(a - 1, b - 1) + CelVar(a - 1, b)
                End If
                Rem     End CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b))))
                Rem     Start Temporal = CelVar(a, b) & IIf(a <> b, " ", "")
                Temporal = CelVar(a, b)
                If a <> b Then
                    Temporal = Temporal & " "
                End If
                Rem     End Temporal = CelVar(a, b) & IIf(a <> b, " ", "")
                Longitud = Len(Temporal)
                Mid(OutDataTemp, Puntero, Longitud) = Temporal
                Puntero = Puntero + Longitud
                If Puntero > KiloByte Then
                    OutData = OutData & OutDataTemp
                    OutDataTemp = Space(KiloByte)
                    Puntero = 2
                End If
            Next b
            If a <> nLineas Then
                Puntero = Puntero
                Mid(OutDataTemp, Puntero, 2) = vbCrLf
                Puntero = Puntero + 2
            End If
            Caption = a
        Next a
1:      Erase CelVar
    End If
    OutData = OutData & Trim$(OutDataTemp)
End Sub
Private Sub Form_Load()
    Text2.Alignment = 2 '   //  Modo centralizado
End Sub
Private Sub Command1_Click()
Dim datas                   As String
    Call GenerateTrianglePascal(Val(Text1.Text), datas)
    Text2.Text = datas
End Sub

Dulce Infierno Lunar!¡.

Psyke1 · 27 Mayo 2010, 09:14 AM

Gracias Black!

No tenia ni idea que habias hecho uno tu!!
Voy a estudiarlo con detenimiento
Una vez mas:
Gracias!

Test Foro de elhacker.net SMF 2.1

[SRC] Triangulo Pascal [by PsYkE1]

Psyke1

BlackZeroX

BlackZeroX

Psyke1