[RETO] Comprobar si un numero es Oblongo/Pronico

[raul338]

Tokes, no estas usando la ultima version de LeandroA

[Karcrack]

No se como estais calculando los tiempos... en mis calculos mi funcion es la mas rapida

MOD: No useis GetTickCount(), para mas precision usad la Clase CTiming.cls que he puesto en otros retos

MOD2: Acabo de ver que Tokes ha hecho una nueva funcion que no utiliza bucles , como has llegado a la conclusion de que num = (max * max) + max? Donde lo has leeeido!!

[raul338]

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

[Karcrack]

No habia visto la nueva version de Leandro , buen trabajo

Código [Seleccionar] Expandir

Option Explicit

Dim cT      As New CTiming

Private Sub Form_Load()
Dim i   As Long
Dim n   As Long

    Open "resultados.txt" For Binary As #1
   
    cT.Reset
    For i = 0 To 10000
        Call IsOblongo01(i, n)
    Next i

    Put #1, , "Karcrack -> " & cT.sElapsed & vbCrLf

    cT.Reset
    For i = 0 To 10000
        Call EsOblongo(i, n)
    Next i
    Put #1, , "Tokes -> " & cT.sElapsed & vbCrLf
   
    cT.Reset
    For i = 0 To 10000
        Call IsOblongoLeo2(i, n)
    Next i
    Put #1, , "LeandroA -> " & cT.sElapsed
   
    Close #1
    End
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
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

' 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

Código [Seleccionar] Expandir

Karcrack -> 5,514 msec
Tokes -> 5,603 msec
LeandroA -> 1,576 msec

Tokes y yo estamos practicamente empatados.... es tan poco diferencia que a veces adelanto yo a veces el...

[79137913]

Disculpen que moleste, se que en otro post dicenq ue programas son, pero no los logro encontrar ¿como sabes la velocidad de proceso?

GRACIAS

[BlackZeroX]

No se como estais calculando los tiempos... en mis calculos mi funcion es la mas rapida

MOD: No useis GetTickCount(), para mas precision usad la Clase CTiming.cls que he puesto en otros retos

MOD2: Acabo de ver que Tokes ha hecho una nueva funcion que no utiliza bucles , como has llegado a la conclusion de que num = (max * max) + max? Donde lo has leeeido!!

x = n (n + 1),

es lo mismo que...

x = n *n + n   ---> [  n (n + 1) ]

esta en la Wikipedia ¬¬", ya ven para que no leen (    malditas matebruticas )

Código [Seleccionar] Expandir



Pronic numbers can also be expressed as n² + n. The n-th pronic number is the sum of the first n even integers, as well as the difference between (2n − 1)² and the n-th centered hexagonal number.

All pronic numbers are even, therefore 2 is the only prime pronic number. It is also the only pronic number in the Fibonacci sequence.

The number of off-diagonal entries in a square matrix is always a pronic number.

The value of the Möbius function μ(x) for any pronic number x = n (n + 1), in addition to being computable in the usual way, can also be calculated as

   μ(x) = μ(n) μ(n + 1).

The fact that consecutive integers are coprime and that a pronic number is the product of two consecutive integers leads to a number of properties. Each distinct prime factor of a pronic number is present in only one of its factors. Thus a pronic number is squarefree if and only if n and n + 1 are. The number of distinct prime factors of a pronic number is the sum of the number of distinct prime factors of n and n + 1.



P.D.: La funcion (Original que no esta en base a dla de Tokes como el dice) de LeandroA solo funciona hasta 11771 ver aqui

Dulces Lunas!¡.

[Tokes]

Bueno, aquí dejo nuevamente una recopilación de códigos, aunque sólo comparo la segunda versión de LeandroA con la segunda versión mía.

Las funciones que comparo son: IsOblongoLeo2 y EsOblongo2.

Cabe hacer notar que la función de LeandroA no tiene filtro para números negativos.

En Private Sub Command1_Click hice un bucle
   
         For i = -100 to Text1.text
             .....
         Next

Y la función de LeandroA se confunde, es decir, si toma en cuenta los negativos.

Código [Seleccionar] Expandir

Option Explicit

Dim n As Long
Private Declare Function GetTickCount Lib "Kernel32" () As Long

Private Sub Form_Load()
   Label1.Caption = ""
   Label1.AutoSize = True
   Text1 = ""
   Command1.Caption = "Calcular"
End Sub

Private Sub Command1_Click()
Dim i As Long, t1 As Long, t2 As Long, c As Long

   On Error Resume Next
   Label1.Caption = ""
   
   'Tokes 2
   c = 0
   t1 = GetTickCount
   For i = -100 To Val(Text1)
       If EsOblongo2(i, n) Then
           c = c + 1
       End If
   Next
   t2 = GetTickCount
   Label1.Caption = Label1.Caption & "Tokes 2 --> " & t2 - t1 & Chr(13) _
   & c & " números oblongos encontrados" & Chr(13) & Chr(13)
   
   'LeandroA 2
   c = 0
   t1 = GetTickCount
   For i = -100 To Val(Text1)
       If IsOblongoLeo2(i, n) Then
           c = c + 1
       End If
   Next
   t2 = GetTickCount
   Label1.Caption = Label1.Caption & "LeandroA 2 --> " & t2 - t1 & Chr(13) _
   & c & " números oblongos encontrados" & Chr(13) & Chr(13)
End Sub

'-----------------
'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 + 1) Then
       EsOblongo2 = True
       n = max
       Exit Function
   End If
End Function

'LeandroA 2
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


Eso es todo por el momento. Gracias.

[raul338]

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

[BlackZeroX]

una modificacion rapida (solo es 2 msec mas rapida ¬¬") a la funcion de Tokes (Ojala hubieramos despenajo n(n+1) ¬¬" )!¡.

Código (Vb) [Seleccionar] Expandir



'  Tokes 03
Private Function IsOblongoTokes03(ByVal nval As Long, ByRef n As Long) As Boolean
   If (nval And 1) Or (nval And &H80000000) Then Exit Function
   n = Sqr(nval)
   IsOblongoTokes03 = n * n + n = nval
End Function



Código [Seleccionar] Expandir



Karcrack -> 3,740 msec
LeandroA -> 0,673 msec
raul338 -> 33,761 msec
Tokes -> 4,587 msec
Tokes 2 -> 0,576 msec
Tokes03-> 0,574 msec
BlackZeroX -> 85,029 msec



Temibles Matematicas Lunares!¡.

[Tokes]

BlackZerox:

A mí no me dan los mismos resultados. Yo estoy probando con las funciones GetTickCount y TimeGetTime. ¿Hay alguna otra manera de medir el tiempo?

Y gracias por la optimización de la función. Estuvo muy buena.

          Hasta pronto.