La verdad es que me hace gracia ver los nombres que les ponen a los tipos de numeros :laugh: :laugh: :laugh:
Un numero odioso es aquel que en su expresion binaria tiene una cantidad impar de unos... por ejemplo el numero ONCE (11) que expresado en forma binaria es 1011, es decir 3 unos..
Mas info:
http://mathworld.wolfram.com/OdiousNumber.html
http://oeis.org/classic/A000069
Se medira el tiempo que tarda en calcular 100.000 numeros... tal que asi:
Dim i As Long
For i = 1 To 100000
Call IsItOdious(i)
Next i
Id preparando los codeees! :P
Aqui teneis un ejemplo de algoritmo habitual:
Private Function IsItOdious(ByVal lNumb As Long) As Boolean
Dim lCount As Long
Dim i As Long
If lNumb <= 0 Then Exit Function
For i = 0 To 30
If lNumb And 2 ^ i Then lCount = lCount + 1
Next i
IsItOdious = ((lNumb Mod 2) <> 0)
End Function
Por supuesto se puede hacer mas rapido :D
Todo el mundo a pensar en 0s y 1s!! :laugh:
yo pongo esta pero me siento un ladron (http://www.xbeat.net/vbspeed/c_LongToBit.htm) >:(
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 Mod 2 <> 0
End Function
Como Karcrack ya dijo ...
IsOdiousNumber = (l mod 2) <> 0
= y mas rapido asi
IsOdiousNumber = (l And 1) <> 0
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!¡.
Private Function IsOdiousNumber(ByVal lVal As Long) As Boolean
Do
If lVal And 1 Then IsOdiousNumber = Not IsOdiousNumber
lVal = lVal \ 2
If lVal = 0 Then Exit Function
If lVal = 1 Then IsOdiousNumber = Not IsOdiousNumber: Exit Function
Loop
End Function
Mi codigo, lo comento para que quien no entienda de Bits le quede mas claro ;):
Private Function IsItOdious(ByVal lNumb As Long) As Boolean
Dim bTmp As Byte
Dim bRes As Byte
' Si es negativo...
If lNumb And &H80000000 Then Exit Function
'Obtenemos el HiByte
bTmp = lNumb And &HFF
bRes = (bTmp And 1)
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
' Rotamos el numero 32bits a la derecha
lNumb = lNumb \ &H100
'Obtenemos el HiByte
bTmp = lNumb And &HFF
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
' Rotamos el numero 32bits a la derecha
lNumb = lNumb \ &H100
'Obtenemos el HiByte
bTmp = lNumb And &HFF
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
' Rotamos el numero 32bits a la derecha
lNumb = lNumb \ &H100
'Obtenemos el HiByte
bTmp = lNumb And &HFF
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
If (bTmp And 1) Then bRes = bRes + 1
bTmp = bTmp \ 2
IsItOdious = (bRes And 1)
End Function
Despues de ver que la tecnica de Leandro era muy rapida he intentado modificar la de Cobein que parecia que tenia potencial:
Private Function IsOdiousNumberX(ByVal lVal As Long) As Boolean
If lVal And &H80000000 Then Exit Function
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
If lVal And 1 Then IsOdiousNumberX = Not IsOdiousNumberX
lVal = lVal \ 2
End Function
Resultados:
Karcrack:
49,668 msec
Cobein:
14,426 msec
LeandroA:
8,991 msec
Cobein (Mod Karcrack):
12,547 msec
Nada mal por ahora, hice unas modificaciones al codigo que postie pero no vi ninguna diferencia realmente significativa. No creo que se pueda hacer mucho mas rapido que el de leandro aunque vi cosas que se podrian optimizar posiblemente pero no creo que haga mucha diferencia.
Con respecto al code que postie por si alguno le interesa, es lo mas simple que se me ocurrio. Simplemente verifica si el numero tiene un uno si lo tiene invierte el valor del flag y hace un shift right y vuelta a lo mismo hasta que llega al ultimo valor.
Hola a todos:
Disculpen que me haya entrometido nuevamente, pero bueno, para eso es el foro.
Les dejo aquí mi código, que es un poco largo, pero igual funciona (al menos para los números del 1 al 100).
Private Function esOdioso4(ByVal num As Long) As Long
esOdioso4 = 0
If (num And &H40000000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H20000000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H10000000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H8000000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H4000000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H2000000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H1000000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H800000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H400000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H200000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H100000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H80000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H40000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H20000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H10000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H8000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H4000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H2000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H1000) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H800) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H400) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H200) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H100) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H80) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H40) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H20) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H10) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H8) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H4) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H2) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
If (num And &H1) <> 0 Then
esOdioso4 = esOdioso4 Xor 1
End If
End Function
Eso es todo. Saludos.
Simplemente para mostrar otra manera, no es mas veloz pero me parecio interesante mostrar la parte donde se reduce el numero a 1 byte.
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Type Dummy_Byte
b1 As Byte
b2 As Byte
b3 As Byte
b4 As Byte
End Type
Private Function IsOdiousNumber(ByVal lVal As Long) As Boolean
Dim b As Dummy_Byte
CopyMemory b.b1, lVal, 4
lVal = b.b1
lVal = lVal Xor b.b2
lVal = lVal Xor b.b3
lVal = lVal Xor b.b4
Dim l As Long
l = l + ((lVal And &H80) \ &H80)
l = l + ((lVal And &H40) \ &H40)
l = l + ((lVal And &H20) \ &H20)
l = l + ((lVal And &H10) \ &H10)
l = l + ((lVal And &H8) \ &H8)
l = l + ((lVal And &H4) \ &H4)
l = l + ((lVal And &H2) \ &H2)
l = l + ((lVal And &H1) \ &H1)
IsOdiousNumber = (l And 1)
End Function
Bueno, como no pude hacer un código más rápido que el de LeandroA, decidí modificar su código un poquitín. Según mis pruebas, así es más rápido.
Private Function IsOdiousNumberModif(lNum As Long) As Boolean
Dim l As Long
l = ((lNum And &H80000000) \ &H80000000)
l = l Xor ((lNum And &H40000000) \ &H40000000)
l = l Xor ((lNum And &H20000000) \ &H20000000)
l = l Xor ((lNum And &H10000000) \ &H10000000)
l = l Xor ((lNum And &H8000000) \ &H8000000)
l = l Xor ((lNum And &H4000000) \ &H4000000)
l = l Xor ((lNum And &H2000000) \ &H2000000)
l = l Xor ((lNum And &H1000000) \ &H1000000)
l = l Xor ((lNum And &H800000) \ &H800000)
l = l Xor ((lNum And &H400000) \ &H400000)
l = l Xor ((lNum And &H200000) \ &H200000)
l = l Xor ((lNum And &H100000) \ &H100000)
l = l Xor ((lNum And &H80000) \ &H80000)
l = l Xor ((lNum And &H40000) \ &H40000)
l = l Xor ((lNum And &H20000) \ &H20000)
l = l Xor ((lNum And &H10000) \ &H10000)
l = l Xor ((lNum And &H8000&) \ &H8000&)
l = l Xor ((lNum And &H4000) \ &H4000)
l = l Xor ((lNum And &H2000) \ &H2000)
l = l Xor ((lNum And &H1000) \ &H1000)
l = l Xor ((lNum And &H800) \ &H800)
l = l Xor ((lNum And &H400) \ &H400)
l = l Xor ((lNum And &H200) \ &H200)
l = l Xor ((lNum And &H100) \ &H100)
l = l Xor ((lNum And &H80) \ &H80)
l = l Xor ((lNum And &H40) \ &H40)
l = l Xor ((lNum And &H20) \ &H20)
l = l Xor ((lNum And &H10) \ &H10)
l = l Xor ((lNum And &H8) \ &H8)
l = l Xor ((lNum And &H4) \ &H4)
l = l Xor ((lNum And &H2) \ &H2)
l = l Xor ((lNum And &H1) \ &H1)
IsOdiousNumberModif = (l And 1) <> 0
End Function
Pruébenlo, me parece que sí es más rápido.
Aquí les dejo un código que hice. Ya no sé si sea más rápido o no, siempre me da resultados diferentes.
Private Function esOdioso3(ByVal num As Long) As Boolean
Dim n1 As Long, n2 As Long
n1 = (num \ &H10000) Xor (num And &HFFFF&)
n2 = (n1 \ &H100&) Xor (n1 And &HFF&)
n1 = (n2 \ &H10&) Xor (n2 And &HF&)
n2 = (n1 \ &H4&) Xor (n1 And &H3&)
n1 = (n2 \ &H2&) Xor (n2 And &H1&)
esOdioso3 = (n1 And 1) <> 0
End Function
Saludos a todos.
@Cobein Muy interesante lo de meterlo todo en un byte :) Me he tomado la libertad de mejorarlo :P:
Private Function IsOdiousNumber(ByVal lVal As Long) As Boolean
Dim lTmp As Long
Dim l As Long
lTmp = lVal
lVal = lTmp And &HFF
lTmp = lTmp \ &H100
lVal = lVal Xor (lTmp And &HFF)
lTmp = lTmp \ &H100
lVal = lVal Xor (lTmp And &HFF)
lTmp = lTmp \ &H100
lVal = lVal Xor (lTmp And &HFF)
l = l + ((lVal And &H80) \ &H80)
l = l + ((lVal And &H40) \ &H40)
l = l + ((lVal And &H20) \ &H20)
l = l + ((lVal And &H10) \ &H10)
l = l + ((lVal And &H8) \ &H8)
l = l + ((lVal And &H4) \ &H4)
l = l + ((lVal And &H2) \ &H2)
l = l + ((lVal And &H1) \ &H1)
IsOdiousNumber = (l And 1)
End Function
ES MAS RAPIDO QUE EL CODIGO DE LEANDROOO!! >:D >:D >:D :P
¡Qué tal, chavos! Me aparezco de nuevo por aquí para presentarles lo nuevo que he hecho. Hice una recopilación de varios códigos suyos y míos (de este tema, por supuesto).
En este código se encuentra:
- La función de LeandroA
- La función de LeandroA modificada por un servidor.
- La función de Cobein.
- La función de Cobein mejorada por Karcrack
- Mi función.
- Un híbrido de mi función con la de LeandroA
Véanlo y pruébenlo. Me asombró mucho el híbrido Cobein-Karcrack y el híbrido LeandroA-Tokes.
Se necesita una label Label1, un Textbox Text1 y un command button Command1. En el text1 ponen el valor máximo que se va a examinar (si ponen 1000 se mostrarán los números odiosos del 1 al 1000).
El código se muestra a continuación.
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Type Dummy_Byte
b1 As Byte
b2 As Byte
b3 As Byte
b4 As Byte
End Type
Private Function esOdioso3(ByVal num As Long) As Boolean
Dim n1 As Long, n2 As Long
n1 = (num \ &H10000) Xor (num And &HFFFF&)
n2 = (n1 \ &H100&) Xor (n1 And &HFF&)
n1 = (n2 \ &H10&) Xor (n2 And &HF&)
n2 = (n1 \ &H4&) Xor (n1 And &H3&)
n1 = (n2 \ &H2&) Xor (n2 And &H1&)
esOdioso3 = (n1 And 1) <> 0
End Function
Private Function esOdiosoTokLean(ByVal lnum As Long) As Boolean
Dim l As Long
lnum = (lnum \ &H10000) Xor (lnum And &HFFFF&)
l = l Xor ((lnum And &H8000&) \ &H8000&)
l = l Xor ((lnum And &H4000) \ &H4000)
l = l Xor ((lnum And &H2000) \ &H2000)
l = l Xor ((lnum And &H1000) \ &H1000)
l = l Xor ((lnum And &H800) \ &H800)
l = l Xor ((lnum And &H400) \ &H400)
l = l Xor ((lnum And &H200) \ &H200)
l = l Xor ((lnum And &H100) \ &H100)
l = l Xor ((lnum And &H80) \ &H80)
l = l Xor ((lnum And &H40) \ &H40)
l = l Xor ((lnum And &H20) \ &H20)
l = l Xor ((lnum And &H10) \ &H10)
l = l Xor ((lnum And &H8) \ &H8)
l = l Xor ((lnum And &H4) \ &H4)
l = l Xor ((lnum And &H2) \ &H2)
l = l Xor ((lnum And &H1) \ &H1)
esOdiosoTokLean = (l And 1) <> 0
End Function
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
Private Function IsOdiousNumberModif(lnum As Long) As Boolean
Dim l As Long
l = ((lnum And &H80000000) \ &H80000000)
l = l Xor ((lnum And &H40000000) \ &H40000000)
l = l Xor ((lnum And &H20000000) \ &H20000000)
l = l Xor ((lnum And &H10000000) \ &H10000000)
l = l Xor ((lnum And &H8000000) \ &H8000000)
l = l Xor ((lnum And &H4000000) \ &H4000000)
l = l Xor ((lnum And &H2000000) \ &H2000000)
l = l Xor ((lnum And &H1000000) \ &H1000000)
l = l Xor ((lnum And &H800000) \ &H800000)
l = l Xor ((lnum And &H400000) \ &H400000)
l = l Xor ((lnum And &H200000) \ &H200000)
l = l Xor ((lnum And &H100000) \ &H100000)
l = l Xor ((lnum And &H80000) \ &H80000)
l = l Xor ((lnum And &H40000) \ &H40000)
l = l Xor ((lnum And &H20000) \ &H20000)
l = l Xor ((lnum And &H10000) \ &H10000)
l = l Xor ((lnum And &H8000&) \ &H8000&)
l = l Xor ((lnum And &H4000) \ &H4000)
l = l Xor ((lnum And &H2000) \ &H2000)
l = l Xor ((lnum And &H1000) \ &H1000)
l = l Xor ((lnum And &H800) \ &H800)
l = l Xor ((lnum And &H400) \ &H400)
l = l Xor ((lnum And &H200) \ &H200)
l = l Xor ((lnum And &H100) \ &H100)
l = l Xor ((lnum And &H80) \ &H80)
l = l Xor ((lnum And &H40) \ &H40)
l = l Xor ((lnum And &H20) \ &H20)
l = l Xor ((lnum And &H10) \ &H10)
l = l Xor ((lnum And &H8) \ &H8)
l = l Xor ((lnum And &H4) \ &H4)
l = l Xor ((lnum And &H2) \ &H2)
l = l Xor ((lnum And &H1) \ &H1)
IsOdiousNumberModif = (l And 1) <> 0
End Function
Private Function IsOdiousNumberCob(ByVal lVal As Long) As Boolean
Dim b As Dummy_Byte
CopyMemory b.b1, lVal, 4
lVal = b.b1
lVal = lVal Xor b.b2
lVal = lVal Xor b.b3
lVal = lVal Xor b.b4
Dim l As Long
l = l + ((lVal And &H80) \ &H80)
l = l + ((lVal And &H40) \ &H40)
l = l + ((lVal And &H20) \ &H20)
l = l + ((lVal And &H10) \ &H10)
l = l + ((lVal And &H8) \ &H8)
l = l + ((lVal And &H4) \ &H4)
l = l + ((lVal And &H2) \ &H2)
l = l + ((lVal And &H1) \ &H1)
IsOdiousNumberCob = (l And 1)
End Function
Private Function IsOdiousNumberCobKar(ByVal lVal As Long) As Boolean
Dim lTmp As Long
Dim l As Long
lTmp = lVal
lVal = lTmp And &HFF
lTmp = lTmp \ &H100
lVal = lVal Xor (lTmp And &HFF)
lTmp = lTmp \ &H100
lVal = lVal Xor (lTmp And &HFF)
lTmp = lTmp \ &H100
lVal = lVal Xor (lTmp And &HFF)
l = l + ((lVal And &H80) \ &H80)
l = l + ((lVal And &H40) \ &H40)
l = l + ((lVal And &H20) \ &H20)
l = l + ((lVal And &H10) \ &H10)
l = l + ((lVal And &H8) \ &H8)
l = l + ((lVal And &H4) \ &H4)
l = l + ((lVal And &H2) \ &H2)
l = l + ((lVal And &H1) \ &H1)
IsOdiousNumberCobKar = (l And 1)
End Function
Private Sub Command1_Click()
Dim i As Long, t1 As Long, t2 As Long, c As Long
Label1.Caption = ""
'LeandroA
c = 0
t1 = GetTickCount
For i = 1 To Val(Text1)
If IsOdiousNumber(i) Then
c = c + 1
End If
Next
t2 = GetTickCount
Label1.Caption = Label1.Caption & "LeandroA = " & t2 - t1 & Chr(13) _
& c & " números odiosos encontrados" & Chr(13) & Chr(13)
'LeandroA modificada
c = 0
t1 = GetTickCount
For i = 1 To Val(Text1)
If IsOdiousNumberModif(i) Then
c = c + 1
End If
Next
t2 = GetTickCount
Label1.Caption = Label1.Caption & "LeandroA modificada = " & t2 - t1 & Chr(13) _
& c & " números odiosos encontrados" & Chr(13) & Chr(13)
'Cobein
c = 0
t1 = GetTickCount
For i = 1 To Val(Text1)
If IsOdiousNumberCob(i) Then
c = c + 1
End If
Next
t2 = GetTickCount
Label1.Caption = Label1.Caption & "Cobein = " & t2 - t1 & Chr(13) _
& c & " números odiosos encontrados" & Chr(13) & Chr(13)
'Cobein con Karcrack
c = 0
t1 = GetTickCount
For i = 1 To Val(Text1)
If IsOdiousNumberCobKar(i) Then
c = c + 1
End If
Next
t2 = GetTickCount
Label1.Caption = Label1.Caption & "Híbrido Cobein-Karcrack = " & t2 - t1 & Chr(13) _
& c & " números odiosos encontrados" & Chr(13) & Chr(13)
'Tokes
c = 0
t1 = GetTickCount
For i = 1 To Val(Text1)
If esOdioso3(i) Then
c = c + 1
End If
Next
t2 = GetTickCount
Label1.Caption = Label1.Caption & "Tokes = " & t2 - t1 & Chr(13) _
& c & " números odiosos encontrados" & Chr(13) & Chr(13)
'Híbrido de Tokes con LeandroA
c = 0
t1 = GetTickCount
For i = 1 To Val(Text1)
If esOdiosoTokLean(i) Then
c = c + 1
End If
Next
t2 = GetTickCount
Label1.Caption = Label1.Caption & "Híbrido LeandroA-Tokes = " & t2 - t1 & Chr(13) _
& c & " números odiosos encontrados" & Chr(13) & Chr(13)
End Sub
Private Sub Form_Load()
Label1.Caption = ""
Text1 = ""
End Sub
De verdad tienen que verlo. Según mis pruebas, los códigos más rápidos son los híbridos Cobein-Karcrack y LeandroA-Tokes, cuando antes de eso pensábamos que ya no se podría más rápido. Dos cabezas piensan mejor que una.
Saludos.
Si, estuve comprobando y Cobein+Karcrack solo se va un par de milisegundos de LeandroA( aka Gilad (http://www.xbeat.net/vbspeed/c_LongToBit.htm#LongToBit10) >:D :xD)+Tokes
Ya tenemos vencedores :P !! (?)
Cita de: Karcrack en 17 Agosto 2010, 03:06 AM
Si, estuve comprobando y Cobein+Karcrack solo se va un par de milisegundos de LeandroA( aka Gilad (http://www.xbeat.net/vbspeed/c_LongToBit.htm#LongToBit10) >:D :xD)+Tokes
Ya tenemos vencedores :P !! (?)
Cita de: LeandroA en 16 Agosto 2010, 06:46 AM
yo pongo esta pero me siento un ladron (http://www.xbeat.net/vbspeed/c_LongToBit.htm) >:(
jajaja y si yo lo dije, de todas formas esOdiosoTokLean se lleva la copa jejej
Cita de: LeandroA en 17 Agosto 2010, 05:49 AM
jajaja y si yo lo dije, de todas formas esOdiosoTokLean se lleva la copa jejej
Querras decir que se la lleva el equipo
CobKar! :laugh: :laugh:
En realidad la copa nos la llevamos todos. Creo que demostramos que el trabajo en equipo es mejor.
¡¡Buen día!!
Otra forma chachi de hacerlo :)
Public Function IsOdiousNumber02(ByVal lLng As Long) As Boolean
IsOdiousNumber02 = (((lLng + ((lLng And &HFFFFFFF0) \ &H10&)) And &HF0F0F0F) And 1)
End Function
No es mas rapida que la que puse, pero es interesante ver como trabaja ;)