[RETO] Comprobar si un numero es Oblongo/Pronico

[BlackZeroX]

Para extremistas!¡.

QueryPerformanceCounter

Edito:

Proyecto gral!¡. 

Dulces Lunas!¡.

[cobein]

No me dejen afuera!!!!! no tengo mucho tiempo ahora pero quiero darle una probada.

[Tokes]

Oye BlackZerox:

Gracias por el proyecto general. Te voy a molestar con una pregunta:

El módulo que contiene las funciones del timer, si yo no lo tuviera, ¿Tengo que crearlo, o ya hay una librería o algo así?

       Por tu atención, gracias.

[LeandroA]

lmax = Sqr(lNumb) = al numero

carajo cuando lo probe no me daba poreso restaba uno y ahora veo que si funciona.  

me gusto esta (nval And &H80000000) para los negativos.

[BlackZeroX]

Para quien le interese la funcion Sqr en ASM (es el punto critico ahora)

http://www.azillionmonkeys.com/qed/sqroot.html

@Tokes

en el mismo .Zip esta el archivo CTiming.cls, ya esta el proyecto completo!¡.

Dulces Lunas!¡.

[Novlucker]

No jodas, yo hice ese mismo código que ha colgado Tokes (salvo que omití el valor OR) y no lo puse porque el de Karcrack era bastante más rápido, supongo que eso me pasa por no tener el VB6 y probarlo en VBA

Que alguien busque otro "reto" de estos, que a la próxima no me quedo quieto

Saludos

[LeandroA]

[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?¿?¿

esto es lo que hice
si alteran el orden de las llamadas hay ciertos cambios.

Código (vb) [Seleccionar] Expandir


Option Explicit

Private CTiming As CTiming


Private Sub Form_Load()
    Dim i As Long, j As Long
    Dim ValTest As Long
   
    Set CTiming = New CTiming
   
    Me.AutoRedraw = True
   
    Me.Print "Test de velocidad" & vbCrLf
   
    ValTest = 5000000
   
    CTiming.Reset

    For i = 0 To ValTest
        For j = 1 To 4
            Prueba1 j
        Next
    Next
   
    Me.Print "Prueba1 " & CTiming.sElapsed
   
    CTiming.Reset
   
    For i = 0 To ValTest
        For j = 1 To 4
            Prueba2 j
        Next
    Next
   
    Me.Print "Prueba2 " & CTiming.sElapsed
   
    CTiming.Reset
   
    For i = 0 To ValTest
        For j = 1 To 4
            Prueba3 j
        Next
    Next
   
    Me.Print "Prueba3 " & CTiming.sElapsed
   
    CTiming.Reset
   
    For i = 0 To ValTest
        For j = 1 To 4
            Prueba4 j
        Next
    Next
   
    Me.Print "Prueba4 " & CTiming.sElapsed
   
    CTiming.Reset
   
    For i = 0 To ValTest
        For j = 1 To 4
            Prueba5 j
        Next
    Next
   
    Me.Print "Prueba5 " & CTiming.sElapsed
   
    CTiming.Reset
   
    For i = 0 To ValTest
        For j = 1 To 4
            Prueba6 j
        Next
    Next
   
    Me.Print "Prueba6 " & CTiming.sElapsed
   
    CTiming.Reset
   
    For i = 0 To ValTest
        For j = 1 To 4
            Prueba7 j
        Next
    Next
   
    Me.Print "Prueba7 " & CTiming.sElapsed
   
End Sub



Private Function Prueba1(ByVal num As Long) As Long
    Select Case num
        Case 1
            Prueba1 = 1
        Case 2
            Prueba1 = 2
        Case 3
            Prueba1 = 3
        Case Else
            Prueba1 = -1
    End Select
End Function


Private Function Prueba2(ByVal num As Long) As Long
    If num = 1 Then Prueba2 = 1 Else If num = 2 Then Prueba2 = 2 Else If num = 3 Then Prueba2 = 3 Else Prueba2 = -1
End Function


Private Function Prueba3(ByVal num As Long) As Long

    If num = 1 Then
        Prueba3 = 1
        Exit Function
    End If
   
    If num = 2 Then
        Prueba3 = 2
        Exit Function
    End If
   
    If num = 3 Then
        Prueba3 = 3
        Exit Function
    End If
   
    Prueba3 = -1
   
End Function

Private Function Prueba4(ByVal num As Long) As Long

    If num = 1 Then
        Prueba4 = 1
    Else
        If num = 2 Then
            Prueba4 = 2
        Else
            If num = 3 Then
                Prueba4 = 3
            Else
                Prueba4 = -1
            End If
        End If
    End If
   
End Function

Private Function Prueba5(ByVal num As Long) As Long

    If num = 1 Then
            Prueba5 = 1
        ElseIf num = 2 Then
                Prueba5 = 2
            ElseIf num = 3 Then
                    Prueba5 = 3
                Else
                    Prueba5 = -1
                End If

   
End Function


Private Function Prueba6(ByVal num As Long) As Long
    Prueba6 = IIf(num = 1, 1, IIf(num = 2, 2, IIf(num = 3, 3, -1)))
End Function

Private Function Prueba7(ByVal num As Long) As Long
    If num = 1 Then Prueba7 = 1: Exit Function
    If num = 2 Then Prueba7 = 2: Exit Function
    If num = 3 Then Prueba7 = 3: Exit Function
    Prueba7 = -1
End Function


[Karcrack]

Veaaamos:

Código [Seleccionar] Expandir

n*(n+1) = numero_oblongo
numero_oblongo = n² + n
n² + n - numero_oblongo = 0
n = (-1 +- Raiz(1+4*numero_oblongo))/(2)



Esta no seria la forma mas rapida, pero es la unica que comprendo...

Código [Seleccionar] Expandir

Private Function IsOblongoAlgebra(ByVal nVal As Long, ByRef n As Long) As Boolean
   If (nVal And 1) Or (nVal And &H80000000) Then Exit Function

   n = (Sqr(1 + nVal * 4) - 1) / 2
   
   IsOblongoAlgebra = (n * n + n = nVal)
End Function

No veo en que punto n = sqr(nVal) a partir de la ecuacion...


Si quereis saber mas sobre VB6 rapido visitar esta pagina

Código [Seleccionar] Expandir

http://www.xbeat.net/vbspeed/

[raul338]

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

[Karcrack]

He aqui mi obra maestra: (ACTUALIZADO)

Código [Seleccionar] Expandir

'---------------------------------------------------------------------------------------
' Module    : cIsOblongo
' Author    : Karcrack
' Now       : 17/08/2010 22:59
' Purpose   : Fastest way to know if a number is Pronic
' History   : 17/08/2010 First cut .....................................................
'             18/08/2010 Fixed and skip odd numbers ....................................
' + Info    : http://foro.elhacker.net/programacion_visual_basic/reto_comprobar_si_un_numero_es_oblongopronico-t302373.0.html
'---------------------------------------------------------------------------------------

Option Explicit
Option Base 0

'NTDLL
Private Declare Sub RtlMoveMemory Lib "NTDLL" (Destination As Any, Source As Any, ByVal Length As Long)

Private c_Code(9)       As Currency

Public Function IsOblongo(ByVal lNumb As Long, ByRef n As Long) As Boolean
    ' Will be filled with ASM code later
End Function

Private Sub Class_Initialize()
    Dim i               As Long
    Dim p               As Long

    For i = 0 To 8
        c_Code(i) = CCur(Choose(i + 1, _
                        501112136803166.0373@, 341985116955243.3932@, _
                        -95471687302877.8613@, -837664576038867.3265@, _
                        -452778894006412.4835@, -402254135688842.0366@, _
                        -857247319500392.0127@, 353164454255135.2835@, _
                        -441078304330420.0512@, -802975918502654.77@))
    Next i

    Call RtlMoveMemory(p, ByVal ObjPtr(Me), 4)
    Call RtlMoveMemory(ByVal p + &H1C, VarPtr(c_Code(0)), 4)
End Sub
Codigo ASM utilizado:

Código [Seleccionar] Expandir

http://karcrack.pastebin.com/MUkSE1qs

Resultados de velocidad (i = 0 to 10000):

Código [Seleccionar] Expandir

~2msec


Saludos