[RETO] Project Euler 4

Iniciado por Psyke1, 2 Febrero 2013, 17:22 PM

0 Miembros y 1 Visitante están viendo este tema.

Psyke1

Un número palíndromo es aquel que se lee igual si lo damos la vuelta, ejemplos:
98789
121
345543


El palíndromo más grande de la multiplicación de dos números de dos cifras es:
9009 = 91 X 99

¿Cuál sería el palíndromo más grande de la multiplicación de dos números de TRES cifras?




Normas del reto:

1.-NO es válido precargar valores.

2.-Estructura de la función:
Código (vb) [Seleccionar]
Public Function PE4_Psyke1(Optional Byval lCifras As Long = 3) As Double

3.-La función debe de ser válida para todas las cifras que se le pasen por el argumento.

4.-El resultado correcto es:
906609

Reto original:

http://projecteuler.net/problem=4


DoEvents! :P

Karcrack

Para los que se quejan de que para ganar hay que ir a la universidad:
Un número resultado de una multiplicación de 3 cifras tendrá como máximo 6 cifras. Teniendo en cuenta que debe ser palíndromo serían 3 cifras diferentes:
N = 100000x + 10000y + 1000z + 100z + 10y + x
Si simplificamos la igualdad:
N = 100001x + 10010y + 1100z
N = 11*(9091x + 910y + 100z)


Así pues uno de los factores debe ser múltiplo de 11 ;)

Psyke1

#2
Tengo problemas de Overflow:-\

Mirad lo que hago:

Código (vb) [Seleccionar]
Option Explicit

Private Sub Form_Load()
Dim B As Double
   
   B = 998001 '999 * 999
   B = 999 * 999
End Sub


Me dice Overflow en la multiplicación, pero la variable B puede almacenar el resultado. :huh:

@karcrack: brillante deducción. ;)

DoEvents! :P

LeandroA

es porque vb lo declara como un integer

    MsgBox VarType(999)
    MsgBox vbInteger
    B = 999# * 999#

BlackZeroX

#4
El domingo que vuelva lo mejoro nos vemos.


 9009          91            99
906609        913           993
91800819      9181          9999
9028118209    91001         99209
903231132309                910129        992421
90189288298109              9100009       9910901


Aquí se las dejo:
Código (vb) [Seleccionar]

Option Explicit

Private Sub Form_Load()
   ' Es exponencialmente lento  el calculo.
   MsgBox PE4_BlackZeroX(2)
   MsgBox PE4_BlackZeroX(3)
   MsgBox PE4_BlackZeroX(4)
   MsgBox PE4_BlackZeroX(5)
   MsgBox PE4_BlackZeroX(6)
   MsgBox PE4_BlackZeroX(7) '--> Desde aqui se vuelve muy lento...
   MsgBox PE4_BlackZeroX(8)
   MsgBox PE4_BlackZeroX(9)
   MsgBox PE4_BlackZeroX(10)
   MsgBox PE4_BlackZeroX(11)
End Sub

Public Function PE4_BlackZeroX(Optional ByVal bCifras As Byte = 3) As Double
Dim Value       As Double
Dim Low         As Long
Dim High        As Long
Dim LowLimit    As Long
Dim HighLimit   As Long
Dim i           As Double
Dim j           As Double

   If (bCifras < 2) Then Exit Function

   'Sabiendo que 91 * 99 = 9009 de igual manera sabiendo que solo agregar 2 numeros X (suponiendo 0)
   'en el centro, pero en sus laterales siempre habra 9 es de esperar que la multiplicación:
   '10 * (91 * 99) se acerque a 900009 pero JAMAS será esacta, aun que estos Dos numeros se acercan
   'a los dos numeros que multiplicados dan un numero Palindromo...

   Low = 91 * 10 ^ (bCifras - 2)
   LowLimit = Low + 10 ^ (bCifras - 2)
   High = 99 * 10 ^ (bCifras - 2)
   HighLimit = High + 10 ^ (bCifras - 2) - 1

   For i = Low To LowLimit
       For j = High To HighLimit
           Value = (i * j)
           If (isValid(Value, bCifras * 2)) Then
               PE4_BlackZeroX = Value
               Exit Function
           End If
       Next
   Next

   PE4_BlackZeroX = -1

End Function

Public Function isValid(ByVal Natural As Double, ByVal lenght As Long) As Boolean
Dim High        As Long
Dim Low         As Long
Dim Fraction    As Double
Dim Pow         As Double

   Pow = (10 ^ (lenght - 1))

   Do While (Natural > 0) And (Pow > 0)
       High = Fix(Natural / Pow)
       Fraction = Natural / &HA&
       Natural = Fix(Fraction)
       Low = (Fraction - Natural) * &HA&

       If Not (Low = High) Then
           isValid = False
           Exit Function
       End If
       Pow = (Pow / &HA&)
       Natural = Natural - (High * Pow)
       Pow = (Pow / &HA&)
   Loop

   isValid = True

End Function


Dulces Lunas!¡.
The Dark Shadow is my passion.

Psyke1

#5
Black, tu algoritmo está incompleto. Tu sacas el primer palíndromo que encuentra. Pero debe de ser el mayor posible.

PD: Mi ordenador echa humo de 6 en adelante. :xD

DoEvents! :P

DarkMatrix

#6
Bueno, a partir de 9 cifras se hace un poco lento el calculo asi que solo calcule hasta 8 cifras, aqui mi codigo:

Código (vb) [Seleccionar]
Public Function PE4_Dark(Optional ByVal lCifras As Long = 3) As Double
   
   Dim A   As Double
   Dim B   As Double
   Dim Min As Double
   Dim Max As Double
   Dim Tmp As Double

   If lCifras < 2 Then Exit Function
   
   Min = 10 * (10 ^ (lCifras - 2)) * 9
   Max = 10 * (10 ^ (lCifras - 1)) - 1

   For A = Max To Min Step -2
       
       For B = Max To Min Step -2

           Tmp = A * B
           
           If Tmp = InvNumber(Tmp) Then
               
               PE4_Dark = Tmp
               
               Exit Function
               
           End If

       Next B

   Next A
   
End Function

Public Function InvNumber(ByVal Number As Double) As Double

   Dim A As Double
   Dim C As Integer
   
   While Number > 0
       
       A = (Number / 10)
       
       Number = Int(A)
       
       C = (A - Number) * 10
       
       InvNumber = (InvNumber * 10) + C
       
   Wend
   
End Function


Salidas:

PE4_Dark(2) = ( 99 x 91 ) = 9.009
PE4_Dark(3) = ( 993 x 913 ) = 906.609
PE4_Dark(4) = ( 9999 x 9901 ) = 99.000.099
PE4_Dark(5) = ( 99979 x 99681 ) = 9.966.006.699
PE4_Dark(6) = ( 999999 x 999001 ) = 999.000.000.999
PE4_Dark(7) = ( 9999979 x 9467731 ) = 94.677.111.177.649
PE4_Dark(8) = ( 99999999 x 90063991 ) = 9.006.399.009.936.009

Todo aquello que no se puede hacer, es lo que no intentamos hacer.
Projecto Ani-Dimension Digital Duel Masters (Juego de cartas masivo multijugador online hecho en Visual Basic 6.0)

Desing by DarkMatrix

Elemental Code

#7
vamos a participar...
Contame, se le pueden pasar valores erroneos a la funcion...
Digamos un numero negativo?




RUSTIC MODE OOOOOOOOON!

Código (vb) [Seleccionar]
Public Function PE4_eCode(Optional ByVal lCifras As Long = 3) As Double
    Dim Nueves As Double
    Dim Factor As Double
    Dim i As Double
    Dim y As Double
    If lCifras < 1 Then Exit Function 'anti negativos.
    Nueves = 10 * (10 ^ (lCifras - 1)) - 1
    Factor = 9 * (10 ^ (lCifras - 1))
    PE4_eCode = Nueves * Factor
   
    For i = Nueves To 1 Step -2
        If i Mod 11 = 0 Then 'Karcrack logic :D
        For y = Nueves To Factor Step -2
            PE4_eCode = i * y
            If PE4_eCode = StrReverse(PE4_eCode) Then Exit Function
        Next
        End If
    Next
End Function


Se parece a la de DarkMatrix pero aplica la Karcrack Logic :)

I CODE FOR $$$
Programo por $$$
Hago tareas, trabajos para la facultad, lo que sea en VB6.0

Mis programas

Karcrack

#8
@DarkMatrix,@Elemental Code no funcionará vuestro código al dar la vuelta al número. eCode al pasarlo a Str el EXX que se genera con números grandes explota. DarkMatrix tienes que hacer Fix() para que funcione correctamente el código.


Aquí mi aproximación:
Código (vb) [Seleccionar]
Public Static Function PE4_Karcrack(Optional ByVal lCifras As Long = 3) As Double
   Dim A   As Double
   Dim B   As Long
   Dim C   As Long
   Dim D   As Long
   Dim M   As Long
   Dim R   As Double
   
   B = (10 ^ lCifras) - 1
   M = (10 ^ (lCifras - 1))
   
   Do Until (M Mod 11) = 0
       M = M + 1
   Loop
   
   D = B
   
   Do Until (D Mod 11) = 0
       D = D - 1
   Loop
   
   For A = D To M Step -11
       For C = B To A * 0.8 Step -1
           R = (A * C)
           If R <= PE4_Karcrack Then Exit For
           If R = NReverse(R) Then
               PE4_Karcrack = R
           End If
       Next C
   Next A
End Function


Public Static Function NReverse(ByVal D As Double) As Double
   Dim dig As Long
   While D > 0
       dig = (D - Fix(D / 10#) * 10)
       NReverse = NReverse * 10 + dig
       D = Fix(D / 10)
   Wend
End Function


Ejemplo:
Código (vb) [Seleccionar]
Private Sub Form_Load()
   Dim i   As Long
   
   For i = 2 To 5
       Debug.Print i, PE4_Karcrack(i)
   Next i
End Sub


Salida:

 2             9009
3             906609
4             99000099
5             9966006699
6             999000000999


Al parecer el NReverse() se queda en bucle infinito con 7 cifras :laugh:

BlackZeroX

Cita de: Psyke1 en  3 Febrero 2013, 02:39 AM
Black, tu algoritmo está incompleto. Tu sacas el primer palíndromo que encuentra. Pero debe de ser el mayor posible.

Por lo menos cumple para 3 cifras.

Dulces Lunas!¡.
The Dark Shadow is my passion.