Quiero proponeros una adivinanza y un reto:
Adivinanza: ¿Que hace esta función que he inventado?
Os dejo las variables con nombres descriptivos para que podais seguirla mejor.
Los mas iniciados seguro que lo adivinan en un vistazo y se ríen de mis métodos.
El caso es que a veces se me enciende la bombilla, pero parpadea mucho :P
Reto: Mejorar esta función. Fácil.
No es que tenga demasiado interés en que sea más rápida, aunque me gustaría ver el sistema que usaría alguien con conocimientos de matemáticas (o igual hay una API para esto :D). Yo en el colegio nunca presté atención :(
He pensado que son dos buenos retos.
Espero que os animéis muchos.
Si se me ocurre como, yo también la intentaré mejorar (bueno, mas rápido ya se me está ocurriendo: puedo quitar los xor si copio 2 veces el código... o quizás no).
Haced vuestras propias versiones una vez que sepais lo que hace.
Function DimeQueHago(ByVal Valor1 As Long, ByVal Valor2 As Long, Trits As Integer) As Long
Dim Acu As Integer
Dim Bloque As Long
Dim Bloque2 As Long
Valor1 = Valor1 + 1 ' yo lo uso sin
Valor2 = Valor2 + 1 ' estas 2 lineas
If Valor2 > Valor1 Then
Valor1 = Valor1 Xor Valor2
Valor2 = Valor1 Xor Valor2
Valor1 = Valor1 Xor Valor2
End If
Bloque = (3 ^ Trits) / 3
Do Until Bloque = 1
Bloque2 = Bloque * 2
If Valor1 > Bloque2 Then
Valor1 = Valor1 - Bloque2
If Valor2 > Bloque2 Then
Valor2 = Valor2 - Bloque2
Else
Acu = Acu + 1
If Valor2 > Bloque Then Valor2 = Valor2 - Bloque
End If
GoTo Sort
End If
If Valor1 > Bloque Then
Valor1 = Valor1 - Bloque
If Valor2 > Bloque Then
Valor2 = Valor2 - Bloque
Else
Acu = Acu + 1
End If
End If
Sort:
If Valor2 > Valor1 Then
Valor1 = Valor1 Xor Valor2
Valor2 = Valor1 Xor Valor2
Valor1 = Valor1 Xor Valor2
End If
Bloque = Bloque / 3
Loop
If Valor1 = Valor2 Then
Else
Acu = Acu + 1
End If
DimeQueHago = Acu
End Function
Lo dicho. Animaos y usad el coco un poco.
Saludos
EDIT:
¿que pasa?
¿no os interesa?
¿estáis deliberando?
¿me he pasado con el reto?
Igual no es tan fácil como pensé.
¿queréis que diga la solución?
¿queréis una pista?
Para los que quieran intentarlo, aquí os dejo una pista.
Esta es su hermanita pequeña. La otra me costó más sacarla (que borrico).
Function DimeQueHagoB(ByVal Valor1 As Long, ByVal Valor2 As Long, Bits As Integer) As Integer
Dim Valor3 As Long
Dim F As Integer
Valor3 = (Valor1 Xor Valor2)
For F = 0 To Bits - 1
If Valor3 And (2 ^ F) Then DimeQueHagoB = DimeQueHagoB + 1
Next F
End Function
Las dos las tengo ya mejoradas reemplazando las operaciones mas gordas por sus resultados.
Mas código pero más velocidad.
Espero que con esto al menos sepáis lo que son los Trits :D
Saludos
Vaya decepción. Parece que ni siquiera lo habéis intentado.
Lo explicaré brevemente para no haceros perder vuestro tiempo. Las hice para un programa de reducciones 1X2.
La segunda función, la pequeña, compara 2 números binarios a partir de sus equivalentes decimales y devuelve las diferencias. Compara 2 dobles a partir de sus números de orden.
La primera función, la grande, hace lo mismo pero con 2 valores que representan dos potencias de 3. Compara 2 triples.
Las dos se pueden mejorar mucho, pero no voy a entrar en detalles.
Saludos
Lo que hace es contar los bits encendidos de la diferencia de los bits de dos valores.
Function DimeQueHagoB(ByVal Valor1 As Long, ByVal Valor2 As Long, Bits As Byte) As Integer
Dim lV3 As Long
Dim iCount As Byte
lV3 = (Valor1 Xor Valor2)
if lV3 = 0 Then exit function
REM {
No recuerdo si es 32 o 64 dejo 32...
}
If (Bits > 32) Then Bits = 32
For iCount = 1 to Bits
REM {
No recuerdo si para dividir y tener un valor entero es \ o / :(
}
lV3 = lV3 \ 2
If (lV3 And &H1) Then
DimeQueHagoB = DimeQueHagoB + 1
Else If (lV3 = 0) Then
Exit Function
End If
Next iCount
End Function
P.D.: No tengo compilador :(.
Dulces Lunas!¡.
Buen trabajo, BlackZeroX, algo tarde pero muy bueno.
Solo he tenido que retocarla un pelín y es mucho mas rápida que la de muestra.
Parece incluso más rápida que la más rápida que he hecho yo :P
Function DimeQueHagoB(ByVal Valor1 As Long, ByVal Valor2 As Long, Bits As Byte) As Integer
Dim lV3 As Long
Dim iCount As Byte
lV3 = (Valor1 Xor Valor2)
If lV3 = 0 Then Exit Function
If (Bits > 32) Then Bits = 32
For iCount = 1 To Bits
If (lV3 And &H1) Then
DimeQueHagoB = DimeQueHagoB + 1
ElseIf (lV3 = 0) Then
Exit For
End If
lV3 = lV3 \ 2
Next iCount
End Function
En VB6 un Long tiene 32 bits, en VB.Net creo que son 64
¿Veis los demás como solo era ponerse?
Saludos
Cita de: pkj en 6 Julio 2015, 20:27 PM
¿Veis los demás como solo era ponerse?
Si gustas retos aquí tienes:
http://foro.elhacker.net/programacion_visual_basic/recopilacion_de_retos_vbclassic_por_79137913-t360748.0.html;msg1743290#msg1743290
Si puedes superar esta te ganas mi respeto :).
IsNumeric_????
Version VB6
http://foro.elhacker.net/programacion_visual_basic/reto_reemplazo_de_funcion_isnumeric-t336067.0.html;msg1652210#msg1652210
Version en C:
http://foro.elhacker.net/programacion_cc/cisnumeric_vb6_a_c-t336564.0.html;msg1652677#msg1652677
Dulces Lunas!¡.
Cita de: BlackZeroX (Astaroth) en 6 Julio 2015, 22:34 PM
Si gustas retos aquí tienes:
http://foro.elhacker.net/programacion_visual_basic/recopilacion_de_retos_vbclassic_por_79137913-t360748.0.html;msg1743290#msg1743290
Es lo que me animó a poner el reto.
Estuve mirando, e incluso he comentado algo, pero en general acabo mareado si intento descifrar los codigos :P
Trabajais con cosas que nunca he visto o que no entiendo y me hago un lio.
Cita de: BlackZeroX (Astaroth) en 6 Julio 2015, 22:34 PM
Si puedes superar esta te ganas mi respeto :).
He echado un vistazo y me parece que teneis el tema bien trillado. No creo que se me ocurra nada nuevo. Ni siquiera he usado nunca esa función IsNumeric :D
De todos modos, al menos lo voy a pensar. Igual salta la liebre.
Saludos
Algo debo estar haciendo mal, porque mi nombre no aparece en la lista de errores :o
Private Function IsNumeric_PKJ(Cadena As String) As Boolean
Dim Valor As Variant
On Error GoTo Error1
Valor = CDbl(Cadena)
IsNumeric_PKJ = True
Error1:
End Function
O eso o 7913+pkj = 1Genius
EDIT: No, ahora me estoy fijando que 7913 no necesita socios :D
Su nombre tampoco aparece en la lista de fallos.
EDIT2:
En realidad hemos pensado lo mismo pero al revés.
Supongo que parece que lo he copiado, pero ha sido pura casualidad.
Intentaré buscar otro modo, aunque ya digo que esto esta muy trillado.
EDIT3:
Lo siento. Solo se me ocurren variantes de lo mismo.
Si lo que quiero es saber si es un número no se me ocurre nada mejor que esto, y ya que funciona creo que me conformaré:
Private Function IsNumeric_PKJ(Cadena As String) As Boolean
On Error GoTo Error1
If CDbl(Cadena) = 0 Or CDbl(Cadena) <> 0 Then IsNumeric_PKJ = True
Error1:
End Function
Por cierto, pensaba que ninguna funcion superaba el test y resulta que hay varias que tampoco dan errores, solo que como no dan errores pasan desapercibidas y no lo habia notado. Por eso cuando me ha funcionado a la primera no me lo creia.
Copie la funcion de 7913 para evitarme escribir el encabezado y cuando vi que era parecida a lo que queria hacer, pense que habia mejorado esa funcion, cuando de por si ya funcionaba.
En fin, creo que darle mas vueltas es complicarse la vida.
Saludos
Como demonio borro mi msg ...
Dulces Lunas!¡.
HOLA!!!
XD estaban hablando de mi y mi reto...
Black lo gano bien ganado no hay mucho que hacer ni mucho que inventar XD :silbar:
GRACIAS POR LEER!!!