Mensajes

[OffTopic]
estuve queriendo probar las diferencias de velocidades entre el IF, SELECT CASE, IF inline etc.
la cuestion es que vi que las funciones que se llaman primero tiene cierta ventaja con respecto a las otras, esto mismo pasa cuando queremos comparar las funciones que estamos haciendo. Es correcto esto que digo?¿?¿

Sabes que yo estaba sospechando lo mismo? Cambio el orden de las llamadas, espero un buen rato (2 min ) sin ejecutar nada y vuelvo a hacer las pruebas y ...... cambian los resultados (aunque se mantiene una "pequeña" proporcion)

Aun asi, no es "para tanto". Lo que me parece raro, es que yo copie la funcion de tokes, le cambie de nombre a las variables.... y? .... 2ms mas lento no se si sera mi cpu o que...

Desde -100 hasta 200000:
Agregando "IF lNumb < 0 Then Exit Function" a Karcrack y LeandroA queda....

Tokes: 19,422201520188
LeandroA: 13,5933384789009
Karcrack: 147,218339521488

En tiempo de ejecucion, usando CTiming

[cTiming.cls]

Me he tomado la libertad de ir testeando, aunque habria que probarlo en más PCs...
Utilizando:
cTiming.cls

Código (vb) [Seleccionar] Expandir

Option Explicit
Dim i As Integer
Dim tim As New CTiming

Private Sub Form_Load()
    Dim i   As Long
    Dim j As Long
    Dim s As String
   
    s = ""
    tim.Reset
    For i = 0 To 100000
        If EsOblongo2(i, j) Then s = s & "(" & i & "," & j & ")"
    Next i
    Text1.Text = Text1.Text & "Tokes: " & tim.Elapsed & vbCrLf & s & vbCrLf & vbCrLf
   
    s = ""
    tim.Reset
    For i = 0 To 100000
        If IsOblongoLeo2(i, j) Then s = s & "(" & i & "," & j & ")"
    Next i
    Text1.Text = Text1.Text & "LeandroA: " & tim.Elapsed & vbCrLf & s & vbCrLf & vbCrLf
   
    s = ""
    tim.Reset
    For i = 0 To 100000
        If IsOblongo01(i, j) Then s = s & "(" & i & "," & j & ")"
    Next i
    Text1.Text = Text1.Text & "Karcrack: " & tim.Elapsed & vbCrLf & s & vbCrLf & vbCrLf
End Sub

' Karcrack
Private Function IsOblongo01(ByVal lNumb As Long, ByRef n As Long) As Boolean
    If (lNumb = 0) Then n = 0: IsOblongo01 = True: Exit Function

    If (lNumb And 1) = 0 Then
        For n = 1 To Sqr(lNumb + 1)
            If lNumb = n * (n + 1) Then
                IsOblongo01 = True
                Exit For
            End If
        Next n
    End If
End Function

'Tokes 2
Private Function EsOblongo2(ByVal num As Long, ByRef n As Long) As Boolean
Dim max As Long
    If (num And 1) Or (num And &H80000000) Then Exit Function
   
    max = Sqr(num)
    If num = max * max + max Then
        EsOblongo2 = True
        n = max
        Exit Function
    End If
End Function

' LeandroA
Private Function IsOblongoLeo2(ByVal lNumb As Long, ByRef n As Long) As Boolean
    Dim lmax As Long, i As Long

    If (lNumb And 1) Then Exit Function
    If lNumb = 0 Then n = 0: IsOblongoLeo2 = True: Exit Function

    lmax = Sqr(lNumb)

    For i = lmax - 1 To lmax
        If lNumb = i * (i + 1) Then
            IsOblongoLeo2 = True
            n = i
            Exit Function
        End If
    Next
End Function


Tokes v2: 9,31712800337221
LeandroA: 7,62460838830173
Karcrack: 95,5182170415809

Blackzerox y yo perdimos por goleada

Agregado la v2 de Tokes

Tokes, no estas usando la ultima version de LeandroA

[LeandroA]

Ufff.... para mi LeandroA ha ganado el reto!, es rapidisima su funcion!!!!

[Raul338]

Algo que vi en algunos algoritmos

6 = 2*(2+1) no es lo mismo que 2 * 2+1

1- Raul338 aplicas mal el algoritmo, como ha dicho Cobein (n * (n+1)) <> (n * n + 1)

6 = 2 * (2 + 1)
// pasamos el 2 dividiendo a 6
6 / 2 = 2 + 1
// en otros lados dicen "dividimos ambos mienbros por 2
6 / 2 = 2 * (2 + 1)
               2
6 / 2 = 2 + 1

Cosa que eso es lo que hago yo

Cambien "lNumb / i = i + 1" por "lNumb = i * (i + 1)" y les dara exactamente los mismos resultados

[y solo EN EL IDE]

He agregado un filtro al codigo tokes, es mas rapido por unas milesimas de segundo XD (se nota en casos grandes y solo EN EL IDE )
@Karcrack Tu codigo no devuelve nada o al menos yo pruebo asi:

Código (vb) [Seleccionar] Expandir

Option Explicit
Dim i As Integer
Dim tim As New CTiming

Private Sub Form_Load()
   Dim i   As Long
   Dim j As Long
   Dim s As String
   
   s = ""
   tim.Reset
   For i = 1 To 100000
       If EsOblongo(i, j) Then s = s & i & ","
   Next i
   Text1.Text = Text1.Text & "Tokes: " & tim.Elapsed & vbCrLf & s & vbCrLf
   
   s = ""
   tim.Reset
   For i = 1 To 100000
       If EsCasiCuadrado(i, j) Then s = s & i & ","
   Next i
   Text1.Text = Text1.Text & "Tokes Mod Raul338: " & tim.Elapsed & vbCrLf & s & vbCrLf
   
   s = ""
   tim.Reset
   For i = 1 To 100000
       If IsOblongo01(i, j) Then s = s & i & ","
   Next i
   Text1.Text = Text1.Text & "Karcrack: " & tim.Elapsed & vbCrLf & s & vbCrLf
End Sub

' Tokes Mod Raul338
Private Function EsCasiCuadrado(ByVal lNumb As Long, ByRef n As Long) As Boolean
   If lNumb < 0 Then Exit Function
   If (lNumb And 1) Then Exit Function
   
   Dim s As Long
   s = CLng(Right$(lNumb, 1))
   If (Not s = 0) Xor (Not s = 2) Xor (Not s = 6) Then
       Exit Function
   End If
   
   Dim fin As Long
   fin = Sqr(lNumb)

   For n = 1 To fin
       If lNumb = n * n + n Then
           EsCasiCuadrado = True
           Exit Function
       End If
   Next
End Function

' Karcrack
Private Function IsOblongo01(ByVal lNumb As Long, ByRef n As Long) As Boolean
   If (lNumb = 0) Or (lNumb = 2) Then n = lNumb \ 2: IsOblongo01 = True: Exit Function

   If (lNumb And 1) Then
       For n = 3 To Sqr(lNumb + 1) Step 2
           If lNumb = n * (n + 1) Then
               IsOblongo01 = True
               Exit For
           End If
       Next n
   End If
End Function

'Tokes
Private Function EsOblongo(ByVal num As Long, ByRef n As Long) As Boolean
Dim max As Long, i As Long
   If (num And 1) Then Exit Function
   
   max = Sqr(num)
   For i = 0 To max
       If num = i * i + i Then 'i * (i + 1) Then
           EsOblongo = True
           n = i
           Exit Function
       End If
   Next
End Function


A ver quien mas se postula


Ademas Karcrack, poniendo \ me empezo a tirar valores literalmente falsos




Resultados en tiempo de ejecucion!!!

Código [Seleccionar] Expandir


Tokes: 44,9498563796377
2,6,12,20,30,42,56,72,90,110,132,156,182,210,240,272,306,342,380,420,462,506,552,600,650,702,756,812,870,930,992,1056,1122,1190,1260,1332,1406,1482,1560,1640,1722,1806,1892,1980,2070,2162,2256,2352,2450,2550,2652,2756,2862,2970,3080,3192,3306,3422,3540,3660,3782,3906,4032,4160,4290,4422,4556,4692,4830,4970,5112,5256,5402,5550,5700,5852,6006,6162,6320,6480,6642,6806,6972,7140,7310,7482,7656,7832,8010,8190,8372,8556,8742,8930,9120,9312,9506,9702,9900,10100,10302,10506,10712,10920,11130,11342,11556,11772,11990,12210,12432,12656,12882,13110,13340,13572,13806,14042,14280,14520,14762,15006,15252,15500,15750,16002,16256,16512,16770,17030,17292,17556,17822,18090,18360,18632,18906,19182,19460,19740,20022,20306,20592,20880,21170,21462,21756,22052,22350,22650,22952,23256,23562,23870,24180,24492,24806,25122,25440,25760,26082,26406,26732,27060,27390,27722,28056,28392,28730,29070,29412,29756,30102,30450,30800,31152,31506,31862,32220,32580,32942,33306,33672,34040,34410,34782,35156,35532,35910,36290,36672,37056,37442,37830,38220,38612,39006,39402,39800,40200,40602,41006,41412,41820,42230,42642,43056,43472,43890,44310,44732,45156,45582,46010,46440,46872,47306,47742,48180,48620,49062,49506,49952,50400,50850,51302,51756,52212,52670,53130,53592,54056,54522,54990,55460,55932,56406,56882,57360,57840,58322,58806,59292,59780,60270,60762,61256,61752,62250,62750,63252,63756,64262,64770,65280,65792,66306,66822,67340,67860,68382,68906,69432,69960,70490,71022,71556,72092,72630,73170,73712,74256,74802,75350,75900,76452,77006,77562,78120,78680,79242,79806,80372,80940,81510,82082,82656,83232,83810,84390,84972,85556,86142,86730,87320,87912,88506,89102,89700,90300,90902,91506,92112,92720,93330,93942,94556,95172,95790,96410,97032,97656,98282,98910,99540,
Tokes Mod Raul338: 76,2871329372145
2,6,12,20,30,42,56,72,90,110,132,156,182,210,240,272,306,342,380,420,462,506,552,600,650,702,756,812,870,930,992,1056,1122,1190,1260,1332,1406,1482,1560,1640,1722,1806,1892,1980,2070,2162,2256,2352,2450,2550,2652,2756,2862,2970,3080,3192,3306,3422,3540,3660,3782,3906,4032,4160,4290,4422,4556,4692,4830,4970,5112,5256,5402,5550,5700,5852,6006,6162,6320,6480,6642,6806,6972,7140,7310,7482,7656,7832,8010,8190,8372,8556,8742,8930,9120,9312,9506,9702,9900,10100,10302,10506,10712,10920,11130,11342,11556,11772,11990,12210,12432,12656,12882,13110,13340,13572,13806,14042,14280,14520,14762,15006,15252,15500,15750,16002,16256,16512,16770,17030,17292,17556,17822,18090,18360,18632,18906,19182,19460,19740,20022,20306,20592,20880,21170,21462,21756,22052,22350,22650,22952,23256,23562,23870,24180,24492,24806,25122,25440,25760,26082,26406,26732,27060,27390,27722,28056,28392,28730,29070,29412,29756,30102,30450,30800,31152,31506,31862,32220,32580,32942,33306,33672,34040,34410,34782,35156,35532,35910,36290,36672,37056,37442,37830,38220,38612,39006,39402,39800,40200,40602,41006,41412,41820,42230,42642,43056,43472,43890,44310,44732,45156,45582,46010,46440,46872,47306,47742,48180,48620,49062,49506,49952,50400,50850,51302,51756,52212,52670,53130,53592,54056,54522,54990,55460,55932,56406,56882,57360,57840,58322,58806,59292,59780,60270,60762,61256,61752,62250,62750,63252,63756,64262,64770,65280,65792,66306,66822,67340,67860,68382,68906,69432,69960,70490,71022,71556,72092,72630,73170,73712,74256,74802,75350,75900,76452,77006,77562,78120,78680,79242,79806,80372,80940,81510,82082,82656,83232,83810,84390,84972,85556,86142,86730,87320,87912,88506,89102,89700,90300,90902,91506,92112,92720,93330,93942,94556,95172,95790,96410,97032,97656,98282,98910,99540,
Karcrack: 61,5048539640439
2,


[[OFFTOPIC]]

Propongo esta pero no es tan rapida

Código (vb) [Seleccionar] Expandir


Private Function EsCasiCuadrado(ByVal lNumb As Long, ByRef n As Long) As Boolean
    If lNumb < 0 Or (lNumb And 1) = 1 Then Exit Function
    If lNumb = 2 Then
        n = 1
        EsCasiCuadrado = True
    End If
   
    Dim i As Long
    Dim fin As Long
    fin = Sqr(lNumb)
    For i = 2 To fin
        If lNumb / i = i + 1 Then
            n = i
            EsCasiCuadrado = True
            Exit Function
        End If
    Next
End Function


[OFFTOPIC]Primera vez que me sale algo para participar!!! [/OFFTOPIC]

yo queria participar y se me habia ocurrido la idea del redim, pero no me salio el algoritmo y me negaba a fijarme en sus codigos y hasta se me ocurrio usar listas enlazadas y doblemente enlazadas, pero mi base del algoritmo fallaba

Muy impresionante lo que hicieron, y si, ya deberian ir cerrando y proclamar un ganador. Yo tengo un reto para mas tarde

las otras pc tienen el .net framework (version q uses) instalada?

Crea un instalador