 Autor
|
Tema: [RETO] Comprobar si un numero es Oblongo/Pronico (Leído 25,221 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,331
|
15 Diciembre 2010, 09:04 am
por Kropt32
|
|
|
|
[JSTL] Como comprobar si una variable es un numero en JSTL
Desarrollo Web
|
nhaalclkiemr
|
0
|
4,477
|
10 Abril 2011, 20:42 pm
por nhaalclkiemr
|
|
|
[RETO] Determinar Número Perfecto
« 1 2 3 »
Programación Visual Basic
|
Miseryk
|
20
|
8,405
|
8 Noviembre 2013, 02:24 am
por rob1104
|
|
|
|
comprobar numero repetido en un vector
Programación C/C++
|
MessageBoxA
|
4
|
3,095
|
26 Junio 2014, 02:05 am
por MeCraniDOS
|
|
|
|
¿Es posible escapar del reto “vecinos de número”?
Noticias
|
wolfbcn
|
6
|
1,493
|
13 Agosto 2019, 18:42 pm
por @XSStringManolo
|
 |
