elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Usando Git para manipular el directorio de trabajo, el índice y commits (segunda parte)


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [RETO] Comprobar si un numero es Oblongo/Pronico
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: 1 2 [3] 4 5 Ir Abajo Respuesta Imprimir
Autor Tema: [RETO] Comprobar si un numero es Oblongo/Pronico  (Leído 26,603 veces)
raul338


Desconectado Desconectado

Mensajes: 2.633


La sonrisa es la mejor forma de afrontar las cosas


Ver Perfil WWW
Re: [RETO] Comprobar si un numero es Oblongo/Pronico
« Respuesta #20 en: 17 Agosto 2010, 19:09 pm »

Tokes, no estas usando la ultima version de LeandroA :P


En línea

Karcrack


Desconectado Desconectado

Mensajes: 2.416


Se siente observado ¬¬'


Ver Perfil
Re: [RETO] Comprobar si un numero es Oblongo/Pronico
« Respuesta #21 en: 17 Agosto 2010, 19:15 pm »

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 :o, como has llegado a la conclusion de que num = (max * max) + max? Donde lo has leeeido!! :¬¬ :laugh: :laugh:


« Última modificación: 17 Agosto 2010, 19:25 pm por Karcrack » En línea

raul338


Desconectado Desconectado

Mensajes: 2.633


La sonrisa es la mejor forma de afrontar las cosas


Ver Perfil WWW
Re: [RETO] Comprobar si un numero es Oblongo/Pronico
« Respuesta #22 en: 17 Agosto 2010, 19:22 pm »

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

Código
  1. Option Explicit
  2. Dim i As Integer
  3. Dim tim As New CTiming
  4.  
  5. Private Sub Form_Load()
  6.    Dim i   As Long
  7.    Dim j As Long
  8.    Dim s As String
  9.  
  10.    s = ""
  11.    tim.Reset
  12.    For i = 0 To 100000
  13.        If EsOblongo2(i, j) Then s = s & "(" & i & "," & j & ")"
  14.    Next i
  15.    Text1.Text = Text1.Text & "Tokes: " & tim.Elapsed & vbCrLf & s & vbCrLf & vbCrLf
  16.  
  17.    s = ""
  18.    tim.Reset
  19.    For i = 0 To 100000
  20.        If IsOblongoLeo2(i, j) Then s = s & "(" & i & "," & j & ")"
  21.    Next i
  22.    Text1.Text = Text1.Text & "LeandroA: " & tim.Elapsed & vbCrLf & s & vbCrLf & vbCrLf
  23.  
  24.    s = ""
  25.    tim.Reset
  26.    For i = 0 To 100000
  27.        If IsOblongo01(i, j) Then s = s & "(" & i & "," & j & ")"
  28.    Next i
  29.    Text1.Text = Text1.Text & "Karcrack: " & tim.Elapsed & vbCrLf & s & vbCrLf & vbCrLf
  30. End Sub
  31.  
  32. ' Karcrack
  33. Private Function IsOblongo01(ByVal lNumb As Long, ByRef n As Long) As Boolean
  34.    If (lNumb = 0) Then n = 0: IsOblongo01 = True: Exit Function
  35.  
  36.    If (lNumb And 1) = 0 Then
  37.        For n = 1 To Sqr(lNumb + 1)
  38.            If lNumb = n * (n + 1) Then
  39.                IsOblongo01 = True
  40.                Exit For
  41.            End If
  42.        Next n
  43.    End If
  44. End Function
  45.  
  46. 'Tokes 2
  47. Private Function EsOblongo2(ByVal num As Long, ByRef n As Long) As Boolean
  48. Dim max As Long
  49.    If (num And 1) Or (num And &H80000000) Then Exit Function
  50.  
  51.    max = Sqr(num)
  52.    If num = max * max + max Then
  53.        EsOblongo2 = True
  54.        n = max
  55.        Exit Function
  56.    End If
  57. End Function
  58.  
  59. ' LeandroA
  60. Private Function IsOblongoLeo2(ByVal lNumb As Long, ByRef n As Long) As Boolean
  61.    Dim lmax As Long, i As Long
  62.  
  63.    If (lNumb And 1) Then Exit Function
  64.    If lNumb = 0 Then n = 0: IsOblongoLeo2 = True: Exit Function
  65.  
  66.    lmax = Sqr(lNumb)
  67.  
  68.    For i = lmax - 1 To lmax
  69.        If lNumb = i * (i + 1) Then
  70.            IsOblongoLeo2 = True
  71.            n = i
  72.            Exit Function
  73.        End If
  74.    Next
  75. End Function
  76.  

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

Blackzerox y yo perdimos por goleada :xD

Agregado la v2 de Tokes
« Última modificación: 17 Agosto 2010, 19:40 pm por raul338 » En línea

Karcrack


Desconectado Desconectado

Mensajes: 2.416


Se siente observado ¬¬'


Ver Perfil
Re: [RETO] Comprobar si un numero es Oblongo/Pronico
« Respuesta #23 en: 17 Agosto 2010, 19:32 pm »

No habia visto la nueva version de Leandro :o :o :o, buen trabajo :)
Código:
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:
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...
En línea

79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
Re: [RETO] Comprobar si un numero es Oblongo/Pronico
« Respuesta #24 en: 17 Agosto 2010, 19:38 pm »

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

GRACIAS
En línea

"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

 79137913                          *Shadow Scouts Team*
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [RETO] Comprobar si un numero es Oblongo/Pronico
« Respuesta #25 en: 17 Agosto 2010, 19:38 pm »

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 :o, como has llegado a la conclusion de que num = (max * max) + max? Donde lo has leeeido!! :¬¬ :laugh: :laugh:

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:

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!¡.
« Última modificación: 17 Agosto 2010, 19:42 pm por BlackZeroX » En línea

The Dark Shadow is my passion.
Tokes

Desconectado Desconectado

Mensajes: 140


Ver Perfil
Re: [RETO] Comprobar si un numero es Oblongo/Pronico
« Respuesta #26 en: 17 Agosto 2010, 19:44 pm »

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:
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.
En línea

raul338


Desconectado Desconectado

Mensajes: 2.633


La sonrisa es la mejor forma de afrontar las cosas


Ver Perfil WWW
Re: [RETO] Comprobar si un numero es Oblongo/Pronico
« Respuesta #27 en: 17 Agosto 2010, 19:50 pm »

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
En línea

BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [RETO] Comprobar si un numero es Oblongo/Pronico
« Respuesta #28 en: 17 Agosto 2010, 20:01 pm »

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

Código
  1.  
  2. '  Tokes 03
  3. Private Function IsOblongoTokes03(ByVal nval As Long, ByRef n As Long) As Boolean
  4.    If (nval And 1) Or (nval And &H80000000) Then Exit Function
  5.    n = Sqr(nval)
  6.    IsOblongoTokes03 = n * n + n = nval
  7. End Function
  8.  
  9.  

Código:

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!¡.
« Última modificación: 17 Agosto 2010, 20:17 pm por BlackZeroX » En línea

The Dark Shadow is my passion.
Tokes

Desconectado Desconectado

Mensajes: 140


Ver Perfil
Re: [RETO] Comprobar si un numero es Oblongo/Pronico
« Respuesta #29 en: 17 Agosto 2010, 20:28 pm »

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.
En línea

Páginas: 1 2 [3] 4 5 Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
[DUDA] Comprobar si un número es ondulado
Programación C/C++
Kropt32 2 7,643 Último mensaje 15 Diciembre 2010, 09:04 am
por Kropt32
[JSTL] Como comprobar si una variable es un numero en JSTL
Desarrollo Web
nhaalclkiemr 0 4,623 Último mensaje 10 Abril 2011, 20:42 pm
por nhaalclkiemr
[RETO] Determinar Número Perfecto « 1 2 3 »
Programación Visual Basic
Miseryk 20 9,161 Último mensaje 8 Noviembre 2013, 02:24 am
por rob1104
comprobar numero repetido en un vector
Programación C/C++
MessageBoxA 4 3,342 Último mensaje 26 Junio 2014, 02:05 am
por MeCraniDOS
¿Es posible escapar del reto “vecinos de número”?
Noticias
wolfbcn 6 1,817 Último mensaje 13 Agosto 2019, 18:42 pm
por @XSStringManolo
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines