| 
	
		|  Autor | Tema: [RETO] Comprobar si un numero es odioso  (Leído 12,897 veces) |  
	| 
			| 
					
						| Karcrack 
								       
								
								 Desconectado 
								Mensajes: 2.416
								
								 
								Se siente observado ¬¬'
								
								
								
								
								
								   | 
 
La verdad es que me hace gracia ver los nombres que les ponen a los tipos de numeros       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.htmlhttp://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!  
 
 |  
						| 
								|  |  
								|  |  En línea | 
 
 |  |  |  | 
			| 
					
						| Karcrack 
								       
								
								 Desconectado 
								Mensajes: 2.416
								
								 
								Se siente observado ¬¬'
								
								
								
								
								
								   | 
 
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   Todo el mundo a pensar en 0s y 1s!!  
 
 |  
						| 
								|  |  
								|  |  En línea | 
 
 |  |  |  | 
			| 
					
						| LeandroA | 
 
yo pongo esta pero me siento un ladron  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 <> 0End Function 
 |  
						| 
								|  |  
								|  |  En línea | 
 
 |  |  |  | 
			| 
					
						| BlackZeroX 
								Wiki  Desconectado 
								Mensajes: 3.158
								
								 
								I'Love...!¡.
								
								
								
								
								
								     | 
 
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!¡. |  
						| 
								|  |  
								|  |  En línea | 
 
 The Dark Shadow is my passion. |  |  |  | 
			| 
					
						| cobein | 
 
Private Function IsOdiousNumber(ByVal lVal As Long) As BooleanDo
 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
 |  
						| 
								|  |  
								|  |  En línea | 
 
 |  |  |  | 
			| 
					
						| Karcrack 
								       
								
								 Desconectado 
								Mensajes: 2.416
								
								 
								Se siente observado ¬¬'
								
								
								
								
								
								   | 
 
Mi codigo, lo comento para que quien no entienda de Bits le quede mas claro   : Private Function IsItOdious(ByVal lNumb As Long) As BooleanDim 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: Resultados:Private Function IsOdiousNumberX(ByVal lVal As Long) As BooleanIf 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
Karcrack:49,668 msec
 Cobein:
 14,426 msec
 LeandroA:
 8,991 msec
 Cobein (Mod Karcrack):
 12,547 msec
 |  
						| 
								|  |  
								|  |  En línea | 
 
 |  |  |  | 
			| 
					
						| cobein | 
 
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.
 |  
						| 
								|  |  
								|  |  En línea | 
 
 |  |  |  | 
			| 
					
						| Tokes 
								
								 Desconectado 
								Mensajes: 140
								
								
								
								
								
								   | 
 
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. |  
						| 
								|  |  
								|  |  En línea | 
 
 |  |  |  | 
			| 
					
						| cobein | 
 
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
 |  
						| 
								|  |  
								|  |  En línea | 
 
 |  |  |  | 
			| 
					
						| Tokes 
								
								 Desconectado 
								Mensajes: 140
								
								
								
								
								
								   | 
 
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. |  
						| 
								|  |  
								|  |  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 | 8,055 |  15 Diciembre 2010, 09:04 am por Kropt32
 |  
						|   |   | [JSTL] Como comprobar si una variable es un numero en JSTL Desarrollo Web
 | nhaalclkiemr | 0 | 4,841 |  10 Abril 2011, 20:42 pm por nhaalclkiemr
 |  
						|   |   | [RETO] Determinar Número Perfecto
							« 1 2 3 » Programación Visual Basic
 | Miseryk | 20 | 10,239 |  8 Noviembre 2013, 02:24 am por rob1104
 |  
						|   |   | comprobar numero repetido en un vector Programación C/C++
 | MessageBoxA | 4 | 3,838 |  26 Junio 2014, 02:05 am por MeCraniDOS
 |  
						|   |   | numero odioso NUEVO! Programación C/C++
 | marsicobetre | 3 | 6,554 |  23 Octubre 2015, 13:13 pm por do-while
 |    |