Pequeño reto

[pkj]

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

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

Código (vb) [Seleccionar] Expandir


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?

[pkj]

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

Código (vb) [Seleccionar] Expandir


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

Saludos

[pkj]

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

[BlackZeroX]

Lo que hace es contar los bits encendidos de la diferencia de los bits de dos valores.

Código (vb) [Seleccionar] Expandir


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

[pkj]

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

Código (vb) [Seleccionar] Expandir


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

[BlackZeroX]

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

[pkj]

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
Trabajais con cosas que nunca he visto o que no entiendo y me hago un lio.

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
De todos modos, al menos lo voy a pensar. Igual salta la liebre.

Saludos

[pkj]

Algo debo estar haciendo mal, porque mi nombre no aparece en la lista de errores  

Código (vb) [Seleccionar] Expandir

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
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é:

Código (vb) [Seleccionar] Expandir

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

[BlackZeroX]

Como demonio borro mi msg ...

Dulces Lunas!¡.

[79137913]

HOLA!!!

XD estaban hablando de mi y mi reto...

Black lo gano bien ganado no hay mucho que hacer ni mucho que inventar XD 

GRACIAS POR LEER!!!