elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Arreglado, de nuevo, el registro del warzone (wargame) de EHN


  Mostrar Mensajes
Páginas: 1 2 3 4 5 6 7 8 9 10 11 12 [13] 14 15
121  Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero es Oblongo/Pronico en: 17 Agosto 2010, 20:28 pm
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.
122  Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero es Oblongo/Pronico en: 17 Agosto 2010, 19:44 pm
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.

Código:
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.
123  Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero es Oblongo/Pronico en: 17 Agosto 2010, 19:07 pm
Hola a todos. No proclamen un ganador sin primero ver esto.

Código:
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.
124  Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero es odioso en: 17 Agosto 2010, 17:53 pm
En realidad la copa nos la llevamos todos. Creo que demostramos que el trabajo en equipo es mejor.

             ¡¡Buen día!!
125  Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero es Oblongo/Pronico en: 17 Agosto 2010, 17:51 pm
raul338 tiene toda la razón del universo.

                   Saludos...
126  Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero es Oblongo/Pronico en: 17 Agosto 2010, 03:24 am
Aquí dejo mi código.

Código:
'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
127  Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero es odioso en: 17 Agosto 2010, 02:40 am
¡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:
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.
128  Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero es odioso en: 17 Agosto 2010, 00:26 am
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:
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.
129  Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero es odioso en: 17 Agosto 2010, 00:17 am
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.

Código:
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.
130  Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero es odioso en: 16 Agosto 2010, 19:45 pm
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).

Código:
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.
Páginas: 1 2 3 4 5 6 7 8 9 10 11 12 [13] 14 15
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines