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

 

 


Tema destacado:


+  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,602 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,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