Autor
|
Tema: [RETO] Comprobar si un numero es Oblongo/Pronico (Leído 27,018 veces)
|
raul338
Desconectado
Mensajes: 2.633
La sonrisa es la mejor forma de afrontar las cosas
|
Tokes, no estas usando la ultima version de LeandroA 
|
|
|
En línea
|
|
|
|
Karcrack
Desconectado
Mensajes: 2.416
Se siente observado ¬¬'
|
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  , como has llegado a la conclusion de que num = (max * max) + max? Donde lo has leeeido!! 
|
|
« Última modificación: 17 Agosto 2010, 19:25 pm por Karcrack »
|
En línea
|
|
|
|
raul338
Desconectado
Mensajes: 2.633
La sonrisa es la mejor forma de afrontar las cosas
|
Me he tomado la libertad de ir testeando, aunque habria que probarlo en más PCs... Utilizando: cTiming.clsOption Explicit Dim i As Integer Dim tim As New CTiming Private Sub Form_Load() Dim i As Long Dim j As Long Dim s As String s = "" tim.Reset For i = 0 To 100000 If EsOblongo2(i, j) Then s = s & "(" & i & "," & j & ")" Next i Text1.Text = Text1.Text & "Tokes: " & tim.Elapsed & vbCrLf & s & vbCrLf & vbCrLf s = "" tim.Reset For i = 0 To 100000 If IsOblongoLeo2(i, j) Then s = s & "(" & i & "," & j & ")" Next i Text1.Text = Text1.Text & "LeandroA: " & tim.Elapsed & vbCrLf & s & vbCrLf & vbCrLf s = "" tim.Reset For i = 0 To 100000 If IsOblongo01(i, j) Then s = s & "(" & i & "," & j & ")" Next i Text1.Text = Text1.Text & "Karcrack: " & tim.Elapsed & vbCrLf & s & vbCrLf & vbCrLf 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 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 ' 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
Tokes v2: 9,31712800337221 LeandroA: 7,62460838830173 Karcrack: 95,5182170415809 Blackzerox y yo perdimos por goleada  Agregado la v2 de Tokes
|
|
« Última modificación: 17 Agosto 2010, 19:40 pm por raul338 »
|
En línea
|
|
|
|
Karcrack
Desconectado
Mensajes: 2.416
Se siente observado ¬¬'
|
No habia visto la nueva version de Leandro  , buen trabajo  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 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
Mensajes: 1.169
4 Esquinas
|
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
Mensajes: 3.158
I'Love...!¡.
|
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  , como has llegado a la conclusion de que num = (max * max) + max? Donde lo has leeeido!!  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 ) 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 aquiDulces Lunas!¡.
|
|
« Última modificación: 17 Agosto 2010, 19:42 pm por BlackZeroX »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
Tokes
Desconectado
Mensajes: 140
|
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. 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
Mensajes: 2.633
La sonrisa es la mejor forma de afrontar las cosas
|
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
Mensajes: 3.158
I'Love...!¡.
|
una modificacion rapida (solo es 2 msec mas rapida ¬¬") a la funcion de Tokes (Ojala hubieramos despenajo n(n+1) ¬¬" )!¡. ' Tokes 03 Private Function IsOblongoTokes03(ByVal nval As Long, ByRef n As Long) As Boolean If (nval And 1) Or (nval And &H80000000) Then Exit Function n = Sqr(nval) IsOblongoTokes03 = n * n + n = nval End Function
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
Mensajes: 140
|
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
|
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
[DUDA] Comprobar si un número es ondulado
Programación C/C++
|
Kropt32
|
2
|
7,796
|
15 Diciembre 2010, 09:04 am
por Kropt32
|
|
|
[JSTL] Como comprobar si una variable es un numero en JSTL
Desarrollo Web
|
nhaalclkiemr
|
0
|
4,717
|
10 Abril 2011, 20:42 pm
por nhaalclkiemr
|
|
|
[RETO] Determinar Número Perfecto
« 1 2 3 »
Programación Visual Basic
|
Miseryk
|
20
|
9,469
|
8 Noviembre 2013, 02:24 am
por rob1104
|
|
|
comprobar numero repetido en un vector
Programación C/C++
|
MessageBoxA
|
4
|
3,492
|
26 Junio 2014, 02:05 am
por MeCraniDOS
|
|
|
¿Es posible escapar del reto “vecinos de número”?
Noticias
|
wolfbcn
|
6
|
1,934
|
13 Agosto 2019, 18:42 pm
por @XSStringManolo
|
|