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

 

 


Tema destacado: Tutorial básico de Quickjs


+  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 24,944 veces)
Karcrack


Desconectado Desconectado

Mensajes: 2.416


Se siente observado ¬¬'


Ver Perfil
[RETO] Comprobar si un numero es Oblongo/Pronico
« en: 17 Agosto 2010, 01:23 am »

Seguimos con los retos de velocidad y numeros :) Ahora han tocado los numeros pronicos/oblongos... que no requieren un algoritmo muy complejo, pero si que tocara pensar para augmentar la velocidad :D

Mas informacion:
Código:
http://en.wikipedia.org/wiki/Pronic_number
http://oeis.org/classic/A002378
Se trata de comprobar si un numero puede ser expresado como el producto de dos enteros consecutivos... es decir:
Código:
numero_oblongo = n*(n+1)
Ejemplo:
Código:
6 = 2*(2+1)

Se trata de comprobar que el numero es oblongo y devolver el valor de n... La funcion ha de estar declarada de este modo:
Código
  1. Private Function IsOblongo(ByVal lNumb As Long, ByRef n As Long) As Boolean

Tal vez la velocidad de aparicion de nuevos retos sea elevada, pero es que por las noches me aburro :-[ :P

Se el mas rapido del oeste, vaquero!


« Última modificación: 17 Agosto 2010, 01:28 am por Karcrack » En línea

Karcrack


Desconectado Desconectado

Mensajes: 2.416


Se siente observado ¬¬'


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

Esta seria la forma habitual y logica de realizar el algoritmo:
Código
  1. Private Function IsOblongo(ByVal lNumb As Long, ByRef n As Long) As Boolean
  2.    Dim i   As Long
  3.  
  4.    For i = 0 To lNumb
  5.        If lNumb = i * (i + 1) Then
  6.            IsOblongo = True
  7.            n = i
  8.            Exit For
  9.        End If
  10.    Next i
  11. End Function

Por cierto, la velocidad se medira llamando a la funcion con un rango de 10000 numeros, tal que asi:
Código:
   Dim i   As Long
    Dim n   As Long

    For i = 0 To 10000
        Call IsOblongo(i, n)
    Next i


« Última modificación: 17 Agosto 2010, 01:34 am por Karcrack » En línea

Karcrack


Desconectado Desconectado

Mensajes: 2.416


Se siente observado ¬¬'


Ver Perfil
Re: [RETO] Comprobar si un numero es Oblongo/Pronico
« Respuesta #2 en: 17 Agosto 2010, 01:49 am »

Aqui esta mi codigo :D
Código
  1. ' Karcrack
  2. Private Function IsOblongo01(ByVal lNumb As Long, ByRef n As Long) As Boolean
  3.    If (lNumb = 0) Then n = 0: IsOblongo01 = True: Exit Function
  4.  
  5.    If (lNumb And 1) = 0 Then
  6.        For n = 1 To Sqr(lNumb + 1)
  7.            If lNumb = n * (n + 1) Then
  8.                IsOblongo01 = True
  9.                Exit For
  10.            End If
  11.        Next n
  12.    End If
  13. End Function

Si simplemente se quiere comprobar si es oblongo sin calcular n, se puede hacer asi:
Código:
' Karcrack, no cumple el requisito de devolver n
Private Function IsOblongo02(ByVal lNumb As Long) As Boolean
    IsOblongo02 = (Round(Sqr(lNumb + 1)) - Round(Sqr(lNumb)) = 1)
End Function
Es mas corta, pero no mas rapida ;)
« Última modificación: 17 Agosto 2010, 13:03 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 #3 en: 17 Agosto 2010, 02:03 am »

Propongo esta pero no es tan rapida :P

Código
  1. Private Function EsCasiCuadrado(ByVal lNumb As Long, ByRef n As Long) As Boolean
  2.    If lNumb < 0 Or (lNumb And 1) = 1 Then Exit Function
  3.    If lNumb = 2 Then
  4.        n = 1
  5.        EsCasiCuadrado = True
  6.    End If
  7.  
  8.    Dim i As Long
  9.    Dim fin As Long
  10.    fin = Sqr(lNumb)
  11.    For i = 2 To fin
  12.        If lNumb / i = i + 1 Then
  13.            n = i
  14.            EsCasiCuadrado = True
  15.            Exit Function
  16.        End If
  17.    Next
  18. End Function
  19.  

[OFFTOPIC]Primera vez que me sale algo para participar!!! :xD[/OFFTOPIC]
« Última modificación: 17 Agosto 2010, 02:07 am 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 #4 en: 17 Agosto 2010, 02:24 am »

@raul338: Para mejorar la velocidad te recomiendo que te saltes los pares, ya que ningun par mayor que 2 es pronico, tambien te recomiendo que hagas el bucle con la n; Te ahorras una variable y ganas velocidad... Y por ultimo te recomiendo que aqui:
Código:
        If lNumb / i = i + 1 Then
Hagas la division entera (\) que es mas rapida ;)

Saludos :D
En línea

Tokes

Desconectado Desconectado

Mensajes: 140


Ver Perfil
Re: [RETO] Comprobar si un numero es Oblongo/Pronico
« Respuesta #5 en: 17 Agosto 2010, 03:24 am »

Aquí dejo mi código.

Código:
'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
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 #6 en: 17 Agosto 2010, 04:40 am »

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 :P)
@Karcrack Tu codigo no devuelve nada :( o al menos yo pruebo asi:

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 = 1 To 100000
  13.        If EsOblongo(i, j) Then s = s & i & ","
  14.    Next i
  15.    Text1.Text = Text1.Text & "Tokes: " & tim.Elapsed & vbCrLf & s & vbCrLf
  16.  
  17.    s = ""
  18.    tim.Reset
  19.    For i = 1 To 100000
  20.        If EsCasiCuadrado(i, j) Then s = s & i & ","
  21.    Next i
  22.    Text1.Text = Text1.Text & "Tokes Mod Raul338: " & tim.Elapsed & vbCrLf & s & vbCrLf
  23.  
  24.    s = ""
  25.    tim.Reset
  26.    For i = 1 To 100000
  27.        If IsOblongo01(i, j) Then s = s & i & ","
  28.    Next i
  29.    Text1.Text = Text1.Text & "Karcrack: " & tim.Elapsed & vbCrLf & s & vbCrLf
  30. End Sub
  31.  
  32. ' Tokes Mod Raul338
  33. Private Function EsCasiCuadrado(ByVal lNumb As Long, ByRef n As Long) As Boolean
  34.    If lNumb < 0 Then Exit Function
  35.    If (lNumb And 1) Then Exit Function
  36.  
  37.    Dim s As Long
  38.    s = CLng(Right$(lNumb, 1))
  39.    If (Not s = 0) Xor (Not s = 2) Xor (Not s = 6) Then
  40.        Exit Function
  41.    End If
  42.  
  43.    Dim fin As Long
  44.    fin = Sqr(lNumb)
  45.  
  46.    For n = 1 To fin
  47.        If lNumb = n * n + n Then
  48.            EsCasiCuadrado = True
  49.            Exit Function
  50.        End If
  51.    Next
  52. End Function
  53.  
  54. ' Karcrack
  55. Private Function IsOblongo01(ByVal lNumb As Long, ByRef n As Long) As Boolean
  56.    If (lNumb = 0) Or (lNumb = 2) Then n = lNumb \ 2: IsOblongo01 = True: Exit Function
  57.  
  58.    If (lNumb And 1) Then
  59.        For n = 3 To Sqr(lNumb + 1) Step 2
  60.            If lNumb = n * (n + 1) Then
  61.                IsOblongo01 = True
  62.                Exit For
  63.            End If
  64.        Next n
  65.    End If
  66. End Function
  67.  
  68. 'Tokes
  69. Private Function EsOblongo(ByVal num As Long, ByRef n As Long) As Boolean
  70. Dim max As Long, i As Long
  71.    If (num And 1) Then Exit Function
  72.  
  73.    max = Sqr(num)
  74.    For i = 0 To max
  75.        If num = i * i + i Then 'i * (i + 1) Then
  76.            EsOblongo = True
  77.            n = i
  78.            Exit Function
  79.        End If
  80.    Next
  81. End Function
  82.  

A ver quien mas se postula :P


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




Resultados en tiempo de ejecucion!!!

Código:
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,
« Última modificación: 17 Agosto 2010, 04:42 am por raul338 » En línea

LeandroA
Moderador
***
Desconectado Desconectado

Mensajes: 760


www.leandroascierto.com


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

Hola me matan las matematicas @~#~#

bueno pongo dos funciones una a lo bruto y la otra mejor es en base a la de tokes pero mas rapida.

Código
  1. Private Function IsOblongoLeo(ByVal lNumb As Long, ByRef n As Long) As Boolean
  2.    Dim R As Long
  3.    Dim lSum As Long
  4.  
  5.    If (lNumb And 1) Then Exit Function
  6.  
  7.    lSum = lNumb + 1
  8.  
  9.    R = lSum ^ 0.48
  10.    If lNumb = R * (R + 1) Then
  11.        IsOblongoLeo = True
  12.        n = R
  13.    Else
  14.        R = lSum ^ 0.49
  15.        If lNumb = R * (R + 1) Then
  16.            IsOblongoLeo = True
  17.            n = R
  18.        Else
  19.            R = lSum ^ 0.495
  20.            If lNumb = R * (R + 1) Then
  21.                IsOblongoLeo = True
  22.                n = R
  23.            Else
  24.                R = lSum ^ 0.498
  25.                If lNumb = R * (R + 1) Then
  26.                    IsOblongoLeo = True
  27.                    n = R
  28.                Else
  29.                    R = lSum ^ 0.499
  30.                    If lNumb = R * (R + 1) Then
  31.                        IsOblongoLeo = True
  32.                        n = R
  33.                    Else
  34.                        If (lNumb = 0) Or (lNumb = 2) Then n = lNumb \ 2: IsOblongoLeo = True: Exit Function
  35.                        If (lNumb = 6) Then n = 2: IsOblongoLeo = True
  36.                    End If
  37.                End If
  38.            End If
  39.        End If
  40.    End If
  41. End Function
  42.  

y esta mucho mas rapida

Código
  1. Private Function IsOblongoLeo2(ByVal lNumb As Long, ByRef n As Long) As Boolean
  2.  
  3.    Dim lmax As Long, i As Long
  4.  
  5.    If (lNumb And 1) Then Exit Function
  6.    If lNumb = 0 Then n = 0: IsOblongoLeo2 = True: Exit Function
  7.  
  8.    lmax = Sqr(lNumb)
  9.  
  10.    For i = lmax - 1 To lmax
  11.        If lNumb = i * (i + 1) Then
  12.            IsOblongoLeo2 = True
  13.            n = i
  14.            Exit Function
  15.        End If
  16.    Next
  17. End Function
  18.  

« Última modificación: 17 Agosto 2010, 06:14 am por LeandroA » En línea

cobein


Desconectado Desconectado

Mensajes: 759



Ver Perfil WWW
Re: [RETO] Comprobar si un numero es Oblongo/Pronico
« Respuesta #8 en: 17 Agosto 2010, 05:56 am »

Algo que vi en algunos algoritmos

6 = 2*(2+1) no es lo mismo que 2 * 2+1
En línea

http://www.advancevb.com.ar
Más Argentino que el morcipan
Aguante el Uvita tinto, Tigre, Ford y seba123neo
Karcrack es un capo.
LeandroA
Moderador
***
Desconectado Desconectado

Mensajes: 760


www.leandroascierto.com


Ver Perfil WWW
Re: [RETO] Comprobar si un numero es Oblongo/Pronico
« Respuesta #9 en: 17 Agosto 2010, 06:11 am »

jaja eso me pasa por copiar  ;D
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,283 Ú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,450 Último mensaje 10 Abril 2011, 20:42 pm
por nhaalclkiemr
[RETO] Determinar Número Perfecto « 1 2 3 »
Programación Visual Basic
Miseryk 20 8,267 Último mensaje 8 Noviembre 2013, 02:24 am
por rob1104
comprobar numero repetido en un vector
Programación C/C++
MessageBoxA 4 3,053 Último mensaje 26 Junio 2014, 02:05 am
por MeCraniDOS
¿Es posible escapar del reto “vecinos de número”?
Noticias
wolfbcn 6 1,449 Último mensaje 13 Agosto 2019, 18:42 pm
por @XSStringManolo
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines