2015 y los números con factorización capicúa

PorJosé A. Alonso 1-enero-20151-mayo-2016

Un número tiene factorización capicúa si puede escribir como un producto de números primos tal que la concatenación de sus dígitos forma un número capicúa. Por ejemplo, el 2015 tiene factorización capicúa ya que 2015 = 13·5·31, los factores son primos y su concatenación es 13531 que es capicúa.

Definir la sucesión

   conFactorizacionesCapicuas :: [Int]

1	conFactorizacionesCapicuas :: [Int]

formada por los números que tienen factorización capicúa. Por ejemplo,

   ghci> take 20 conFactorizacionesCapicuas
   [1,2,3,4,5,7,8,9,11,12,16,18,20,25,27,28,32,36,39,44]

1 2	ghci> take 20 conFactorizacionesCapicuas [1,2,3,4,5,7,8,9,11,12,16,18,20,25,27,28,32,36,39,44]

Usando conFactorizacionesCapicuas escribir expresiones cuyos valores sean las respuestas a las siguientes preguntas y calcularlas

¿Qué lugar ocupa el 2015 en la sucesión?
¿Cuál fue el anterior año con factorización capicúa?
¿Cuál será el siguiente año con factorización capicúa?

Soluciones

import Data.List (permutations)

conFactorizacionesCapicuas :: [Int]
conFactorizacionesCapicuas =
    [n | n <- [1..], not (null (factorizacionesCapicua n))]

-- (factorizacionesCapicua n) es la lista de las factorizaciones
-- capicúas de n. Por ejemplo,
--    factorizacionesCapicua 2015  ==  [[13,5,31],[31,5,13]]
factorizacionesCapicua :: Int -> [[Int]]
factorizacionesCapicua n =
    [xs | xs <- permutations (factorizacion n),
          esCapicuaConcatenacion xs]

-- (factorizacion n) es la lista de todos los factores primos de n; es
-- decir, es una lista de números primos cuyo producto es n. Por ejemplo,
--    factorizacion 300  ==  [2,2,3,5,5]
factorizacion :: Int -> [Int]
factorizacion n | n == 1    = []
                | otherwise = x : factorizacion (div n x)
    where x = menorFactor n

-- (menorFactor n) es el menor factor primo de n. Por ejemplo,
--    menorFactor 15  ==  3
--    menorFactor 16  ==  2
--    menorFactor 17  == 17
menorFactor :: Int -> Int
menorFactor n = head [x | x <- [2..], rem n x == 0]

-- (esCapicuaConcatenacion xs) se verifica si la concatenación de los
-- números de xs es capicúa. Por ejemplo,
--    esCapicuaConcatenacion [13,5,31]   ==  True
--    esCapicuaConcatenacion [135,31]    ==  True
--    esCapicuaConcatenacion [135,21]    ==  False
esCapicuaConcatenacion :: [Int] -> Bool
esCapicuaConcatenacion xs = ys == reverse ys
    where ys = concat (map show xs)

-- El cálculo de la 1ª respuesta es
--    ghci> length (takeWhile (<= 2015) conFactorizacionesCapicuas)
--    265

-- El cálculo de la 2ª respuesta es
--    ghci> last (takeWhile (<2015) conFactorizacionesCapicuas)
--    2001

-- El cálculo de la 3ª respuesta es
--    ghci> head (dropWhile (<=2015) conFactorizacionesCapicuas)
--    2023

import Data.List (permutations)

conFactorizacionesCapicuas :: [Int]

conFactorizacionesCapicuas =

[n | n <- [1..], not (null (factorizacionesCapicua n))]

-- (factorizacionesCapicua n) es la lista de las factorizaciones

-- capicúas de n. Por ejemplo,

-- factorizacionesCapicua 2015 == [[13,5,31],[31,5,13]]

factorizacionesCapicua :: Int -> [[Int]]

factorizacionesCapicua n =

[xs | xs <- permutations (factorizacion n),

esCapicuaConcatenacion xs]

-- (factorizacion n) es la lista de todos los factores primos de n; es

-- decir, es una lista de números primos cuyo producto es n. Por ejemplo,

-- factorizacion 300 == [2,2,3,5,5]

factorizacion :: Int -> [Int]

factorizacion n | n == 1 = []

| otherwise = x : factorizacion (div n x)

where x = menorFactor n

-- (menorFactor n) es el menor factor primo de n. Por ejemplo,

-- menorFactor 15 == 3

-- menorFactor 16 == 2

-- menorFactor 17 == 17

menorFactor :: Int -> Int

menorFactor n = head [x | x <- [2..], rem n x == 0]

-- (esCapicuaConcatenacion xs) se verifica si la concatenación de los

-- números de xs es capicúa. Por ejemplo,

-- esCapicuaConcatenacion [13,5,31] == True

-- esCapicuaConcatenacion [135,31] == True

-- esCapicuaConcatenacion [135,21] == False

esCapicuaConcatenacion :: [Int] -> Bool

esCapicuaConcatenacion xs = ys == reverse ys

where ys = concat (map show xs)

-- El cálculo de la 1ª respuesta es

-- ghci> length (takeWhile (<= 2015) conFactorizacionesCapicuas)

-- 265

-- El cálculo de la 2ª respuesta es

-- ghci> last (takeWhile (<2015) conFactorizacionesCapicuas)

-- 2001

-- El cálculo de la 3ª respuesta es

-- ghci> head (dropWhile (<=2015) conFactorizacionesCapicuas)

-- 2023

2 Comentarios

conFactorizacionesCapicuas :: [Int]
conFactorizacionesCapicuas = [n | n <- [1..], listaCapicua n]

listaCapicua :: Int -> Bool
listaCapicua n = 
    not (null [xs | xs <- digitosLista2 n, xs == reverse xs])

digitosLista2 :: Int -> [[Int]]
digitosLista2 n = digitosLista (listaPermutaciones n)

listaPermutaciones :: Int -> [[Int]]
listaPermutaciones n = [xs | xs <- permutaciones (descomposicion2 n)]

descomposicion2 :: Int -> [Int]
descomposicion2 n = descomposicion n [x | x <- listaPrimos, x <= n]

listaPrimos :: [Int]
listaPrimos = [x | x <- [1..], primos x]

primos :: Int -> Bool
primos n = factores n == [1,n]

factores :: Int -> [Int]
factores n = [x | x <- [1..n], rem n x == 0]

descomposicion :: Int -> [Int] -> [Int]
descomposicion 1 _ = []
descomposicion n (x:xs) 
    | rem n x == 0 = [x] ++  descomposicion (div n x) (x:xs)
    | otherwise    = descomposicion n xs

permutaciones :: [a] -> [[a]]
permutaciones [] = [[]] 
permutaciones (x:xs) = concat (map (intercala x) (permutaciones xs))

intercala :: a -> [a] -> [[a]]
intercala x [] = [[x]]
intercala x (y:ys) = (x:y:ys) : map (y:) (intercala x ys)

digitosLista :: [[Int]] -> [[Int]]
digitosLista []       = []
digitosLista (xs:xss) = [concat [digitos x | x <- xs]] ++ digitosLista xss

digitos :: Int -> [Int]
digitos n = [read [x]|x<- show n]


-- 2015 ocupa la posicion 265 --
-- take 265 conFactorizacionesCapicuas
-- [1,2,3,4,5,7,8,9,11,12,16,18,20,25,27,28,32,36,39,44,45,46,48,49,50,58,63,64,
--  69,72,75,80,81,93,98,99,100,101,108,111,112,119,121,125,128,129,131,138,144,
--  147,151,156,159,162,175,176,180,181,184,191,192,196,200,219,225,232,242,243,
--  245,249,252,256,259,265,275,276,288,295,300,313,320,324,329,339,343,351,353,
--  363,372,373,383,392,396,400,403,404,405,414,422,429,432,441,444,448,450,466,
--  469,476,484,497,500,507,511,512,516,522,524,539,552,553,554,567,576,588,598,
--  604,605,621,624,625,636,648,663,669,675,679,690,700,704,720,724,727,729,736,
--  741,757,764,768,777,784,787,795,797,800,806,837,847,876,882,891,892,900,908,
--  909,916,919,928,929,933,966,968,972,975,980,996,999,1008,1023,1024,1036,
--  1058,1060,1071,1089,1100,1102,1104,1125,1150,1152,1161,1179,1180,1200,1207,
--  1209,1225,1242,1243,1250,1252,1280,1296,1309,1316,1323,1329,1331,1338,1356,
--  1359,1372,1398,1404,1412,1431,1434,1450,1452,1458,1488,1492,1518,1521,1532,
--  1533,1547,1554,1568,1575,1584,1587,1589,1590,1600,1612,1616,1620,1629,1656,
--  1682,1688,1703,1716,1719,1725,1728,1764,1776,1778,1792,1800,1864,1875,1876,
--  1887,1904,1911,1936,1971,1978,1988,2000,2001,2015]

-- El año anterior al 2015 en cumplir la propiedad es el 2001 

-- El año siguiente al 2015 en cumplir la propiedad es el 2023 
-- take 266 conFactorizacionesCapicuas
-- [1,2,3,4,5,7,8,9,11,12,16,18,20,25,27,28,32,36,39,44,45,46,48,49,50,58,63,64,
--  69,72,75,80,81,93,98,99,100,101,108,111,112,119,121,125,128,129,131,138,144,
--  147,151,156,159,162,175,176,180,181,184,191,192,196,200,219,225,232,242,243,
--  245,249,252,256,259,265,275,276,288,295,300,313,320,324,329,339,343,351,353,
--  363,372,373,383,392,396,400,403,404,405,414,422,429,432,441,444,448,450,466,
--  469,476,484,497,500,507,511,512,516,522,524,539,552,553,554,567,576,588,598,
--  604,605,621,624,625,636,648,663,669,675,679,690,700,704,720,724,727,729,736,
--  741,757,764,768,777,784,787,795,797,800,806,837,847,876,882,891,892,900,908,
--  909,916,919,928,929,933,966,968,972,975,980,996,999,1008,1023,1024,1036,
--  1058,1060,1071,1089,1100,1102,1104,1125,1150,1152,1161,1179,1180,1200,1207,
--  1209,1225,1242,1243,1250,1252,1280,1296,1309,1316,1323,1329,1331,1338,1356,
--  1359,1372,1398,1404,1412,1431,1434,1450,1452,1458,1488,1492,1518,1521,1532,
--  1533,1547,1554,1568,1575,1584,1587,1589,1590,1600,1612,1616,1620,1629,1656,
--  1682,1688,1703,1716,1719,1725,1728,1764,1776,1778,1792,1800,1864,1875,1876,
--  1887,1904,1911,1936,1971,1978,1988,2000,2001,2015,2023]

conFactorizacionesCapicuas :: [Int]

conFactorizacionesCapicuas = [n | n <- [1..], listaCapicua n]

listaCapicua :: Int -> Bool

listaCapicua n =

not (null [xs | xs <- digitosLista2 n, xs == reverse xs])

digitosLista2 :: Int -> [[Int]]

digitosLista2 n = digitosLista (listaPermutaciones n)

listaPermutaciones :: Int -> [[Int]]

listaPermutaciones n = [xs | xs <- permutaciones (descomposicion2 n)]

descomposicion2 :: Int -> [Int]

descomposicion2 n = descomposicion n [x | x <- listaPrimos, x <= n]

listaPrimos :: [Int]

listaPrimos = [x | x <- [1..], primos x]

primos :: Int -> Bool

primos n = factores n == [1,n]

factores :: Int -> [Int]

factores n = [x | x <- [1..n], rem n x == 0]

descomposicion :: Int -> [Int] -> [Int]

descomposicion 1 _ = []

descomposicion n (x:xs)

| rem n x == 0 = [x] ++ descomposicion (div n x) (x:xs)

| otherwise = descomposicion n xs

permutaciones :: [a] -> [[a]]

permutaciones [] = [[]]

permutaciones (x:xs) = concat (map (intercala x) (permutaciones xs))

intercala :: a -> [a] -> [[a]]

intercala x [] = [[x]]

intercala x (y:ys) = (x:y:ys) : map (y:) (intercala x ys)

digitosLista :: [[Int]] -> [[Int]]

digitosLista [] = []

digitosLista (xs:xss) = [concat [digitos x | x <- xs]] ++ digitosLista xss

digitos :: Int -> [Int]

digitos n = [read [x]|x<- show n]

-- 2015 ocupa la posicion 265 --

-- take 265 conFactorizacionesCapicuas

-- [1,2,3,4,5,7,8,9,11,12,16,18,20,25,27,28,32,36,39,44,45,46,48,49,50,58,63,64,

-- 69,72,75,80,81,93,98,99,100,101,108,111,112,119,121,125,128,129,131,138,144,

-- 147,151,156,159,162,175,176,180,181,184,191,192,196,200,219,225,232,242,243,

-- 245,249,252,256,259,265,275,276,288,295,300,313,320,324,329,339,343,351,353,

-- 363,372,373,383,392,396,400,403,404,405,414,422,429,432,441,444,448,450,466,

-- 469,476,484,497,500,507,511,512,516,522,524,539,552,553,554,567,576,588,598,

-- 604,605,621,624,625,636,648,663,669,675,679,690,700,704,720,724,727,729,736,

-- 741,757,764,768,777,784,787,795,797,800,806,837,847,876,882,891,892,900,908,

-- 909,916,919,928,929,933,966,968,972,975,980,996,999,1008,1023,1024,1036,

-- 1058,1060,1071,1089,1100,1102,1104,1125,1150,1152,1161,1179,1180,1200,1207,

-- 1209,1225,1242,1243,1250,1252,1280,1296,1309,1316,1323,1329,1331,1338,1356,

-- 1359,1372,1398,1404,1412,1431,1434,1450,1452,1458,1488,1492,1518,1521,1532,

-- 1533,1547,1554,1568,1575,1584,1587,1589,1590,1600,1612,1616,1620,1629,1656,

-- 1682,1688,1703,1716,1719,1725,1728,1764,1776,1778,1792,1800,1864,1875,1876,

-- 1887,1904,1911,1936,1971,1978,1988,2000,2001,2015]

-- El año anterior al 2015 en cumplir la propiedad es el 2001

-- El año siguiente al 2015 en cumplir la propiedad es el 2023

-- take 266 conFactorizacionesCapicuas