[RETO] Matriz Bidimensional {FrogMatrix algorithm}

[Psyke1]

Bueno, aqui traigo un reto bastante fácil digo yo, la idea es armar una matriz de las dimensiones indicadas siguendo las explicaciones:

Si introduzco 5 en la función:

0     1     2     3     4    
1     3     5     7     4    
9    15    16    7     4    
47   42    16    7    4    
116   42    16    7    4

Cada numero viene dado de la suma del que tenga arriba mas tantas columnas a la derecha como el numero fila actual.
En caso de sobrepasar el limite de columnas es igual a el numero de arriba.
Si no me explico bien postea o mándame un MP.

El reto ha sido pensado por mi...

Mucha suerte, yo me pongo ya a hacerlo!!

DoEvents!

EDIT: Ya lo tengo, mañana posteo...

[BlackZeroX]

 * Cada numero viene dado de la suma del que tenga arriba mas tantas columnas a la derecha como el numero fila actual.
* En caso de sobrepasar el limite de columnas es igual a el numero de arriba.

Describe mejor mas claro y mucho mas entendible (espesifica el que con el que por que asi no te entiendo... quizas entienda algo pero es muy pobre lo entendido asi y nadamas no me da con las pruebas de escritorio)... y aun que sea pon 1, 2 o mas ejemplos para ver un patron congruente, por que asi como lo expones nadamas no me da!¡.

Dulces Lunas!¡.

[Psyke1]

Ook, lo siento tienes razón...
Es que me resulta dificil de explicar, dejo un ejemplo de 7:

0       1      2      3     4     5     6   
1       3      5      7     9     11    6   
9       15     21     27    26    11    6   
72      89     85     70    26    11    6   
342     281    198    70    26    11    6   
928     592    198    70    26    11    6   
1831    592    198    70    26    11    6 

Código [Seleccionar] Expandir

El Item (1,0) [el 1] = (0,0) [0] + (0,1) [1]
El Item (1,1) [el 3] = (0,1) [1] + (0,2) [2]
...
El Item (2,0) [el 9] = (1,0) [1] + (1,1) [3] + (1,2) [5]
El Item (2,1) [el 15] = (1,1) [3] + (1,2) [5] + (1,3) [7]
...
El Item (3,0) [el 72] = (2,0) [9] + (2,1) [15] + (2,2) [21] + (2,3) [27]
El Item (3,1) [el 89] = (2,1) [15] + (2,2) [21] + (2,3) [27] + (2,4) [26]
...

¿Se entiende la lógica?
Y si nos encontramos en casos en los que no tenemos más columnas a la derecha entonces se baja el número de arriba.

Ej:

Código [Seleccionar] Expandir

El Item (2,5) [el 11] = (0,5) [11] ' Puesto que 5 + 2 se excede del número de columnas

Espero haberme explicado bien... 

Un Saludo y suerte...

DoEvents!

[BlackZeroX]

ya entendi me a costado

Se tiene que hacer algo similar a esto:

Código [Seleccionar] Expandir



0       1      2      3     4     5     6   
1       3      5      7     9     11    6   
9       15(|)     21(|)     27(|)    26(|)    11    6   
72      89(X)     85     70    26    11    6   
342     281    198    70    26    11    6   
928     592    198    70    26    11    6   
1831    592    198    70    26    11    6 



Donde Solo se suman los  que tienen el signo (|) y donde la cantidad y la posicion inicial de los mismos dependen del lugar Destinatario es decir es descripciones Simples

X <-- esta en la la coordenada {1,3} (Fila,Columna) [Iniciando columna y filas en 0's], el origen de los (|) empiesan en la expresion {1,3-1}.

es decir

X = Sumatoria de Celdas (F+1) empesando en (F,C-1)  , Solo si (F+1) es es menor o igual a (C+1)

* El +1 es solo un auxiliar ya que las matrices empesarian desde 0's.

Lo siento pero en BBcode no salen expresiones matematicas si no las ponia como deberia de ser ¬¬"...

Sangriento Infienro Lunar!¡.

[Psyke1]

Exacto BlackZer0x, es exactamente eso! 
Voy a esperar unas horas más para poner mi forma, que sino no tiene gracia (a parte que no estoy en mi pc ahora mismo)...

DoEvents!

[Psyke1]

Mi solución:

Código (vb) [Seleccionar] Expandir

Option Explicit
Option Base 1

Public Function FrogMatrix(ByVal lSize&) As Long()
Dim lTempArr&()
Dim lSum&, lRepeat&
Dim lCol&, lRow&
   If lSize& > 0 Then
       ReDim lTempArr&(lSize&, lSize&)
       For lCol& = 0 To (lSize& - 1)
           lTempArr&(1, (lCol& + 1)) = lCol&
       Next lCol&
       lRepeat& = 1
       For lRow& = 2 To lSize&
           For lCol& = 1 To lSize&
               lSum& = FrogSum&(lTempArr&(), (lRow& - 1), lCol&, lRepeat&, lSize&)
               lTempArr&(lRow&, lCol&) = IIf((lSum& > 0), lSum&, lTempArr&((lRow& - 1), lCol&))
           Next lCol&
           lRepeat& = lRepeat& + 1
       Next lRow&
       FrogMatrix = lTempArr&()
   End If
End Function

Private Function FrogSum&(ByRef lArray&(), ByVal lRow&, ByVal lCol&, ByVal lRepeat&, ByVal lLimit&)
Dim Q&
   If Not (lCol& + lRepeat& > lLimit&) Then
       For Q& = 0 To lRepeat&
           FrogSum& = FrogSum& + lArray&(lRow&, lCol& + Q&)
       Next Q&
   End If
End Function

' º Un ejemplo :

Private Sub Form_Load()
Const vbBigSpace$ = "    "
Dim x&, y&
Dim sRow$
Dim lSize&
   
   lSize& = 10
   
   For x& = 1 To lSize&
       For y& = 1 To lSize&
           sRow$ = sRow$ & FrogMatrix(lSize)(x&, y&) & vbBigSpace$
       Next y&
       
       Debug.Print sRow$
       sRow$ = vbNullString
   Next x&
End Sub

Devuelve:

Código [Seleccionar] Expandir

0    1    2    3    4    5    6    7    8    9    
1    3    5    7    9    11    13    15    17    9    
9    15    21    27    33    39    45    41    17    9    
72    96    120    144    158    142    112    41    17    9    
590    660    676    597    470    321    112    41    17    9    
3314    2836    2217    1558    970    321    112    41    17    9    
11328    8055    5236    3028    970    321    112    41    17    9    
29091    17780    9734    3028    970    321    112    41    17    9    
61094    32012    9734    3028    970    321    112    41    17    9    
107338    32012    9734    3028    970    321    112    41    17    9  

DoEvents!

[LeandroA]

hola no se puede poner valores grandes solo hasta 17

Código [Seleccionar] Expandir

Option Explicit

Private Sub Form_Load()
Dim M() As Long
Dim lVal As Long, x As Long, y As Long

lVal = 7

M = CreateMatrix(lVal)

For y = 0 To lVal - 1
For x = 0 To lVal - 1
Debug.Print M(x, y),
Next
Debug.Print
Next

End Sub


Private Function CreateMatrix(ByVal Val As Long) As Long()
Dim M() As Long
Dim x As Long, y As Long, i As Long
Dim lSum As Long, lSize As Long

If Val > 17 Or Val < 1 Then Exit Function

lSize = Val - 1

ReDim M(lSize, lSize)

For x = 0 To lSize
M(x, 0) = x
Next

For y = 1 To lSize
For x = 0 To lSize
If x + y > lSize Then
M(x, y) = M(x, y - 1)
Else
lSum = 0
For i = x To y + x
lSum = lSum + M(i, y - 1)
Next
M(x, y) = lSum
End If

Next
Next

CreateMatrix = M

End Function

saludos.

[Psyke1]

 
El que faltaba...

hola no se puede poner valores grandes solo hasta 17

En el reto no hice ninguna referencia fálica creo yo , queria poner algo con lo que pudierais competir conmigo
Encima en tu función solo se pueden meter valores menores de edad

Código [Seleccionar] Expandir

Val > 17

Yo mirare a ver si hago más rapida la mia, que no la hice para correr...

DoEvents!

[Psyke1]

Mi versión 2 :

Código (vb) [Seleccionar] Expandir

Option Explicit
Option Base 1

Public Function FrogMatrix(ByVal lSize&) As Long()
Dim lTempArr&()
Dim lSum&, lRepeat&, Q&
Dim lCol&, lRow&
   If lSize& > 1 And lSize& < 18 Then
       ReDim lTempArr&(lSize&, lSize&)
       For lCol& = 0 To (lSize& - 1)
           lTempArr&(1, (lCol& + 1)) = lCol&
       Next lCol&
       lRepeat& = 1
       For lRow& = 2 To lSize&
           For lCol& = 1 To lSize&
               If Not ((lCol& + lRepeat&) > lSize&) Then
                   For Q& = 0 To lRepeat&
                       lSum& = lSum& + lTempArr&((lRow& - 1), (lCol& + Q&))
                   Next Q&
               End If
               'lTempArr&(lRow&, lCol&) = IIf((lSum& > 0), lSum&, lTempArr&((lRow& - 1), lCol&))
               If CBool(lSum&) Then
                   lTempArr&(lRow&, lCol&) = lSum&
                   lSum& = 0
               Else
                   lTempArr&(lRow&, lCol&) = lTempArr&((lRow& - 1), lCol&)
               End If
           Next lCol&
           lRepeat& = lRepeat& + 1
       Next lRow&
       FrogMatrix = lTempArr&()
   End If
End Function

DoEvents!

[BlackZeroX]

.
Madre que codigos aqui dejo el mio es lo mas rapido que he podido hacerlo, y con la mejor velocidad posible (Solo calculo un triangulo).

Código (Vb) [Seleccionar] Expandir



Option Explicit

Private Declare Sub RtlMoveMemory Lib "kernel32" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Private Function CreateMatriXBZeroX(ByVal vNum&, ByRef OutArray&()) As Boolean
Dim lng_f&, lng_c&, lng_fa&

    CreateMatriXBZeroX = vNum& > 0 And vNum& < 18
   
    If CreateMatriXBZeroX Then
        vNum& = vNum& - 1
        ReDim OutArray&(0 To vNum&, 0 To vNum&)
        For lng_f& = 0 To vNum&
            OutArray&(lng_f&, lng_c&) = lng_f&
        Next
        For lng_c& = 1 To vNum&
            For lng_f& = 0 To vNum& - lng_c&
                For lng_fa& = lng_f& To lng_c& + lng_f&
                    OutArray&(lng_f&, lng_c&) = OutArray&(lng_f&, lng_c&) + OutArray&(lng_fa&, lng_c& - 1)
                Next
            Next
            RtlMoveMemory ByVal VarPtr(OutArray&(lng_f&, lng_c&)), ByVal VarPtr(OutArray&(lng_f&, lng_c& - 1)), 4 * lng_c&
        Next
    End If
End Function



Prueba:

Código (Vb) [Seleccionar] Expandir



Private Sub Form_Load()
Dim OutArray&()
Dim lng_f&, lng_c&, lng_vNum&
    lng_vNum& = 5
    If CreateMatriXBZeroX(lng_vNum&, OutArray&) Then
        For lng_f& = 0 To lng_vNum& - 1
            For lng_c& = 0 To lng_vNum& - 1
                Debug.Print OutArray&(lng_c&, lng_f&),
            Next
            Debug.Print
        Next
    End If
End Sub



Sangriento Infierno Lunar!¡.