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:
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
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 ;)
Tengo problemas de Overflow. :-\
Mirad lo que hago:
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
es porque vb lo declara como un integer
MsgBox VarType(999)
MsgBox vbInteger
B = 999# * 999#
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:
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!¡.
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
Bueno, a partir de 9 cifras se hace un poco lento el calculo asi que solo calcule hasta 8 cifras, aqui mi codigo:
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
vamos a participar...
Contame, se le pueden pasar valores erroneos a la funcion...
Digamos un numero negativo?
RUSTIC MODE OOOOOOOOON!
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 :)
@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:
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:
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:
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!¡.
Si es double por que da overflow ?¿?
bs imoen