[RETO] Comprobar si un numero es odioso

[Tokes]

Aquí les dejo un código que hice. Ya no sé si sea más rápido o no, siempre me da resultados diferentes.

Código [Seleccionar] Expandir

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.

[Karcrack]

@Cobein Muy interesante lo de meterlo todo en un byte Me he tomado la libertad de mejorarlo :

Código [Seleccionar] Expandir

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

[Tokes]

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

Código [Seleccionar] Expandir

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.

[Karcrack]

Si, estuve comprobando y Cobein+Karcrack solo se va un par de milisegundos de LeandroA( aka Gilad )+Tokes

Ya tenemos vencedores !! (?)

[LeandroA]

Si, estuve comprobando y Cobein+Karcrack solo se va un par de milisegundos de LeandroA( aka Gilad )+Tokes

Ya tenemos vencedores !! (?)

yo pongo esta pero me siento un ladron 

jajaja y si yo lo dije, de todas formas esOdiosoTokLean se lleva la copa jejej

[Karcrack]

jajaja y si yo lo dije, de todas formas esOdiosoTokLean se lleva la copa jejej

Querras decir que se la lleva el equipo CobKar!

[Tokes]

En realidad la copa nos la llevamos todos. Creo que demostramos que el trabajo en equipo es mejor.

             ¡¡Buen día!!

[Karcrack]

Otra forma chachi de hacerlo

Código (vb) [Seleccionar] Expandir

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