Mensajes

[CTiming.cls]

Para quien le interese la funcion Sqr en ASM (es el punto critico ahora)

http://www.azillionmonkeys.com/qed/sqroot.html

@Tokes

en el mismo .Zip esta el archivo CTiming.cls, ya esta el proyecto completo!¡.

Dulces Lunas!¡.

Para extremistas!¡.

QueryPerformanceCounter

Edito:

Proyecto gral!¡. 

Dulces Lunas!¡.

[n(n+1)]

una modificacion rapida (solo es 2 msec mas rapida ¬¬") a la funcion de Tokes (Ojala hubieramos despenajo n(n+1) ¬¬" )!¡.

Código (Vb) [Seleccionar] Expandir



'  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



Código [Seleccionar] Expandir



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!¡.

[MOD:]

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 )

Código [Seleccionar] Expandir



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 aqui

Dulces Lunas!¡.

[Karcrack]

Hay funciones que se indican erroneas:

Karcrack y la Funcion de LeandroA

Karcrack 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

Código [Seleccionar] Expandir



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



Código (vb) [Seleccionar] Expandir



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!¡.

[n]

@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!¡.

no participe en el anterior reto pero dejo lña mia

Código (vb) [Seleccionar] Expandir



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!¡.

[Karcrack]

Como Karcrack ya dijo ...

Código (vb) [Seleccionar] Expandir



IsOdiousNumber = (l mod 2) <> 0



= y mas rapido asi

Código (Vb) [Seleccionar] Expandir



IsOdiousNumber = (l And 1) <> 0



Código (vb) [Seleccionar] Expandir



Private Function IsOdiousNumber(lNum As Long) As Boolean

   Dim l As Long

   l = ((lNum And &H80000000) \ &H80000000)
   l = l + ((lNum And &H40000000) \ &H40000000)
   l = l + ((lNum And &H20000000) \ &H20000000)
   l = l + ((lNum And &H10000000) \ &H10000000)
   l = l + ((lNum And &H8000000) \ &H8000000)
   l = l + ((lNum And &H4000000) \ &H4000000)
   l = l + ((lNum And &H2000000) \ &H2000000)
   l = l + ((lNum And &H1000000) \ &H1000000)
   l = l + ((lNum And &H800000) \ &H800000)
   l = l + ((lNum And &H400000) \ &H400000)
   l = l + ((lNum And &H200000) \ &H200000)
   l = l + ((lNum And &H100000) \ &H100000)
   l = l + ((lNum And &H80000) \ &H80000)
   l = l + ((lNum And &H40000) \ &H40000)
   l = l + ((lNum And &H20000) \ &H20000)
   l = l + ((lNum And &H10000) \ &H10000)
   l = l + ((lNum And &H8000&) \ &H8000&)
   l = l + ((lNum And &H4000) \ &H4000)
   l = l + ((lNum And &H2000) \ &H2000)
   l = l + ((lNum And &H1000) \ &H1000)
   l = l + ((lNum And &H800) \ &H800)
   l = l + ((lNum And &H400) \ &H400)
   l = l + ((lNum And &H200) \ &H200)
   l = l + ((lNum And &H100) \ &H100)
   l = l + ((lNum And &H80) \ &H80)
   l = l + ((lNum And &H40) \ &H40)
   l = l + ((lNum And &H20) \ &H20)
   l = l + ((lNum And &H10) \ &H10)
   l = l + ((lNum And &H8) \ &H8)
   l = l + ((lNum And &H4) \ &H4)
   l = l + ((lNum And &H2) \ &H2)
   l = l + ((lNum And &H1) \ &H1)

   IsOdiousNumber = (l and 1) <> 0

End Function



Ducles Lunas!¡.

La Funcion de Tokes me parece que se puede hacer mas rapida si en lgar del For Next se sustituye por CopyMemory...

Dulces Lunas!¡.

.
http://infrangelux.sytes.net/FileX/down.php?InfraDown=/BlackZeroX/Comprovaciones/NumOfLuck/ComprobacionVel-3.zip

Código [Seleccionar] Expandir



Dessa --> 1250
PsYkE1 -- > 2078
LeandroA -- > 1453
Cobein -- > 107265
Tokes -- > 204

Se comprobaran Coherencias...



Dulces Lunas!¡.