Autor
|
Tema: [RETO] Comprobar si un numero es Oblongo/Pronico (Leído 26,698 veces)
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
no participe en el anterior reto pero dejo lña mia Private Function IsOblongo(ByVal lNumb As Long, ByRef n As Long) As Boolean Dim a As Long If lNumb < 0 Then n = -1: Exit Function If (lNumb And 1) = 0 Then If lNumb = 0 Then IsOblongo = True ElseIf lNumb = 2 Then n = 1 IsOblongo = True ElseIf lNumb = 6 Then n = 2 IsOblongo = True ElseIf lNumb = 12 Then n = 3 IsOblongo = True Else For n = lNumb \ 4 To lNumb ^ (0.5) Step -1 If n * (n - 1) = lNumb Then IsOblongo = True Exit Function End If Next End If Else IsOblongo = False n = -1 End If End Function
P.D.: Aun no la he optimisado!¡. Dulces Lunas!¡.
|
|
« Última modificación: 17 Agosto 2010, 09:27 am por BlackZeroX »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
@LeandroA
La funcion sqr() no permite numeros negativos xP
@General
n deberia devolver -1 u otro, razonando que 0 pertenece a el numero 0, al igual que 1 pertenece a 2, 2 a 6, 3 a 12, 4 a 20, 5 a 30, etc (Siendo n a X)!¡..
Dulces Lunas!¡.
|
|
|
En línea
|
The Dark Shadow is my passion.
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
Hay funciones que se indican erroneas: Karcrack y la Funcion de LeandroAKarcrack corrige el HOrror (step 2, sqr(X-1), y (n=3) [sqr(6)=2.444.. ] el 6 no esta contemplado) --> Que paso ? Indicare los numeros: LeandroA Solo son desde apartir de 11772 LeandroA 11772 LeandroA 11990 LeandroA 12210 LeandroA 12432 LeandroA 12656 LeandroA 12882 LeandroA 13110 LeandroA 13340 LeandroA 13572 LeandroA 13806 LeandroA 14042 LeandroA 14280 LeandroA 14520 LeandroA 14762 LeandroA 15006 LeandroA 15252 LeandroA 15500 LeandroA 15750 LeandroA 16002 LeandroA 16256 LeandroA 16512 LeandroA 16770 LeandroA 17030 LeandroA 17292 LeandroA 17556 LeandroA 17822 LeandroA 18090 LeandroA 18360 LeandroA 18632 LeandroA 18906 LeandroA 19182 LeandroA 19460 LeandroA 19740 LeandroA 20022 LeandroA 20306 LeandroA 20592 LeandroA 20880 LeandroA 21170 LeandroA 21462 LeandroA 21756 LeandroA 22052 LeandroA 22350 LeandroA 22650 LeandroA 22952 LeandroA 23256 LeandroA 23562 LeandroA 23870 LeandroA 24180 LeandroA 24492 LeandroA 24806 LeandroA 25122 LeandroA 25440 LeandroA 25760 LeandroA 26082 LeandroA 26406 LeandroA 26732 LeandroA 27060 LeandroA 27390 LeandroA 27722 LeandroA 28056 LeandroA 28392 LeandroA 28730 LeandroA 29070 LeandroA 29412 LeandroA 29756 LeandroA 30102 LeandroA 30450 LeandroA 30800 LeandroA 31152 LeandroA 31506 LeandroA 31862 LeandroA 32220 LeandroA 32580 LeandroA 32942 LeandroA 33306 LeandroA 33672 LeandroA 34040 LeandroA 34410 LeandroA 34782 LeandroA 35156 LeandroA 35532 LeandroA 35910 LeandroA 36290 LeandroA 36672 LeandroA 37056 LeandroA 37442 LeandroA 37830 LeandroA 38220 LeandroA 38612 LeandroA 39006 LeandroA 39402 LeandroA 39800 LeandroA 40200 LeandroA 40602 LeandroA 41006 LeandroA 41412 LeandroA 41820 LeandroA 42230 LeandroA 42642 LeandroA 43056 LeandroA 43472 LeandroA 43890 LeandroA 44310 LeandroA 44732 LeandroA 45156 LeandroA 45582 LeandroA 46010 LeandroA 46440 LeandroA 46872 LeandroA 47306 LeandroA 47742 LeandroA 48180 LeandroA 48620 LeandroA 49062 LeandroA 49506 LeandroA 49952 LeandroA 50400 LeandroA 50850 LeandroA 51302 LeandroA 51756 LeandroA 52212 LeandroA 52670 LeandroA 53130 LeandroA 53592 LeandroA 54056 LeandroA 54522 LeandroA 54990 LeandroA 55460 LeandroA 55932 LeandroA 56406 LeandroA 56882 LeandroA 57360 LeandroA 57840 LeandroA 58322 LeandroA 58806 LeandroA 59292 LeandroA 59780 LeandroA 60270 LeandroA 60762 LeandroA 61256 LeandroA 61752 LeandroA 62250 LeandroA 62750 LeandroA 63252 LeandroA 63756 LeandroA 64262 LeandroA 64770 LeandroA 65280 LeandroA 65792 LeandroA 66306 LeandroA 66822 LeandroA 67340 LeandroA 67860 LeandroA 68382 LeandroA 68906 LeandroA 69432 LeandroA 69960 LeandroA 70490 LeandroA 71022 LeandroA 71556 LeandroA 72092 LeandroA 72630 LeandroA 73170 LeandroA 73712 LeandroA 74256 LeandroA 74802 LeandroA 75350 LeandroA 75900 LeandroA 76452 LeandroA 77006 LeandroA 77562 LeandroA 78120 LeandroA 78680 LeandroA 79242 LeandroA 79806 LeandroA 80372 LeandroA 80940 LeandroA 81510 LeandroA 82082 LeandroA 82656 LeandroA 83232 LeandroA 83810 LeandroA 84390 LeandroA 84972 LeandroA 85556 LeandroA 86142 LeandroA 86730 LeandroA 87320 LeandroA 87912 LeandroA 88506 LeandroA 89102 LeandroA 89700 LeandroA 90300 LeandroA 90902 LeandroA 91506 LeandroA 92112
Option Explicit Private Declare Function GetTickCount Lib "Kernel32" () As Long Private Sub Form_Load() Dim i As Long Dim t(1) As Long t(0) = GetTickCount For i = 0 To 92681 If IsOblongo01(i, 0) <> IsOblongo02(i) Then Debug.Print "Karcrack", i End If Next i t(1) = GetTickCount text1.text = text1.text & vbNewLine & "Karcrack --> " & t(1) - t(0) t(0) = GetTickCount For i = 0 To 92681 If EsOblongo(i, 0) <> IsOblongo02(i) Then Debug.Print "Tokes", i End If Next i t(1) = GetTickCount text1.text = text1.text & vbNewLine & "Tokes --> " & t(1) - t(0) t(0) = GetTickCount For i = 0 To 92681 If IsOblongo(i, 0) <> IsOblongo02(i) Then Debug.Print "BlackZeroX", i End If Next i t(1) = GetTickCount text1.text = text1.text & vbNewLine & "BlackZeroX --> " & t(1) - t(0) t(0) = GetTickCount For i = 0 To 92681 If IsOblongoLeo(i, 0) <> IsOblongo02(i) Then Debug.Print "LeandroA", i End If Next i t(1) = GetTickCount text1.text = text1.text & vbNewLine & "LeandroA --> " & t(1) - t(0) End Sub 'BlackZeroX Private Function IsOblongo(ByVal lNumb As Long, ByRef n As Long) As Boolean Dim a As Long If lNumb < 0 Then n = -1: Exit Function If (lNumb And 1) = 0 Then If lNumb = 0 Then IsOblongo = True ElseIf lNumb = 2 Then n = 1 IsOblongo = True ElseIf lNumb = 6 Then n = 2 IsOblongo = True ElseIf lNumb = 12 Then n = 3 IsOblongo = True Else For n = lNumb \ 4 To lNumb ^ (0.5) Step -1 If n * (n - 1) = lNumb Then IsOblongo = True Exit Function End If Next End If Else IsOblongo = False n = -1 End If End Function ' Karcrack Private Function IsOblongo01(ByVal lNumb As Long, ByRef n As Long) As Boolean If (lNumb = 0) Or (lNumb = 2) Then n = lNumb \ 2: IsOblongo01 = True: Exit Function If (lNumb And 1) Then For n = 3 To Sqr(lNumb + 1) Step 2 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 'raul338 Private Function EsCasiCuadrado(ByVal lNumb As Long, ByRef n As Long) As Boolean If lNumb < 0 Or (lNumb And 1) = 1 Then Exit Function If lNumb = 2 Then n = 1 EsCasiCuadrado = True End If Dim i As Long Dim fin As Long fin = Sqr(lNumb) For i = 2 To fin If lNumb / i = i + 1 Then n = i EsCasiCuadrado = True Exit Function End If Next End Function 'LeandroA Private Function IsOblongoLeo(ByVal lNumb As Long, ByRef n As Long) As Boolean Dim R As Long Dim lSum As Long If (lNumb And 1) Then Exit Function lSum = lNumb + 1 R = lSum ^ 0.48 If lNumb = R * (R + 1) Then IsOblongoLeo = True n = R Else R = lSum ^ 0.49 If lNumb = R * (R + 1) Then IsOblongoLeo = True n = R Else R = lSum ^ 0.495 If lNumb = R * (R + 1) Then IsOblongoLeo = True n = R Else R = lSum ^ 0.498 If lNumb = R * (R + 1) Then IsOblongoLeo = True n = R Else R = lSum ^ 0.499 If lNumb = R * (R + 1) Then IsOblongoLeo = True n = R Else If (lNumb = 0) Or (lNumb = 2) Then n = lNumb \ 2: IsOblongoLeo = True: Exit Function If (lNumb = 6) Then n = 2: IsOblongoLeo = True End If End If End If End If End If End Function ' 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
P.D.: la mia es la mas lenta xP Ducles Lunas!¡.
|
|
« Última modificación: 17 Agosto 2010, 10:26 am por BlackZeroX »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
Karcrack
Desconectado
Mensajes: 2.416
Se siente observado ¬¬'
|
1- Raul338 aplicas mal el algoritmo, como ha dicho Cobein (n * (n+1)) <> (n * n + 1) 2- La velocidad ha de comprobarse compilada siempre. 3- Algunos de vosotros no incluis el 2 como numero Oblongo, y lo es: 2 = 1*(1+1) 4- Aqui pongo los resultados del test que he corrido en mi PC ( Con la llamada que puse yo, que es con la que hay que probar ): Karcrack -> 5,729 msec Tokes -> 6,236 msec LeandroA -> 24,102 B0X -> 76,071 msec raul338 -> Funcion no valida
He actualizado mi funcion, tenia un gran fallo ' 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
|
|
« Última modificación: 17 Agosto 2010, 13:05 pm por Karcrack »
|
En línea
|
|
|
|
79137913
Desconectado
Mensajes: 1.169
4 Esquinas
|
HOLA!!! QUISIERA SABER QUE ES MAS RAPIDO: If Not (lNumb And 1) = 0 Then Exit Function ' O If Not (lNumb Mod 2) = 0 Then Exit Function
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*
|
|
|
raul338
Desconectado
Mensajes: 2.633
La sonrisa es la mejor forma de afrontar las cosas
|
Algo que vi en algunos algoritmos
6 = 2*(2+1) no es lo mismo que 2 * 2+1
1- Raul338 aplicas mal el algoritmo, como ha dicho Cobein (n * (n+1)) <> (n * n + 1)
6 = 2 * (2 + 1) // pasamos el 2 dividiendo a 6 6 / 2 = 2 + 1 // en otros lados dicen "dividimos ambos mienbros por 2 6 / 2 = 2 * (2 + 1) 2 6 / 2 = 2 + 1
Cosa que eso es lo que hago yo Cambien "lNumb / i = i + 1" por "lNumb = i * (i + 1)" y les dara exactamente los mismos resultados
|
|
|
En línea
|
|
|
|
Tokes
Desconectado
Mensajes: 140
|
raul338 tiene toda la razón del universo.
Saludos...
|
|
|
En línea
|
|
|
|
raul338
Desconectado
Mensajes: 2.633
La sonrisa es la mejor forma de afrontar las cosas
|
Ufff.... para mi LeandroA ha ganado el reto!, es rapidisima su funcion!!!!
|
|
|
En línea
|
|
|
|
Karcrack
Desconectado
Mensajes: 2.416
Se siente observado ¬¬'
|
@79137913: Es mucho mas rapido el primero, siempre trabajar con Bits es mas rapido.
|
|
« Última modificación: 17 Agosto 2010, 19:14 pm por Karcrack »
|
En línea
|
|
|
|
Tokes
Desconectado
Mensajes: 140
|
Hola a todos. No proclamen un ganador sin primero ver esto. 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 = "" 'BlackZeroX c = 0 t1 = GetTickCount For i = 1 To Val(Text1) If IsOblongo(i, n) Then c = c + 1 End If Next t2 = GetTickCount Label1.Caption = Label1.Caption & "'BlackZeroX --> " & t2 - t1 & Chr(13) _ & c & " números oblongos encontrados" & Chr(13) & Chr(13) 'Karcrack c = 0 t1 = GetTickCount For i = 1 To Val(Text1) If IsOblongo01(i, n) Then c = c + 1 End If Next t2 = GetTickCount Label1.Caption = Label1.Caption & "Karcrack --> " & t2 - t1 & Chr(13) _ & c & " números oblongos encontrados" & Chr(13) & Chr(13) 'Tokes c = 0 t1 = GetTickCount For i = 1 To Val(Text1) If EsOblongo(i, n) Then c = c + 1 End If Next t2 = GetTickCount Label1.Caption = Label1.Caption & "Tokes --> " & t2 - t1 & Chr(13) _ & c & " números oblongos encontrados" & Chr(13) & Chr(13) 'Tokes 2 c = 0 t1 = GetTickCount For i = 1 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) 'raul338 c = 0 t1 = GetTickCount For i = 1 To Val(Text1) If EsCasiCuadrado(i, n) Then c = c + 1 End If Next t2 = GetTickCount Label1.Caption = Label1.Caption & "raul338 --> " & t2 - t1 & Chr(13) _ & c & " números oblongos encontrados" & Chr(13) & Chr(13) 'LeandroA c = 0 t1 = GetTickCount For i = 1 To Val(Text1) If IsOblongoLeo(i, n) Then c = c + 1 End If Next t2 = GetTickCount Label1.Caption = Label1.Caption & "LeandroA --> " & t2 - t1 & Chr(13) _ & c & " números oblongos encontrados" & Chr(13) & Chr(13) 'Karcrack sin retorno de n c = 0 t1 = GetTickCount For i = 1 To Val(Text1) If IsOblongo02(i) Then c = c + 1 End If Next t2 = GetTickCount Label1.Caption = Label1.Caption & "Karcrack (IsOblongo02) = " & t2 - t1 & Chr(13) _ & c & " números oblongos encontrados" & Chr(13) & Chr(13) End Sub
'---------------------- 'BlackZeroX Private Function IsOblongo(ByVal lNumb As Long, ByRef n As Long) As Boolean Dim a As Long If lNumb < 0 Then n = -1: Exit Function If (lNumb And 1) = 0 Then If lNumb = 0 Then IsOblongo = True ElseIf lNumb = 2 Then n = 1 IsOblongo = True ElseIf lNumb = 6 Then n = 2 IsOblongo = True ElseIf lNumb = 12 Then n = 3 IsOblongo = True Else For n = lNumb \ 4 To lNumb ^ (0.5) Step -1 If n * (n - 1) = lNumb Then IsOblongo = True Exit Function End If Next End If Else IsOblongo = False n = -1 End If End Function '------------------ ' 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 '----------------- '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 'raul338 Private Function EsCasiCuadrado(ByVal lNumb As Long, ByRef n As Long) As Boolean If lNumb < 0 Or (lNumb And 1) = 1 Then Exit Function If lNumb = 2 Then n = 1 EsCasiCuadrado = True End If Dim i As Long Dim fin As Long fin = Sqr(lNumb) For i = 2 To fin If lNumb / i = i + 1 Then n = i EsCasiCuadrado = True Exit Function End If Next End Function 'LeandroA Private Function IsOblongoLeo(ByVal lNumb As Long, ByRef n As Long) As Boolean Dim R As Long Dim lSum As Long If (lNumb And 1) Then Exit Function lSum = lNumb + 1 R = lSum ^ 0.48 If lNumb = R * (R + 1) Then IsOblongoLeo = True n = R Else R = lSum ^ 0.49 If lNumb = R * (R + 1) Then IsOblongoLeo = True n = R Else R = lSum ^ 0.495 If lNumb = R * (R + 1) Then IsOblongoLeo = True n = R Else R = lSum ^ 0.498 If lNumb = R * (R + 1) Then IsOblongoLeo = True n = R Else R = lSum ^ 0.499 If lNumb = R * (R + 1) Then IsOblongoLeo = True n = R Else If (lNumb = 0) Or (lNumb = 2) Then n = lNumb \ 2: IsOblongoLeo = True: Exit Function If (lNumb = 6) Then n = 2: IsOblongoLeo = True End If End If End If End If End If End Function ' 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
Saludos.
|
|
|
En línea
|
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
[DUDA] Comprobar si un número es ondulado
Programación C/C++
|
Kropt32
|
2
|
7,691
|
15 Diciembre 2010, 09:04 am
por Kropt32
|
|
|
[JSTL] Como comprobar si una variable es un numero en JSTL
Desarrollo Web
|
nhaalclkiemr
|
0
|
4,652
|
10 Abril 2011, 20:42 pm
por nhaalclkiemr
|
|
|
[RETO] Determinar Número Perfecto
« 1 2 3 »
Programación Visual Basic
|
Miseryk
|
20
|
9,244
|
8 Noviembre 2013, 02:24 am
por rob1104
|
|
|
comprobar numero repetido en un vector
Programación C/C++
|
MessageBoxA
|
4
|
3,389
|
26 Junio 2014, 02:05 am
por MeCraniDOS
|
|
|
¿Es posible escapar del reto “vecinos de número”?
Noticias
|
wolfbcn
|
6
|
1,845
|
13 Agosto 2019, 18:42 pm
por @XSStringManolo
|
|