Comprensión – Página 17

Números libres de cuadrados

PorJosé A. Alonso 3-noviembre-201525-abril-2021

Un número es libre de cuadrados si no es divisible el cuadrado de ningún entero mayor que 1. Por ejemplo, 70 es libre de cuadrado porque sólo es divisible por 1, 2, 5, 7 y 70; en cambio, 40 no es libre de cuadrados porque es divisible por 2².

Definir la función

   libreDeCuadrados :: Integer -> Bool

1	libreDeCuadrados :: Integer -> Bool

tal que (libreDeCuadrados x) se verifica si x es libre de cuadrados. Por ejemplo,

   libreDeCuadrados 70                 ==  True
   libreDeCuadrados 40                 ==  False
   libreDeCuadrados 510510             ==  True
   libreDeCuadrados (((10^10)^10)^10)  ==  False

libreDeCuadrados 70 == True

libreDeCuadrados 40 == False

libreDeCuadrados 510510 == True

libreDeCuadrados (((10^10)^10)^10) == False

Soluciones

-- 1ª definición:
libreDeCuadrados :: Integer -> Bool
libreDeCuadrados x = x == product (divisoresPrimos x)

-- (divisoresPrimos x) es la lista de los divisores primos de x. Por
-- ejemplo,  
--    divisoresPrimos 40  ==  [2,5]
--    divisoresPrimos 70  ==  [2,5,7]
divisoresPrimos :: Integer -> [Integer]
divisoresPrimos x = [n | n <- divisores x, primo n]

-- (divisores n) es la lista de los divisores del número n. Por ejemplo,
--    divisores 30  ==  [1,2,3,5,6,10,15,30]  
divisores :: Integer -> [Integer]
divisores n = [x | x <- [1..n], n `mod` x == 0]

-- (primo n) se verifica si n es primo. Por ejemplo,
--    primo 30  == False
--    primo 31  == True  
primo :: Integer -> Bool
primo n = divisores n == [1, n]

-- 2ª definición
libreDeCuadrados2 :: Integer -> Bool
libreDeCuadrados2 n = 
    null [x | x <- [2..n], rem n (x^2) == 0]

-- 3ª definición
libreDeCuadrados3 :: Integer -> Bool
libreDeCuadrados3 n = 
    null [x | x <- [2..floor (sqrt (fromIntegral n))], 
              rem n (x^2) == 0]

-- Comparación de eficiencia
-- =========================

--    λ> libreDeCuadrados 510510
--    True
--    (0.76 secs, 89,522,360 bytes)
--    λ> libreDeCuadrados2 510510
--    True
--    (1.78 secs, 371,826,320 bytes)
--    λ> libreDeCuadrados3 510510
--    True
--    (0.01 secs, 0 bytes)

-- 1ª definición:

libreDeCuadrados :: Integer -> Bool

libreDeCuadrados x = x == product (divisoresPrimos x)

-- (divisoresPrimos x) es la lista de los divisores primos de x. Por

-- ejemplo,

-- divisoresPrimos 40 == [2,5]

-- divisoresPrimos 70 == [2,5,7]

divisoresPrimos :: Integer -> [Integer]

divisoresPrimos x = [n | n <- divisores x, primo n]

-- (divisores n) es la lista de los divisores del número n. Por ejemplo,

-- divisores 30 == [1,2,3,5,6,10,15,30]

divisores :: Integer -> [Integer]

divisores n = [x | x <- [1..n], n `mod` x == 0]

-- (primo n) se verifica si n es primo. Por ejemplo,

-- primo 30 == False

-- primo 31 == True

primo :: Integer -> Bool

primo n = divisores n == [1, n]

-- 2ª definición

libreDeCuadrados2 :: Integer -> Bool

libreDeCuadrados2 n =

null [x | x <- [2..n], rem n (x^2) == 0]

-- 3ª definición

libreDeCuadrados3 :: Integer -> Bool

libreDeCuadrados3 n =

null [x | x <- [2..floor (sqrt (fromIntegral n))],

rem n (x^2) == 0]

-- Comparación de eficiencia

-- =========================

-- λ> libreDeCuadrados 510510

-- True

-- (0.76 secs, 89,522,360 bytes)

-- λ> libreDeCuadrados2 510510

-- True

-- (1.78 secs, 371,826,320 bytes)

-- λ> libreDeCuadrados3 510510

-- True

-- (0.01 secs, 0 bytes)

Factoriales iguales a su número de dígitos

PorJosé A. Alonso 30-octubre-201520-noviembre-2015

Se dice que un número n tiene un factorial especial si el número de dígitos de n! es igual a n. Por ejemplo, 22 tiene factorial especial porque 22! es 1124000727777607680000 que tiene 22 dígitos.

Definir la función

   factorialesEspeciales :: [Integer]

1	factorialesEspeciales :: [Integer]

tal que su valor es la lista de los números que tienen factoriales especiales. Por ejemplo,

   take 2 factorialesEspeciales  ==  [1,22]

1	take 2 factorialesEspeciales == [1,22]

Nota: Si factorialesEspeciales es una lista finita, argumentar porqué no puede tener más elementos.

Soluciones

import Data.List (genericLength)

factorialesEspeciales :: [Integer]
factorialesEspeciales =
    [n | n <- [1..], tieneFactorialEspecial n]

tieneFactorialEspecial :: Integer -> Bool
tieneFactorialEspecial n = n == genericLength (show (factorial n))

factorial :: Integer -> Integer
factorial n = product [1..n]

-- El cálculo es
--    ghci> factorialesEspeciales
--    [1,22,23,24  C-c C-cInterrupted.

-- Para comprobar que no hay más definimos

crecimiento :: [(Integer,Integer)]
crecimiento = [(n,n - genericLength (show (factorial n))) | n <- [1..]]

-- Al evaluarla

--    ghci> take 30 crecimiento 
--    [(1,0),(2,1),(3,2),(4,2),(5,2),(6,3),(7,3),(8,3),(9,3),(10,3),(11,3),
--     (12,3),(13,3),(14,3),(15,2),(16,2),(17,2),(18,2),(19,1),(20,1),(21,1),
--     (22,0),(23,0),(24,0),(25,-1),(26,-1),(27,-2),(28,-2),(29,-2),(30,-3)]

-- se observa que, a partir de n = 25, el número de cifras del factorial
-- de n es mayor que n.

import Data.List (genericLength)

factorialesEspeciales :: [Integer]

factorialesEspeciales =

[n | n <- [1..], tieneFactorialEspecial n]

tieneFactorialEspecial :: Integer -> Bool

tieneFactorialEspecial n = n == genericLength (show (factorial n))

factorial :: Integer -> Integer

factorial n = product [1..n]

-- El cálculo es

-- ghci> factorialesEspeciales

-- [1,22,23,24 C-c C-cInterrupted.

-- Para comprobar que no hay más definimos

crecimiento :: [(Integer,Integer)]

crecimiento = [(n,n - genericLength (show (factorial n))) | n <- [1..]]

-- Al evaluarla

-- ghci> take 30 crecimiento

-- [(1,0),(2,1),(3,2),(4,2),(5,2),(6,3),(7,3),(8,3),(9,3),(10,3),(11,3),

-- (12,3),(13,3),(14,3),(15,2),(16,2),(17,2),(18,2),(19,1),(20,1),(21,1),

-- (22,0),(23,0),(24,0),(25,-1),(26,-1),(27,-2),(28,-2),(29,-2),(30,-3)]

-- se observa que, a partir de n = 25, el número de cifras del factorial

-- de n es mayor que n.

Mayor resto

PorJosé A. Alonso 26-octubre-20152-noviembre-2015

El resultado de dividir un número n por un divisor d es un cociente q y un resto r.

Definir la función

   mayorResto :: Int -> Int -> (Int,[Int])

1	mayorResto :: Int -> Int -> (Int,[Int])

tal que (mayorResto n d) es el par (m,xs) tal que m es el mayor resto de dividir n entre x (con 1 ≤ x < d) y xs es la lista de números x menores que d tales que el resto de n entre x es m. Por ejemplo,

   mayorResto 20 10  ==  (6,[7])
   mayorResto 50 8   ==  (2,[3,4,6])

1 2	mayorResto 20 10 == (6,[7]) mayorResto 50 8 == (2,[3,4,6])

Nota: Se supone que d es mayor que 1.

Soluciones

mayorResto :: Int -> Int -> (Int,[Int])
mayorResto n d = (m, [x | x <- [1..d-1], n `rem` x == m])
    where m = maximum [n `rem` x | x <- [1..d-1]]

mayorResto :: Int -> Int -> (Int,[Int])

mayorResto n d = (m, [x | x <- [1..d-1], n `rem` x == m])

where m = maximum [n `rem` x | x <- [1..d-1]]

Referencia

El ejercio está basado en el problema Largest possible remainder publicado el 16 de octubre de 2015 en «Programming paraxis».

Entero positivo con ciertas propiedades

PorJosé A. Alonso 23-octubre-201530-octubre-2015

El 6 de octubre, se propuso en el blog Gaussianos el siguiente problema

Demostrar que para todo entero positivo n, existe otro entero positivo que tiene las siguientes propiedades:

Tiene exactamente n dígitos.

Ninguno de sus dígitos es 0.

Es divisible por la suma de sus dígitos.

Definir la función

   especiales :: Integer -> [Integer]

1	especiales :: Integer -> [Integer]

tal que (especiales n) es la lista de los números enteros que cumplen las 3 propiedades anteriores para n. Por ejemplo,

   take 3 (especiales 2)  ==  [12,18,21]
   take 3 (especiales 3)  ==  [111,112,114]
   head (especiales 30)   ==  111111111111111111111111111125
   length (especiales 3)  ==  108
   null (especiales 1000) ==  False

take 3 (especiales 2) == [12,18,21]

take 3 (especiales 3) == [111,112,114]

head (especiales 30) == 111111111111111111111111111125

length (especiales 3) == 108

null (especiales 1000) == False

En el primer ejemplo, 12 es un número especial para 2 ya que tiene exactamente 2 dígitos, ninguno de sus dígitos es 0 y 12 es divisible por la suma de sus dígitos.

Soluciones

especiales :: Integer -> [Integer]
especiales n = [x | x <- [(10^n-1) `div` 9..10^n-1]
                  , esEspecial x]

esEspecial :: Integer -> Bool
esEspecial x = 
    notElem 0 digitos &&
    x `mod` sum digitos == 0        
    where digitos = [read [d] | d <- show x]

especiales :: Integer -> [Integer]

especiales n = [x | x <- [(10^n-1) `div` 9..10^n-1]

, esEspecial x]

esEspecial :: Integer -> Bool

esEspecial x =

notElem 0 digitos &&

x `mod` sum digitos == 0

where digitos = [read [d] | d <- show x]

Centro de masas

PorJosé A. Alonso 22-octubre-201529-octubre-2015

El centro de masas de un sistema discreto es el punto geométrico que dinámicamente se comporta como si en él estuviera aplicada la resultante de las fuerzas externas al sistema.

Representamos un conjunto de n masas en el plano mediante una lista de n pares de la forma ((a(i),b(i)),m(i)) donde (a(i),b(i)) es la posición y m(i) la masa puntual. Las coordenadas del centro de masas (a,b) se calculan por

   a = (a(1)*m(1) + a(2)*m(2) + ... + a(n)*m(n)) / (m(1) + m(2) +...+ m(n))
   b = (b(1)*m(1) + b(2)*m(2) + ... + b(n)*m(n)) / (m(1) + m(2) +...+ m(n))

1 2	a = (a(1)m(1) + a(2)m(2) + ... + a(n)m(n)) / (m(1) + m(2) +...+ m(n)) b = (b(1)m(1) + b(2)m(2) + ... + b(n)m(n)) / (m(1) + m(2) +...+ m(n))

Definir la función

   centrodeMasas :: [((Float,Float),Float)] -> (Float,Float)

1	centrodeMasas :: [((Float,Float),Float)] -> (Float,Float)

tal que (centrodeMasas xs) es las coordenadas del centro
de masas del sistema discreto xs. Por ejemplo:

   centrodeMasas [((-1,3),2),((0,0),5),((1,3),3)] == (0.1,1.5)

1	centrodeMasas [((-1,3),2),((0,0),5),((1,3),3)] == (0.1,1.5)

Soluciones

-- 1ª definición (por comprensión):
centrodeMasas :: [((Float,Float),Float)] -> (Float,Float) 
centrodeMasas xs = 
    (sum [a*m | ((a,_),m) <- xs] / t,
     sum [b*m | ((_,b),m) <- xs] / t)
    where t = sum [m | (_,m) <- xs]

-- 2ª definición (por recursión):
centrodeMasas2 :: [((Float,Float),Float)] -> (Float,Float)
centrodeMasas2 xs = aux xs (0,0,0)
    where aux [] (as,bs,ms)             = (as/ms, bs/ms)
          aux (((a,b),m):ys) (as,bs,ms) = aux ys (as+a*m,bs+b*m,ms+m)

-- 1ª definición (por comprensión):

centrodeMasas :: [((Float,Float),Float)] -> (Float,Float)

centrodeMasas xs =

(sum [a*m | ((a,_),m) <- xs] / t,

sum [b*m | ((_,b),m) <- xs] / t)

where t = sum [m | (_,m) <- xs]

-- 2ª definición (por recursión):

centrodeMasas2 :: [((Float,Float),Float)] -> (Float,Float)

centrodeMasas2 xs = aux xs (0,0,0)

where aux [] (as,bs,ms) = (as/ms, bs/ms)

aux (((a,b),m):ys) (as,bs,ms) = aux ys (as+a*m,bs+b*m,ms+m)

Refinamiento de listas

PorJosé A. Alonso 21-octubre-201528-octubre-2015

Definir la función

   refinada :: [Float] -> [Float]

1	refinada :: [Float] -> [Float]

tal que (refinada xs) es la lista obtenida intercalando entre cada dos elementos consecutivos de xs su media aritmética. Por ejemplo,

   refinada [2,7,1,8]  ==  [2.0,4.5,7.0,4.0,1.0,4.5,8.0]
   refinada [2]        ==  [2.0]
   refinada []         ==  []

refinada [2,7,1,8] == [2.0,4.5,7.0,4.0,1.0,4.5,8.0]

refinada [2] == [2.0]

refinada [] == []

Soluciones

-- 1ª definición (por recursión):
refinada :: [Float] -> [Float]
refinada (x:y:zs) = x : (x+y)/2 : refinada (y:zs)
refinada xs       = xs

-- 2ª definición (por comprensión);
refinada2 :: [Float] -> [Float]
refinada2 []     = []
refinada2 (x:xs) = x : concat [[(a+b)/2,b] | (a,b) <- zip (x:xs) xs]

-- 1ª definición (por recursión):

refinada :: [Float] -> [Float]

refinada (x:y:zs) = x : (x+y)/2 : refinada (y:zs)

refinada xs = xs

-- 2ª definición (por comprensión);

refinada2 :: [Float] -> [Float]

refinada2 [] = []

refinada2 (x:xs) = x : concat [[(a+b)/2,b] | (a,b) <- zip (x:xs) xs]

Múltiplos especiales

PorJosé A. Alonso 7-mayo-201515-mayo-2015

Dado dos números n y m, decimos que m es un múltiplo especial de n si m es un múltiplo de n y m no tiene ningún factor primo que sea congruente con 1 módulo 3.

Definir la función

   multiplosEspecialesCota :: Int -> Int -> [Int]

1	multiplosEspecialesCota :: Int -> Int -> [Int]

tal que (multiplosEspecialesCota n k) es la lista ordenada de todos los múltiplos especiales de n que son menores o iguales que k. Por ejemplo,

   multiplosEspecialesCota 5 50  ==  [5,10,15,20,25,30,40,45,50]
   multiplosEspecialesCota 7 50  ==  []

1 2	multiplosEspecialesCota 5 50 == [5,10,15,20,25,30,40,45,50] multiplosEspecialesCota 7 50 == []

Soluciones

import Data.Numbers.Primes (primeFactors)

multiplosEspecialesCota :: Int -> Int -> [Int]
multiplosEspecialesCota n k =
    [m | m <- [n,2*n..k], 
         all (\p -> p `mod` 3 /= 1) (primeFactors m)]

import Data.Numbers.Primes (primeFactors)

multiplosEspecialesCota :: Int -> Int -> [Int]

multiplosEspecialesCota n k =

[m | m <- [n,2*n..k],

all (\p -> p `mod` 3 /= 1) (primeFactors m)]

Colinealidad de una lista de puntos

PorJosé A. Alonso 28-abril-20155-mayo-2015

Una colección de puntos son colineales si existe una línea recta tal que todos están en dicha línea. Por ejemplo, los puntos (2,1), (5,7), (4,5) y (20,37) son colineales porque pertenecen a la línea y = 2*x-3.

Definir la función

   colineales :: [(Int,Int)] -> Bool

1	colineales :: [(Int,Int)] -> Bool

tal que (colineales ps) se verifica si los puntos de la lista ps son colineales. Por ejemplo,

   colineales [(2,1),(5,7),(4,5),(20,37)]  ==  True
   colineales [(2,1),(5,7),(4,5),(21,37)]  ==  False

1 2	colineales [(2,1),(5,7),(4,5),(20,37)] == True colineales [(2,1),(5,7),(4,5),(21,37)] == False

Soluciones

-- 1ª definición
colineales1 :: [(Int,Int)] -> Bool
colineales1 ((x1,y1):(x2,y2):xys) =
    all (\(x,y) -> (x-x1)*dy == (y-y1)*dx) xys
    where (dx,dy) = (x2-x1,y2-y1)
colineales1 _ = True

-- 2ª definición
colineales2 :: [(Int,Int)] -> Bool
colineales2 ((x,y):xys) = all (\(dx',dy')-> dx'*dy == dy'*dx) ds 
    where ((dx,dy):ds) = [(x'-x,y'-y) | (x',y') <- xys]

-- 3ª definición
colineales3 :: [(Int,Int)] -> Bool
colineales3 ((x1,y1):(x2,y2):xys) =
    all (\(x,y) -> x*dy-y*dx == k) xys
    where (dx,dy,k) = (x2-x1,y2-y1,x1*dy-y1*dx)
colineales3 _ = True

-- 1ª definición

colineales1 :: [(Int,Int)] -> Bool

colineales1 ((x1,y1):(x2,y2):xys) =

all (\(x,y) -> (x-x1)*dy == (y-y1)*dx) xys

where (dx,dy) = (x2-x1,y2-y1)

colineales1 _ = True

-- 2ª definición

colineales2 :: [(Int,Int)] -> Bool

colineales2 ((x,y):xys) = all (\(dx',dy')-> dx'*dy == dy'*dx) ds

where ((dx,dy):ds) = [(x'-x,y'-y) | (x',y') <- xys]

-- 3ª definición

colineales3 :: [(Int,Int)] -> Bool

colineales3 ((x1,y1):(x2,y2):xys) =

all (\(x,y) -> x*dy-y*dx == k) xys

where (dx,dy,k) = (x2-x1,y2-y1,x1*dy-y1*dx)

colineales3 _ = True

Fracciones cancelativas

PorJosé A. Alonso 22-abril-201529-abril-2015

Una fracción x/y es cancelativa si se cumplen las siguientes condiciones:

x/y es propia (es decir, x < y),
ninguno de los números x e y son múltiplos de 10 y
existe un dígito d tal que al borrar una ocurrencia de d en x y otra en y se obtiene una fracción cuyo valor coincide con x/y.

Por ejemplo, 16/64 es cancelativa ya que borrando el 6 en el numerador y el denominador se obtiene 1/4 que es igual a la original: 16/64 = 1/4.

Definir la función

   cancelativas :: Int -> Int -> [((Int, Int), (Int, Int))]

1	cancelativas :: Int -> Int -> [((Int, Int), (Int, Int))]

tal que (cancelativas m n) es la lista de las fracciones cancelativas con su denominador entre m y n. Por ejemplo,

   ghci> cancelativas 1 100
   [((16,64),(1,4)),((26,65),(2,5)),((19,95),(1,5)),((49,98),(4,8))]
   ghci> cancelativas 101 150
   [((22,121),(2,11)),((33,132),(3,12)),((34,136),(4,16)),((44,143),(4,13))]
   ghci> length (cancelativas 1 200)
   18

ghci> cancelativas 1 100

[((16,64),(1,4)),((26,65),(2,5)),((19,95),(1,5)),((49,98),(4,8))]

ghci> cancelativas 101 150

[((22,121),(2,11)),((33,132),(3,12)),((34,136),(4,16)),((44,143),(4,13))]

ghci> length (cancelativas 1 200)

Soluciones

import Data.List (intersect, nub)

cancelativas :: Int -> Int -> [((Int, Int), (Int, Int))]
cancelativas m n = 
    nub [((x,y),(a,b))
         | y <- [m..n], 
           y `mod` 10 /= 0,
           x <- [1..y-1],
           x `mod` 10 /= 0,
           (as,bs) <- reducciones (show x) (show y),
           not (null as),
           not (null bs),
           let (a,b) = (read as, read bs),
           b /= 0,
           a*y == b*x]

-- (reducciones xs ys) es la lista de los pares obtenidos eliminando una
-- ocurrencia de un elemento de xs tanto en xs como en ys. Por ejemplo,
--    ghci> reducciones "abac" "bcba"
--    [("bac","bcb"),("abc","bcb"),
--     ("aac","cba"),("aac","bca"),
--     ("aba","bba")]
reducciones :: Eq a => [a] -> [a] -> [([a],[a])]
reducciones xs ys =
    concat [[(us,vs) | us <- eliminaciones xs x, vs <- eliminaciones ys x]
            | x <- nub (intersect xs ys)]

-- (eliminaciones xs y) es la lista de las listas obtenidas eliminando
-- una ocurrencia del elemento y en la lista xs. Por ejemplo,  
--    eliminaciones "abacda" 'a'  ==  ["bacda","abcda","abacd"]
--    eliminaciones "abacd"  'a'  ==  ["bacd","abcd"]
--    eliminaciones "abacd"  'b'  ==  ["aacd"]
--    eliminaciones "abacd"  'e'  ==  []
eliminaciones :: Eq a => [a] -> a -> [[a]]
eliminaciones [] _ = []
eliminaciones (x:xs) y
    | x == y    = xs : [x:zs | zs <- zss]
    | otherwise = [x:zs | zs <- zss]
    where zss = eliminaciones xs y

import Data.List (intersect, nub)

cancelativas :: Int -> Int -> [((Int, Int), (Int, Int))]

cancelativas m n =

nub [((x,y),(a,b))

| y <- [m..n],

y `mod` 10 /= 0,

x <- [1..y-1],

x `mod` 10 /= 0,

(as,bs) <- reducciones (show x) (show y),

not (null as),

not (null bs),

let (a,b) = (read as, read bs),

b /= 0,

a*y == b*x]

-- (reducciones xs ys) es la lista de los pares obtenidos eliminando una

-- ocurrencia de un elemento de xs tanto en xs como en ys. Por ejemplo,

-- ghci> reducciones "abac" "bcba"

-- [("bac","bcb"),("abc","bcb"),

-- ("aac","cba"),("aac","bca"),

-- ("aba","bba")]

reducciones :: Eq a => [a] -> [a] -> [([a],[a])]

reducciones xs ys =

concat [[(us,vs) | us <- eliminaciones xs x, vs <- eliminaciones ys x]

| x <- nub (intersect xs ys)]

-- (eliminaciones xs y) es la lista de las listas obtenidas eliminando

-- una ocurrencia del elemento y en la lista xs. Por ejemplo,

-- eliminaciones "abacda" 'a' == ["bacda","abcda","abacd"]

-- eliminaciones "abacd" 'a' == ["bacd","abcd"]

-- eliminaciones "abacd" 'b' == ["aacd"]

-- eliminaciones "abacd" 'e' == []

eliminaciones :: Eq a => [a] -> a -> [[a]]

eliminaciones [] _ = []

eliminaciones (x:xs) y

| x == y = xs : [x:zs | zs <- zss]

| otherwise = [x:zs | zs <- zss]

where zss = eliminaciones xs y

Con mínimo común denominador

PorJosé A. Alonso 20-abril-201527-abril-2015

Los números racionales se pueden representar como pares de enteros:

   type Racional a = (a,a)

1	type Racional a = (a,a)

Definir la función

   reducida :: Integral a => [Racional a] -> [Racional a]

1	reducida :: Integral a => [Racional a] -> [Racional a]

tal que (reducida xs) es la lista de los números racionales donde cada uno es igual al correspondiente elemento de xs y el denominador de todos los elementos de (reducida xs) es el menor número que cumple dicha condición; es decir, si xs es la lista

   [(x_1, y_1), ..., (x_n, y_n)]

1	[(x_1, y_1), ..., (x_n, y_n)]

entonces (reducida xs) es

   [(z_1, d), ..., (z_n, d)]

1	[(z_1, d), ..., (z_n, d)]

tales que

   z_1/d = x_1/y_1, ..., z_n/d = x_n/y_n

1	z_1/d = x_1/y_1, ..., z_n/d = x_n/y_n

y d es el menor posible. Por ejemplo,

   reducida [(1,2),(1,3),(1,4)]  ==  [(6,12),(4,12),(3,12)]
   reducida [(1,2),(1,3),(6,4)]  ==  [(3,6),(2,6),(9,6)]
   reducida [(-7,6),(-10,-8)]    ==  [(-14,12),(15,12)]
   reducida [(8,12)]             ==  [(2,3)]

reducida [(1,2),(1,3),(1,4)] == [(6,12),(4,12),(3,12)]

reducida [(1,2),(1,3),(6,4)] == [(3,6),(2,6),(9,6)]

reducida [(-7,6),(-10,-8)] == [(-14,12),(15,12)]

reducida [(8,12)] == [(2,3)]

Soluciones

type Racional a = (a,a) 

reducida :: Integral a => [Racional a] -> [Racional a]
reducida xs = 
    [(x * (m `div` y), m) | (x,y) <- ys]
    where ys = map fraccionReducida xs
          m  = mcm [y | (_,y) <- ys]

-- (fraccionReducida r) es el número racional igual a r con menor
-- denominador positivo. Por ejemplo,
--    fraccionReducida ( 6, 10)  ==  ( 3,5)
--    fraccionReducida (-6, 10)  ==  (-3,5)
--    fraccionReducida ( 6,-10)  ==  (-3,5)
--    fraccionReducida (-6,-10)  ==  ( 3,5)
--    fraccionReducida ( 3,  5)  ==  ( 3,5)
fraccionReducida :: Integral a => (a,a) -> (a,a)
fraccionReducida (x,y) =
    (s * x1 `div` m, y1 `div` m)
    where s  = signum x * signum y      
          x1 = abs x
          y1 = abs y
          m  = gcd x1 y1
          
-- (mcm xs) es el mínimo común múltiplo de xs. Por ejemplo,
--    mcm [2,6,10]  ==  30
mcm :: Integral a => [a] -> a
mcm = foldl lcm 1

type Racional a = (a,a)

reducida :: Integral a => [Racional a] -> [Racional a]

reducida xs =

[(x * (m `div` y), m) | (x,y) <- ys]

where ys = map fraccionReducida xs

m = mcm [y | (_,y) <- ys]

-- (fraccionReducida r) es el número racional igual a r con menor

-- denominador positivo. Por ejemplo,

-- fraccionReducida ( 6, 10) == ( 3,5)

-- fraccionReducida (-6, 10) == (-3,5)

-- fraccionReducida ( 6,-10) == (-3,5)

-- fraccionReducida (-6,-10) == ( 3,5)

-- fraccionReducida ( 3, 5) == ( 3,5)

fraccionReducida :: Integral a => (a,a) -> (a,a)

fraccionReducida (x,y) =

(s * x1 `div` m, y1 `div` m)

where s = signum x * signum y

x1 = abs x

y1 = abs y

m = gcd x1 y1

-- (mcm xs) es el mínimo común múltiplo de xs. Por ejemplo,

-- mcm [2,6,10] == 30

mcm :: Integral a => [a] -> a

mcm = foldl lcm 1

Primos hereditarios

PorJosé A. Alonso 16-abril-20151-mayo-2016

Un número primo es hereditario si todos los números obtenidos eliminando dígitos por la derecha o por la izquierda son primos. Por ejemplo, 3797 es hereditario ya que los números obtenidos eliminando dígitos por la derecha son 3797, 379, 37 y 3 y los obtenidos eliminando dígitos por la izquierda son 3797, 797, 97 y 7 y todos ellos son primos.

Definir la sucesión

   hereditarios :: [Integer]

1	hereditarios :: [Integer]

cuyos elementos son los números hereditarios. Por ejemplo,

   ghci> take 15 hereditarios
   [2,3,5,7,23,37,53,73,313,317,373,797,3137,3797,739397]

1 2	ghci> take 15 hereditarios [2,3,5,7,23,37,53,73,313,317,373,797,3137,3797,739397]

Soluciones

import Data.List (inits, tails)
import Data.Char (digitToInt)
import Data.Numbers.Primes (primes, isPrime)

hereditarios :: [Integer]
hereditarios = [n | n <- primes, hereditario n]

hereditario :: Integer -> Bool
hereditario n = 
    all odd (map digitToInt (tail ds)) &&
    all isPrime (map read (tail (inits ds))) &&
    all isPrime (map read (init (tails ds)))
    where ds = show n

import Data.List (inits, tails)

import Data.Char (digitToInt)

import Data.Numbers.Primes (primes, isPrime)

hereditarios :: [Integer]

hereditarios = [n | n <- primes, hereditario n]

hereditario :: Integer -> Bool

hereditario n =

all odd (map digitToInt (tail ds)) &&

all isPrime (map read (tail (inits ds))) &&

all isPrime (map read (init (tails ds)))

where ds = show n

Constante de Champernowne

PorJosé A. Alonso 15-abril-201525-marzo-2022

La constante de Champernowne es el número irracional

   0.12345678910111213141516171819202122232425262728293031323334 ...

1	0.12345678910111213141516171819202122232425262728293031323334 ...

cuya parte entera es 0 y la parte decimal se obtiene concatenado los números naturales a partir de 1.

Definir la función

   productoChampernowne :: [Int] -> Int

1	productoChampernowne :: [Int] -> Int

tal que (productoChampernowne ns) es el producto de los dígitos de la constante de Champernowne que ocupan las posiciones ns. Por ejemplo,

   productoChampernowne [0,1,2]                 ==  6
   productoChampernowne [8,20]                  ==  45
   productoChampernowne [10^i-1 | i <- [0..7]]  ==  1470

productoChampernowne [0,1,2] == 6

productoChampernowne [8,20] == 45

productoChampernowne [10^i-1 | i <- [0..7]] == 1470

Soluciones

import Data.Char (digitToInt)

productoChampernowne :: [Int] -> Int
productoChampernowne ns = product [champernowne !! n | n <- ns] 

-- champernowne  es la sucesión de champernowne. Por ejemplo,
--    ghci> take 20 champernowne
--    [1,2,3,4,5,6,7,8,9,1,0,1,1,1,2,1,3,1,4,1]
champernowne :: [Int] 
champernowne = map digitToInt (concatMap show [1..])

import Data.Char (digitToInt)

productoChampernowne :: [Int] -> Int

productoChampernowne ns = product [champernowne !! n | n <- ns]

-- champernowne es la sucesión de champernowne. Por ejemplo,

-- ghci> take 20 champernowne

-- [1,2,3,4,5,6,7,8,9,1,0,1,1,1,2,1,3,1,4,1]

champernowne :: [Int]

champernowne = map digitToInt (concatMap show [1..])

Pandigitales múltiplos de un número por una lista de números

PorJosé A. Alonso 9-abril-20151-mayo-2015

Un número pandigital es un número que contiene todos los dígitos del 1 al 9 sólo una vez. Por ejemplo, 192384576 es un número pandigital.

El producto de un número natural x por una lista de números naturales ys es el número obtenido concatenando los productos de x por cada uno de los elementos de ys. Por ejemplo, el producto de 2 por [3,2,5] es 6410.

Un número pandigital x es un múltiplo si existe un y y un n > 1 tales que x es el producto de y por [1,2,3,…,n]. Por ejemplo, 192384576 es un pandigital múltiplo ya que

   192 × 1 = 192
   192 × 2 = 384
   192 × 3 = 576

192 × 1 = 192

192 × 2 = 384

192 × 3 = 576

por tanto, 192384576 es el producto de 192 por [1,2,3]. Otro pandgital múltiplo es el 918273645 ya que es el producto de 9 por [1,2,3,4,5].

Definir la sucesión

   pandigitalesMultiplos :: [Integer]

1	pandigitalesMultiplos :: [Integer]

tal que sus elementos son los números pandigitales múltiplos. Por ejemplo,

   ghci> take 5 pandigitalesMultiplos
   [123456789,192384576,219438657,273546819,327654981]

1 2	ghci> take 5 pandigitalesMultiplos [123456789,192384576,219438657,273546819,327654981]

Soluciones

import Data.List (sort)

pandigitalesMultiplos :: [Integer]
pandigitalesMultiplos =
    sort [y | x <- [1..a],
              y <- productosCon9Digitos x,
              esPandigital y]
    where a = head [x | x <- [1..], producto x [1,2] > 987654321]

-- (productosCon9Digitos x) es la lista de los productos de x por una
-- lista [1,2,...,n] (con n > 1) que tienen 9 dígitos, Por ejemplo, 
--    productosCon9Digitos 3  ==  [369121518]
--    productosCon9Digitos 2  ==  []
productosCon9Digitos :: Integer -> [Integer]
productosCon9Digitos x | numeroDeDigitos z == 9 = [z]
                       | otherwise              = []
    where z = head [y | n <- [2..], 
                        let y = producto x [1..n], 
                        numeroDeDigitos y >= 9]

-- (producto x ys) es el producto de x por ys. Por ejemplo,
--    producto 2 [3,2,5]  ==  6410
producto :: Integer -> [Integer] -> Integer
producto x = read . concatMap (show . (x*))

-- (numeroDeDigitos x) es el número de dígitos de x. Por ejemplo,
--    numeroDeDigitos 425  ==  3
numeroDeDigitos :: Integer -> Int
numeroDeDigitos = length . show

-- (esPandigital x) se verifica si x es pandigital. Por ejemplo,
--    esPandigital 192384576   ==  True
--    esPandigital 192314576   ==  False
--    esPandigital 1923145761  ==  False
esPandigital :: Integer -> Bool
esPandigital n = sort (show n) == "123456789"

-- La lista de los pandigitales múltiplos se calcula por
--    ghci> pandigitalesMultiplos
--    [123456789, 192384576, 219438657, 273546819, 327654981, 672913458,
--     679213584, 692713854, 726914538, 729314586, 732914658, 769215384,
--     792315846, 793215864, 918273645, 926718534, 927318546, 932718654]

import Data.List (sort)

pandigitalesMultiplos :: [Integer]

pandigitalesMultiplos =

sort [y | x <- [1..a],

y <- productosCon9Digitos x,

esPandigital y]

where a = head [x | x <- [1..], producto x [1,2] > 987654321]

-- (productosCon9Digitos x) es la lista de los productos de x por una

-- lista [1,2,...,n] (con n > 1) que tienen 9 dígitos, Por ejemplo,

-- productosCon9Digitos 3 == [369121518]

-- productosCon9Digitos 2 == []

productosCon9Digitos :: Integer -> [Integer]

productosCon9Digitos x | numeroDeDigitos z == 9 = [z]

| otherwise = []

where z = head [y | n <- [2..],

let y = producto x [1..n],

numeroDeDigitos y >= 9]

-- (producto x ys) es el producto de x por ys. Por ejemplo,

-- producto 2 [3,2,5] == 6410

producto :: Integer -> [Integer] -> Integer

producto x = read . concatMap (show . (x*))

-- (numeroDeDigitos x) es el número de dígitos de x. Por ejemplo,

-- numeroDeDigitos 425 == 3

numeroDeDigitos :: Integer -> Int

numeroDeDigitos = length . show

-- (esPandigital x) se verifica si x es pandigital. Por ejemplo,

-- esPandigital 192384576 == True

-- esPandigital 192314576 == False

-- esPandigital 1923145761 == False

esPandigital :: Integer -> Bool

esPandigital n = sort (show n) == "123456789"

-- La lista de los pandigitales múltiplos se calcula por

-- ghci> pandigitalesMultiplos

-- [123456789, 192384576, 219438657, 273546819, 327654981, 672913458,

-- 679213584, 692713854, 726914538, 729314586, 732914658, 769215384,

-- 792315846, 793215864, 918273645, 926718534, 927318546, 932718654]

Perímetro más frecuente de triángulos rectángulos

PorJosé A. Alonso 7-abril-20151-mayo-2015

El grado perimetral de un número p es la cantidad de tres triángulos rectángulos de lados enteros cuyo perímetro es p. Por ejemplo, el grado perimetral de 120 es 3 ya que sólo hay 3 triángulos rectángulos de lados enteros cuyo perímetro es 120: {20,48,52}, {24,45,51} y {30,40,50}.

Definir la función

   maxGradoPerimetral :: Int -> (Int,[Int])

1	maxGradoPerimetral :: Int -> (Int,[Int])

tal que (maxGradoPerimetral n) es el par (m,ps) tal que m es el máximo grado perimetral de los números menores o iguales que n y ps son los perímetros, menores o iguales que n, cuyo grado perimetral es m. Por ejemplo,

   maxGradoPerimetral   50  ==  (1,[12,24,30,36,40,48])
   maxGradoPerimetral  100  ==  (2,[60,84,90])
   maxGradoPerimetral  200  ==  (3,[120,168,180])
   maxGradoPerimetral  400  ==  (4,[240,360])
   maxGradoPerimetral  500  ==  (5,[420])
   maxGradoPerimetral  750  ==  (6,[720])
   maxGradoPerimetral  839  ==  (6,[720])
   maxGradoPerimetral  840  ==  (8,[840])
   maxGradoPerimetral 1500  ==  (8,[840,1260])
   maxGradoPerimetral 2000  ==  (10,[1680])
   maxGradoPerimetral 3000  ==  (12,[2520])

maxGradoPerimetral 50 == (1,[12,24,30,36,40,48])

maxGradoPerimetral 100 == (2,[60,84,90])

maxGradoPerimetral 200 == (3,[120,168,180])

maxGradoPerimetral 400 == (4,[240,360])

maxGradoPerimetral 500 == (5,[420])

maxGradoPerimetral 750 == (6,[720])

maxGradoPerimetral 839 == (6,[720])

maxGradoPerimetral 840 == (8,[840])

maxGradoPerimetral 1500 == (8,[840,1260])

maxGradoPerimetral 2000 == (10,[1680])

maxGradoPerimetral 3000 == (12,[2520])

Soluciones

import Data.List
import Data.Array (accumArray, assocs)

-- 1ª solución                                                      --
-- ===========

maxGradoPerimetral1 :: Int -> (Int,[Int])
maxGradoPerimetral1 p = (m,[x | (n,x) <- ts, n == m])
    where ts    = [(length (triangulos x),x) | x <- [1..p]] 
          (m,_) = maximum ts 

-- (triangulos p) es el conjunto de triángulos rectángulos de perímetro
-- p. Por ejemplo,
--    triangulos 120  ==  [(20,48,52),(24,45,51),(30,40,50)]
triangulos :: Int -> [(Int,Int,Int)]
triangulos p = 
    [(a,b,c) | a <- [1..q],
               b <- [a..q],
               let c = p-a-b,
               a*a+b*b == c*c]
    where q = p `div` 2

-- 2ª solución                                                      --
-- ===========

maxGradoPerimetral2 :: Int -> (Int,[Int])
maxGradoPerimetral2 p = (m,[x | (n,x) <- ts, n == m])
    where ts    = [(n,x) | (x,n) <- numeroPerimetrosTriangulos p, n > 0]
          (m,_) = maximum ts 

-- (numeroPerimetrosTriangulos p) es la lista formado por los números de
-- 1 a p y la cantidad de triángulos rectángulos enteros cuyo perímetro
-- es dicho número. Por ejemplo,
--    ghci>  [(p,n) | (p,n) <- numeroPerimetrosTriangulos 70, n > 0]
--    [(12,1),(24,1),(30,1),(36,1),(40,1),(48,1),(56,1),(60,2),(70,1)]
numeroPerimetrosTriangulos :: Int -> [(Int,Int)] 
numeroPerimetrosTriangulos p = 
    assocs (accumArray (\x _ -> 1+x) 0 (1,p) (perimetrosTriangulos p))

-- (perimetrosTriangulos p) es la lista formada por los perímetros y los
-- lados de los triángulos rectángulos enteros cuyo perímetro es menor o
-- igual que p. Por ejemplo,
--    ghci> perimetrosTriangulos 70
--    [(12,(3,4,5)),   (30,(5,12,13)),(24,(6,8,10)),  (56,(7,24,25)),
--     (40,(8,15,17)), (36,(9,12,15)),(60,(10,24,26)),(48,(12,16,20)),
--     (60,(15,20,25)),(70,(20,21,29))]
perimetrosTriangulos :: Int -> [(Int,(Int,Int,Int))]
perimetrosTriangulos p =
    [(q,(a,b,c)) | a <- [1..p1],
                   b <- [a..p1],
                   esCuadrado (a*a+b*b), 
                   let c = raizCuadradaE (a*a+b*b), 
                   let q = a+b+c,
                   q <= p]
    where p1 = p `div` 2

-- (esCuadrado n) se verifica si n es un cuadrado. Por ejemplo,
--    esCuadrado 25  ==  True
--    esCuadrado 27  ==  False
esCuadrado :: Int -> Bool
esCuadrado n = a*a == n
    where a = raizCuadradaE n

-- (raizCuadradaE n) es la raíz cuadrada entera de n. Por ejemplo,
--    raizCuadradaE 25  ==  5
--    raizCuadradaE 27  ==  5
--    raizCuadradaE 35  ==  5
--    raizCuadradaE 36  ==  6
raizCuadradaE :: Int -> Int
raizCuadradaE = floor . sqrt . fromIntegral

-- 3ª solución                                                      --
-- ===========

maxGradoPerimetral3 :: Int -> (Int,[Int])
maxGradoPerimetral3 p = (m,[x | (n,x) <- ts, n == m])
    where ts    = [(n,x) | (x,n) <- numeroPerimetrosTriangulos2 p, n > 0]
          (m,_) = maximum ts 

-- (numeroPerimetrosTriangulos2 p) es la lista formado por los números de
-- 1 a p y la cantidad de triángulos rectángulos enteros cuyo perímetro
-- es dicho número. Por ejemplo,
--    ghci>  [(p,n) | (p,n) <- numeroPerimetrosTriangulos2 70, n > 0]
--    [(12,1),(24,1),(30,1),(36,1),(40,1),(48,1),(56,1),(60,2),(70,1)]
numeroPerimetrosTriangulos2 :: Int -> [(Int,Int)] 
numeroPerimetrosTriangulos2 p = 
    [(head xs, length xs) | xs <- group (sort (perimetrosTriangulos2 p))]

-- (perimetrosTriangulos2 p) es la lista formada por los perímetros de
-- los triángulos rectángulos enteros cuyo perímetro es menor o igual
-- que p. Por ejemplo, 
--    perimetrosTriangulos2 70  ==  [12,30,24,56,40,36,60,48,60,70]
perimetrosTriangulos2 :: Int -> [Int]
perimetrosTriangulos2 p =
    [q | a <- [1..p1],
         b <- [a..p1],
         esCuadrado (a*a+b*b), 
         let c = raizCuadradaE (a*a+b*b), 
         let q = a+b+c,
         q <= p]
    where p1 = p `div` 2

-- Comparación de eficiencia
-- =========================

-- La comparación es
--    ghci> maxGradoPerimetral1 1000
--    (8,[840])
--    (120.08 secs, 21116625136 bytes)
--    ghci> maxGradoPerimetral2 1000
--    (8,[840])
--    (0.66 secs, 132959056 bytes)
--    ghci> maxGradoPerimetral3 1000
--    (1000,[1])
--    (0.66 secs, 133443816 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List

import Data.Array (accumArray, assocs)

-- 1ª solución --

-- ===========

maxGradoPerimetral1 :: Int -> (Int,[Int])

maxGradoPerimetral1 p = (m,[x | (n,x) <- ts, n == m])

where ts = [(length (triangulos x),x) | x <- [1..p]]

(m,_) = maximum ts

-- (triangulos p) es el conjunto de triángulos rectángulos de perímetro

-- p. Por ejemplo,

-- triangulos 120 == [(20,48,52),(24,45,51),(30,40,50)]

triangulos :: Int -> [(Int,Int,Int)]

triangulos p =

[(a,b,c) | a <- [1..q],

b <- [a..q],

let c = p-a-b,

a*a+b*b == c*c]

where q = p `div` 2

-- 2ª solución --

-- ===========

maxGradoPerimetral2 :: Int -> (Int,[Int])

maxGradoPerimetral2 p = (m,[x | (n,x) <- ts, n == m])

where ts = [(n,x) | (x,n) <- numeroPerimetrosTriangulos p, n > 0]

(m,_) = maximum ts

-- (numeroPerimetrosTriangulos p) es la lista formado por los números de

-- 1 a p y la cantidad de triángulos rectángulos enteros cuyo perímetro

-- es dicho número. Por ejemplo,

-- ghci> [(p,n) | (p,n) <- numeroPerimetrosTriangulos 70, n > 0]

-- [(12,1),(24,1),(30,1),(36,1),(40,1),(48,1),(56,1),(60,2),(70,1)]

numeroPerimetrosTriangulos :: Int -> [(Int,Int)]

numeroPerimetrosTriangulos p =

assocs (accumArray (\x _ -> 1+x) 0 (1,p) (perimetrosTriangulos p))

-- (perimetrosTriangulos p) es la lista formada por los perímetros y los

-- lados de los triángulos rectángulos enteros cuyo perímetro es menor o

-- igual que p. Por ejemplo,

-- ghci> perimetrosTriangulos 70

-- [(12,(3,4,5)), (30,(5,12,13)),(24,(6,8,10)), (56,(7,24,25)),

-- (40,(8,15,17)), (36,(9,12,15)),(60,(10,24,26)),(48,(12,16,20)),

-- (60,(15,20,25)),(70,(20,21,29))]

perimetrosTriangulos :: Int -> [(Int,(Int,Int,Int))]

perimetrosTriangulos p =

[(q,(a,b,c)) | a <- [1..p1],

b <- [a..p1],

esCuadrado (a*a+b*b),

let c = raizCuadradaE (a*a+b*b),

let q = a+b+c,

q <= p]

where p1 = p `div` 2

-- (esCuadrado n) se verifica si n es un cuadrado. Por ejemplo,

-- esCuadrado 25 == True

-- esCuadrado 27 == False

esCuadrado :: Int -> Bool

esCuadrado n = a*a == n

where a = raizCuadradaE n

-- (raizCuadradaE n) es la raíz cuadrada entera de n. Por ejemplo,

-- raizCuadradaE 25 == 5

-- raizCuadradaE 27 == 5

-- raizCuadradaE 35 == 5

-- raizCuadradaE 36 == 6

raizCuadradaE :: Int -> Int

raizCuadradaE = floor . sqrt . fromIntegral

-- 3ª solución --

-- ===========

maxGradoPerimetral3 :: Int -> (Int,[Int])

maxGradoPerimetral3 p = (m,[x | (n,x) <- ts, n == m])

where ts = [(n,x) | (x,n) <- numeroPerimetrosTriangulos2 p, n > 0]

(m,_) = maximum ts

-- (numeroPerimetrosTriangulos2 p) es la lista formado por los números de

-- 1 a p y la cantidad de triángulos rectángulos enteros cuyo perímetro

-- es dicho número. Por ejemplo,

-- ghci> [(p,n) | (p,n) <- numeroPerimetrosTriangulos2 70, n > 0]

-- [(12,1),(24,1),(30,1),(36,1),(40,1),(48,1),(56,1),(60,2),(70,1)]

numeroPerimetrosTriangulos2 :: Int -> [(Int,Int)]

numeroPerimetrosTriangulos2 p =

[(head xs, length xs) | xs <- group (sort (perimetrosTriangulos2 p))]

-- (perimetrosTriangulos2 p) es la lista formada por los perímetros de

-- los triángulos rectángulos enteros cuyo perímetro es menor o igual

-- que p. Por ejemplo,

-- perimetrosTriangulos2 70 == [12,30,24,56,40,36,60,48,60,70]

perimetrosTriangulos2 :: Int -> [Int]

perimetrosTriangulos2 p =

[q | a <- [1..p1],

b <- [a..p1],

esCuadrado (a*a+b*b),

let c = raizCuadradaE (a*a+b*b),

let q = a+b+c,

q <= p]

where p1 = p `div` 2

-- Comparación de eficiencia

-- =========================

-- La comparación es

-- ghci> maxGradoPerimetral1 1000

-- (8,[840])

-- (120.08 secs, 21116625136 bytes)

-- ghci> maxGradoPerimetral2 1000

-- (8,[840])

-- (0.66 secs, 132959056 bytes)

-- ghci> maxGradoPerimetral3 1000

-- (1000,[1])

-- (0.66 secs, 133443816 bytes)

Ramas a las que pertenece un elemento

PorJosé A. Alonso 1-abril-20151-mayo-2015

Representamos los árboles binarios con elementos en las hojas y en los nodos mediante el tipo de dato

   data Arbol a = H a | N a (Arbol a) (Arbol a) deriving Show

1	data Arbol a = H a \| N a (Arbol a) (Arbol a) deriving Show

Por ejemplo,

   ej1 :: Arbol Int
   ej1 = N 5 (N 2 (H 1) (H 2)) (N 3 (H 4) (H 2))

1 2	ej1 :: Arbol Int ej1 = N 5 (N 2 (H 1) (H 2)) (N 3 (H 4) (H 2))

Definir la función

   ramasCon :: Eq a => Arbol a -> a -> [[a]]

1	ramasCon :: Eq a => Arbol a -> a -> [[a]]

tal que (ramasCon a x) es la lista de las ramas del árbol a en las que aparece el elemento x. Por ejemplo,

  ramasCon ej1 2 ==  [[5,2,1],[5,2,2],[5,3,2]]

1	ramasCon ej1 2 == [[5,2,1],[5,2,2],[5,3,2]]

Soluciones

data Arbol a = H a | N a (Arbol a) (Arbol a) deriving Show

ej1 :: Arbol Int
ej1 = N 5 (N 2 (H 1) (H 2)) (N 3 (H 4) (H 2))

-- 1ª definición
-- =============

ramasCon :: Eq a => Arbol a -> a -> [[a]]
ramasCon a x = [ys | ys <- ramas a, x `elem` ys]

ramas :: Arbol a -> [[a]]
ramas (H x)     = [[x]]
ramas (N x i d) = [x:ys | ys <- ramas i ++ ramas d]

-- 2ª definición
-- =============

ramasCon2 :: Eq a => Arbol a -> a -> [[a]]
ramasCon2 a x = filter (x `elem`) (ramas2 a)

ramas2 :: Arbol a -> [[a]]
ramas2 (H x)     = [[x]]
ramas2 (N x i d) = map (x:) (ramas2 i ++ ramas2 d)

data Arbol a = H a | N a (Arbol a) (Arbol a) deriving Show

ej1 :: Arbol Int

ej1 = N 5 (N 2 (H 1) (H 2)) (N 3 (H 4) (H 2))

-- 1ª definición

-- =============

ramasCon :: Eq a => Arbol a -> a -> [[a]]

ramasCon a x = [ys | ys <- ramas a, x `elem` ys]

ramas :: Arbol a -> [[a]]

ramas (H x) = [[x]]

ramas (N x i d) = [x:ys | ys <- ramas i ++ ramas d]

-- 2ª definición

-- =============

ramasCon2 :: Eq a => Arbol a -> a -> [[a]]

ramasCon2 a x = filter (x `elem`) (ramas2 a)

ramas2 :: Arbol a -> [[a]]

ramas2 (H x) = [[x]]

ramas2 (N x i d) = map (x:) (ramas2 i ++ ramas2 d)

Pares de enteros con sólo un factor primo común

PorJosé A. Alonso 31-marzo-201525-marzo-2022

Dos enteros positivos a y b se dirán relacionados si poseen, exactamente, un factor primo en común. Por ejemplo, 12 y 20 están relacionados, pero 6 y 30 no lo están.

Definir la lista infinita

   paresRel :: [(Int,Int)]

1	paresRel :: [(Int,Int)]

tal que paresRel enumera todos los pares (a,b), con 1 ≤ a < b, tal que a y b están relacionados. Por ejemplo,

   ghci> take 10 paresRel
   [(2,4),(2,6),(3,6),(4,6),(2,8),(4,8),(6,8),(3,9),(6,9),(2,10)]

1 2	ghci> take 10 paresRel [(2,4),(2,6),(3,6),(4,6),(2,8),(4,8),(6,8),(3,9),(6,9),(2,10)]

¿Qué lugar ocupa el par (51,111) en la lista infinita paresRel?

Soluciones

import Data.List (group, intersect, nub)
import Data.Numbers.Primes (primeFactors)

-- 1ª solución
-- ===========

paresRel1 :: [(Int,Int)]
paresRel1 = [(a,b) | b <- [1..], a <- [1..b-1], relacionados a b]

relacionados :: Int -> Int -> Bool
relacionados a b = 
    length (nub (primeFactors a `intersect` primeFactors b)) == 1

-- 2ª solución
-- ===========

paresRel2 :: [(Int,Int)]
paresRel2 = [(x,y) | y <- [4..], x <- [2..y-2], rel x y]
    where rel x y = m /= 1 && all (== head ps) ps
              where m  = gcd x y
                    ps = primeFactors m

-- 3ª solución
-- ===========

paresRel3 :: [(Int,Int)]
paresRel3 =
    [(x,y) | y <- [2..], x <- [2..y-1], relacionados3 x y]

relacionados3 :: Int -> Int -> Bool
relacionados3 x y =
    length (group (primeFactors (gcd x y))) == 1

-- Comparación de eficiencia
--    λ> paresRel1 !! 40000
--    (216,489)
--    (3.19 secs, 1,825,423,056 bytes)
--    λ> paresRel2 !! 40000
--    (216,489)
--    (0.96 secs, 287,174,864 bytes)
--    λ> paresRel3 !! 40000
--    (216,489)
--    (0.70 secs, 264,137,928 bytes)

-- Cálculo
-- =======

-- El cálculo es
--    ghci> 1 + length (takeWhile (/=(51,111)) paresRel1)
--    2016

import Data.List (group, intersect, nub)

import Data.Numbers.Primes (primeFactors)

-- 1ª solución

-- ===========

paresRel1 :: [(Int,Int)]

paresRel1 = [(a,b) | b <- [1..], a <- [1..b-1], relacionados a b]

relacionados :: Int -> Int -> Bool

relacionados a b =

length (nub (primeFactors a `intersect` primeFactors b)) == 1

-- 2ª solución

-- ===========

paresRel2 :: [(Int,Int)]

paresRel2 = [(x,y) | y <- [4..], x <- [2..y-2], rel x y]

where rel x y = m /= 1 && all (== head ps) ps

where m = gcd x y

ps = primeFactors m

-- 3ª solución

-- ===========

paresRel3 :: [(Int,Int)]

paresRel3 =

[(x,y) | y <- [2..], x <- [2..y-1], relacionados3 x y]

relacionados3 :: Int -> Int -> Bool

relacionados3 x y =

length (group (primeFactors (gcd x y))) == 1

-- Comparación de eficiencia

-- λ> paresRel1 !! 40000

-- (216,489)

-- (3.19 secs, 1,825,423,056 bytes)

-- λ> paresRel2 !! 40000

-- (216,489)

-- (0.96 secs, 287,174,864 bytes)

-- λ> paresRel3 !! 40000

-- (216,489)

-- (0.70 secs, 264,137,928 bytes)

-- Cálculo

-- =======

-- El cálculo es

-- ghci> 1 + length (takeWhile (/=(51,111)) paresRel1)

-- 2016

Matrices cruzadas

PorJosé A. Alonso 24-marzo-20151-mayo-2015

Consideramos las matrices representadas como tablas cuyos índices son pares de números naturales.

   type Matriz a = Array (Int,Int) a

1	type Matriz a = Array (Int,Int) a

Una matriz cruzada es una matriz cuadrada en la que sólo hay elementos distintos de 0 en las diagonales principal y secundaria. Por ejemplo,

   | 1 0 0 0 3 |     | 1 0 0 3 |
   | 0 2 0 1 0 |     | 0 2 3 0 |
   | 0 0 3 0 0 |     | 0 4 5 0 |
   | 0 2 0 1 0 |     | 2 0 0 3 |
   | 1 0 0 0 3 |

| 1 0 0 0 3 | | 1 0 0 3 |

| 0 2 0 1 0 | | 0 2 3 0 |

| 0 0 3 0 0 | | 0 4 5 0 |

| 0 2 0 1 0 | | 2 0 0 3 |

| 1 0 0 0 3 |

Definir la función

   creaCruzada :: Int -> Matriz Int

1	creaCruzada :: Int -> Matriz Int

tal que (creaCruzada n) es la siguiente matriz cruzada con n filas y n columnas:

   | 1  0   0  ...  0   0  1 |
   | 0  2   0  ...  0   2  0 |
   | 0  0   3  ...  3   0  0 |
   | ....................... |
   | 0  0  n-2 ... n-2  0  0 |
   | 0 n-1  0  ...  0  n-1 0 |
   | n  0   0  ...  0   0  n |

| 1 0 0 ... 0 0 1 |

| 0 2 0 ... 0 2 0 |

| 0 0 3 ... 3 0 0 |

| ....................... |

| 0 0 n-2 ... n-2 0 0 |

| 0 n-1 0 ... 0 n-1 0 |

| n 0 0 ... 0 0 n |

Es decir, los elementos de la diagonal principal son [1,…,n], en orden desde la primera fila hasta la última; y los elementos de la diagonal secundaria son [1,…,n], en orden desde la primera fila hasta la última. Por ejemplo,

   ghci> elems (creaCruzada 3)
   [1,0,1, 0,2,0, 3,0,3]
   ghci> elems (creaCruzada 4)
   [1,0,0,1, 0,2,2,0, 0,3,3,0, 4,0,0,4]
   ghci> elems (creaCruzada 5)
   [1,0,0,0,1, 0,2,0,2,0, 0,0,3,0,0, 0,4,0,4,0, 5,0,0,0,5]

ghci> elems (creaCruzada 3)

[1,0,1, 0,2,0, 3,0,3]

ghci> elems (creaCruzada 4)

[1,0,0,1, 0,2,2,0, 0,3,3,0, 4,0,0,4]

ghci> elems (creaCruzada 5)

[1,0,0,0,1, 0,2,0,2,0, 0,0,3,0,0, 0,4,0,4,0, 5,0,0,0,5]

Soluciones

import Data.Array

type Matriz a = Array (Int,Int) a

-- 1ª solución
creaCruzada1 :: Int -> Matriz Int
creaCruzada1 n =
    array ((1,1),(n,n))
          [((i,j),f i j) | i <- [1..n], j <- [1..n]]
    where f i j | i == j     = i
                | i+j == n+1 = i
                | otherwise  = 0

-- 2ª solución
creaCruzada2 :: Int -> Matriz Int
creaCruzada2 n = listArray t [f i j| (i,j) <- range t]
    where t = ((1,1),(n,n))
          f i j | i == j     = i
                | i+j == n+1 = i
                | otherwise  = 0

-- 3ª solución
creaCruzada3 :: Int -> Matriz Int
creaCruzada3 n = 
    listArray ((1,1),(n,n)) 
              (replicate (n^2) 0) // ([((i,i),i) | i <- [1..n]] ++ 
                                     [((i,n-i+1),i)| i <- [n,n-1..1]])

creaCruzada4 :: Int -> Matriz Int
creaCruzada4 n = 
    accumArray (\x y -> y) 0 ((1,1),(n,n))
               (concat [[((i,i),i),((i,n+1-i),i)] | i <- [1..n]])

-- Comparación de eficiencia
--    ghci> let n = 2000 in creaCruzada1 n ! (n,n)
--    2000
--    (6.13 secs, 896997468 bytes)
--    
--    ghci> let n = 2000 in creaCruzada2 n ! (n,n)
--    2000
--    (3.83 secs, 433675668 bytes)
--    
--    ghci> let n = 2000 in creaCruzada3 n ! (n,n)
--    2000
--    (0.56 secs, 145741748 bytes)
--    
--    ghci> let n = 2000 in creaCruzada4 n ! (n,n)
--    2000
--    (0.27 secs, 37373392 bytes)

import Data.Array

type Matriz a = Array (Int,Int) a

-- 1ª solución

creaCruzada1 :: Int -> Matriz Int

creaCruzada1 n =

array ((1,1),(n,n))

[((i,j),f i j) | i <- [1..n], j <- [1..n]]

where f i j | i == j = i

| i+j == n+1 = i

| otherwise = 0

-- 2ª solución

creaCruzada2 :: Int -> Matriz Int

creaCruzada2 n = listArray t [f i j| (i,j) <- range t]

where t = ((1,1),(n,n))

f i j | i == j = i

| i+j == n+1 = i

| otherwise = 0

-- 3ª solución

creaCruzada3 :: Int -> Matriz Int

creaCruzada3 n =

listArray ((1,1),(n,n))

(replicate (n^2) 0) // ([((i,i),i) | i <- [1..n]] ++

[((i,n-i+1),i)| i <- [n,n-1..1]])

creaCruzada4 :: Int -> Matriz Int

creaCruzada4 n =

accumArray (\x y -> y) 0 ((1,1),(n,n))

(concat [[((i,i),i),((i,n+1-i),i)] | i <- [1..n]])

-- Comparación de eficiencia

-- ghci> let n = 2000 in creaCruzada1 n ! (n,n)

-- 2000

-- (6.13 secs, 896997468 bytes)

-- ghci> let n = 2000 in creaCruzada2 n ! (n,n)

-- 2000

-- (3.83 secs, 433675668 bytes)

-- ghci> let n = 2000 in creaCruzada3 n ! (n,n)

-- 2000

-- (0.56 secs, 145741748 bytes)

-- ghci> let n = 2000 in creaCruzada4 n ! (n,n)

-- 2000

-- (0.27 secs, 37373392 bytes)

Máximos locales de una matriz

PorJosé A. Alonso 20-marzo-20151-mayo-2015

Un elemento de una matriz es un máximo local si es mayor que todos sus vecinos. Por ejemplo, en la matriz

    [[1,0,0,8],
     [0,2,0,3],
     [0,0,0,5],
     [3,5,7,6],
     [1,2,3,4]]

[[1,0,0,8],

[0,2,0,3],

[0,0,0,5],

[3,5,7,6],

[1,2,3,4]]

los máximos locales son 8 (en la posición (1,4)), 2 (en la posición (2,2)) y 7 (en la posición (4,3)).

Definimos el tipo de las matrices, mediante

   type Matriz a = Array (Int,Int) Int

1	type Matriz a = Array (Int,Int) Int

y el ejemplo anterior por

   ej1 :: Matriz Int
   ej1 = listArray ((1,1),(5,4)) (concat [[1,0,0,8],
                                          [0,2,0,3],
                                          [0,0,0,5],
                                          [3,5,7,6],
                                          [1,2,3,4]])

ej1 :: Matriz Int

ej1 = listArray ((1,1),(5,4)) (concat [[1,0,0,8],

[0,2,0,3],

[0,0,0,5],

[3,5,7,6],

[1,2,3,4]])

Definir la función

   maximosLocales :: Matriz Int -> [((Int,Int),Int)]

1	maximosLocales :: Matriz Int -> [((Int,Int),Int)]

tal que (maximosLocales p) es la lista de las posiciones en las que hay un máximo local, con el valor correspondiente. Por ejemplo,

   maximosLocales ej1 == [((1,4),8),((2,2),2),((4,3),7)]

1	maximosLocales ej1 == [((1,4),8),((2,2),2),((4,3),7)]

Soluciones

import Data.Array

type Matriz a = Array (Int,Int) a

ej1 :: Matriz Int
ej1 = listArray ((1,1),(5,4)) (concat [[1,0,0,8],
                                       [0,2,0,3],
                                       [0,0,0,5],
                                       [3,5,7,6],
                                       [1,2,3,4]])

maximosLocales :: Matriz Int -> [((Int,Int),Int)]
maximosLocales p = 
    [((i,j),p!(i,j)) | (i,j) <- indices p,
               and [p!(a,b) < p!(i,j) | (a,b) <- vecinos (i,j)]] 
    where (_,(m,n)) = bounds p
          vecinos (i,j) = [(a,b) | a <- [max 1 (i-1)..min m (i+1)],
                                   b <- [max 1 (j-1)..min n (j+1)],
                                   (a,b) /= (i,j)]

import Data.Array

type Matriz a = Array (Int,Int) a

ej1 :: Matriz Int

ej1 = listArray ((1,1),(5,4)) (concat [[1,0,0,8],

[0,2,0,3],

[0,0,0,5],

[3,5,7,6],

[1,2,3,4]])

maximosLocales :: Matriz Int -> [((Int,Int),Int)]

maximosLocales p =

[((i,j),p!(i,j)) | (i,j) <- indices p,

and [p!(a,b) < p!(i,j) | (a,b) <- vecinos (i,j)]]

where (_,(m,n)) = bounds p

vecinos (i,j) = [(a,b) | a <- [max 1 (i-1)..min m (i+1)],

b <- [max 1 (j-1)..min n (j+1)],

(a,b) /= (i,j)]

Sucesión de números parientes

PorJosé A. Alonso 17-marzo-20151-mayo-2016

Se dice que dos números naturales son parientes sitienen exactamente un factor primo en común, independientemente de su multiplicidad. Por ejemplo,

Los números 12 (2²·3) y 40 (2³·5) son parientes, pues tienen al 2 como único factor primo en común.
Los números 49 (7²) y 63 (3²·7) son parientes, pues tienen al 7 como único factor primo en común.
Los números 12 (2²·3) y 30 (2·3·5) no son parientes, pues tienen dos factores primos en común.
Los números 49 (7²) y 25 (5²) no son parientes, pues no tienen factores primos en común.

Se dice que una lista de números naturales es una secuencia de parientes si cada par de números consecutivos son parientes. Por ejemplo,

La lista [12,40,35,28] es una secuencia de parientes.
La lista [12,30,21,49] no es una secuencia de parientes.

Definir la función

   secuenciaParientes :: [Integer] -> Bool

1	secuenciaParientes :: [Integer] -> Bool

tal que (secuenciaParientes xs) se verifica si xs es una secuencia de parientes. Por ejemplo,

   secuenciaParientes [12,40,35,28]           ==  True
   secuenciaParientes [12,30,21,49]           ==  False
   secuenciaParientes [2^n | n <- [1..2000]]  ==  True

secuenciaParientes [12,40,35,28] == True

secuenciaParientes [12,30,21,49] == False

secuenciaParientes [2^n | n <- [1..2000]] == True

Soluciones

import Data.List (intersect, nub)
import Data.Numbers.Primes (primes, primeFactors)

-- (parientes x y) se verifica si x e y son parientes. Por ejemplo,
--    parientes 12 40  ==  True
--    parientes 49 63  ==  True
--    parientes 12 30  ==  False
--    parientes 49 25  ==  False

-- 1ª definición (con gcd)
parientes1 :: Integer -> Integer -> Bool
parientes1 x y =
    length [p | p <- takeWhile (<= d) primes, d `mod` p == 0] == 1 
    where d = gcd x y

-- 2ª definición (con primeFactors)
parientes2 :: Integer -> Integer -> Bool
parientes2 0 0 = False
parientes2 x y = 
    length (nub (primeFactors x `intersect` primeFactors y)) == 1

-- Comparación de eficiencia
--    ghci> parientes1 (2^25) (2^25)
--    True
--    (34.34 secs, 15974866184 bytes)
--    ghci> parientes2 (2^25) (2^25)
--    True
--    (0.01 secs, 3093024 bytes)

-- Usaremos la 2ª definición
parientes :: Integer -> Integer -> Bool
parientes = parientes2

-- Definiciones de secuenciaParientes 
-- ==================================

-- 1ª definición (por recursión)
secuenciaParientes :: [Integer] -> Bool
secuenciaParientes []         = True
secuenciaParientes [x]        = True
secuenciaParientes (x1:x2:xs) =
    parientes x1 x2 && secuenciaParientes (x2:xs)

-- 2ª definición (por recursión con 2 ecuaciones)
secuenciaParientes2 :: [Integer] -> Bool
secuenciaParientes2 (x1:x2:xs) =
    parientes x1 x2 && secuenciaParientes2 (x2:xs)
secuenciaParientes2 _         = True

-- 3ª definición (sin recursión):
secuenciaParientes3 :: [Integer] -> Bool
secuenciaParientes3 xs = all (\(x,y) -> parientes x y) (zip xs (tail xs)) 

-- 4ª definición
secuenciaParientes4 :: [Integer] -> Bool
secuenciaParientes4 xs = all (uncurry parientes) (zip xs (tail xs))

import Data.List (intersect, nub)

import Data.Numbers.Primes (primes, primeFactors)

-- (parientes x y) se verifica si x e y son parientes. Por ejemplo,

-- parientes 12 40 == True

-- parientes 49 63 == True

-- parientes 12 30 == False

-- parientes 49 25 == False

-- 1ª definición (con gcd)

parientes1 :: Integer -> Integer -> Bool

parientes1 x y =

length [p | p <- takeWhile (<= d) primes, d `mod` p == 0] == 1

where d = gcd x y

-- 2ª definición (con primeFactors)

parientes2 :: Integer -> Integer -> Bool

parientes2 0 0 = False

parientes2 x y =

length (nub (primeFactors x `intersect` primeFactors y)) == 1

-- Comparación de eficiencia

-- ghci> parientes1 (2^25) (2^25)

-- True

-- (34.34 secs, 15974866184 bytes)

-- ghci> parientes2 (2^25) (2^25)

-- True

-- (0.01 secs, 3093024 bytes)

-- Usaremos la 2ª definición

parientes :: Integer -> Integer -> Bool

parientes = parientes2

-- Definiciones de secuenciaParientes

-- ==================================

-- 1ª definición (por recursión)

secuenciaParientes :: [Integer] -> Bool

secuenciaParientes [] = True

secuenciaParientes [x] = True

secuenciaParientes (x1:x2:xs) =

parientes x1 x2 && secuenciaParientes (x2:xs)

-- 2ª definición (por recursión con 2 ecuaciones)

secuenciaParientes2 :: [Integer] -> Bool

secuenciaParientes2 (x1:x2:xs) =

parientes x1 x2 && secuenciaParientes2 (x2:xs)

secuenciaParientes2 _ = True

-- 3ª definición (sin recursión):

secuenciaParientes3 :: [Integer] -> Bool

secuenciaParientes3 xs = all (\(x,y) -> parientes x y) (zip xs (tail xs))

-- 4ª definición

secuenciaParientes4 :: [Integer] -> Bool

secuenciaParientes4 xs = all (uncurry parientes) (zip xs (tail xs))

Números como sumas de primos consecutivos

PorJosé A. Alonso 11-marzo-201525-abril-2021

En el artículo Integers as a sum of consecutive primes in 2,3,4,.. ways se presentan números que se pueden escribir como sumas de primos consecutivos de varias formas. Por ejemplo, el 41 se puede escribir de dos formas distintas

   41 =  2 +  3 +  5 + 7 + 11 + 13
   41 = 11 + 13 + 17

1 2	41 = 2 + 3 + 5 + 7 + 11 + 13 41 = 11 + 13 + 17

el 240 se puede escribir de tres formas

   240 =  17 +  19 + 23 + 29 + 31 + 37 + 41 + 43
   240 =  53 +  59 + 61 + 67
   240 = 113 + 127

240 = 17 + 19 + 23 + 29 + 31 + 37 + 41 + 43

240 = 53 + 59 + 61 + 67

240 = 113 + 127

y el 311 se puede escribir de 4 formas

   311 =  11 +  13 +  17 + 19 + 23 + 29 + 31 + 37 + 41 + 43 + 47
   311 =  31 +  37 +  41 + 43 + 47 + 53 + 59
   311 =  53 +  59 +  61 + 67 + 71
   311 = 101 + 103 + 107

311 = 11 + 13 + 17 + 19 + 23 + 29 + 31 + 37 + 41 + 43 + 47

311 = 31 + 37 + 41 + 43 + 47 + 53 + 59

311 = 53 + 59 + 61 + 67 + 71

311 = 101 + 103 + 107

Definir la función

   sumas :: Integer -> [[Integer]]

1	sumas :: Integer -> [[Integer]]

tal que (sumas x) es la lista de las formas de escribir x como suma de dos o más números primos consecutivos. Por ejemplo,

   ghci> sumas 41
   [[2,3,5,7,11,13],[11,13,17]]
   ghci> sumas 240
   [[17,19,23,29,31,37,41,43],[53,59,61,67],[113,127]]
   ghci> sumas 311
   [[11,13,17,19,23,29,31,37,41,43,47],[31,37,41,43,47,53,59],
    [53,59,61,67,71],[101,103,107]]
   ghci> maximum [length (sumas n) | n <- [1..600]]
   4

ghci> sumas 41

[[2,3,5,7,11,13],[11,13,17]]

ghci> sumas 240

[[17,19,23,29,31,37,41,43],[53,59,61,67],[113,127]]

ghci> sumas 311

[[11,13,17,19,23,29,31,37,41,43,47],[31,37,41,43,47,53,59],

[53,59,61,67,71],[101,103,107]]

ghci> maximum [length (sumas n) | n <- [1..600]]

Soluciones

import Data.Numbers.Primes (primes)
import Data.List (span)

sumas :: Integer -> [[Integer]]
sumas x = [ys | n <- takeWhile (< x) primes, 
                let ys = sumaDesde x n,
                not (null ys)]

-- (sumaDesde x n) es la lista de al menos dos números primos
-- consecutivos a partir del número primo n cuya suma es x, si existen y
-- la lista vacía en caso contrario. Por ejemplo,
--    sumaDesde 15 3  ==  [3,5,7]
--    sumaDesde  7 3  ==  []
sumaDesde :: Integer -> Integer -> [Integer]
sumaDesde x n | x == y    = take (1 + length us) ys
              | otherwise = []
    where ys       = dropWhile (<n) primes
          (us,y:_) = span (<x) (scanl1 (+) ys)

import Data.Numbers.Primes (primes)

import Data.List (span)

sumas :: Integer -> [[Integer]]

sumas x = [ys | n <- takeWhile (< x) primes,

let ys = sumaDesde x n,

not (null ys)]

-- (sumaDesde x n) es la lista de al menos dos números primos

-- consecutivos a partir del número primo n cuya suma es x, si existen y

-- la lista vacía en caso contrario. Por ejemplo,

-- sumaDesde 15 3 == [3,5,7]

-- sumaDesde 7 3 == []

sumaDesde :: Integer -> Integer -> [Integer]

sumaDesde x n | x == y = take (1 + length us) ys

| otherwise = []

where ys = dropWhile (<n) primes

(us,y:_) = span (<x) (scanl1 (+) ys)

Orden de divisibilidad

PorJosé A. Alonso 9-marzo-201525-abril-2021

El orden de divisibilidad de un número x es el mayor n tal que para todo i menor o igual que n, los i primeros dígitos de n es divisible por i. Por ejemplo, el orden de divisibilidad de 74156 es 3 porque

   7       es divisible por 1
   74      es divisible por 2
   741     es divisible por 3
   7415 no es divisible por 4

7 es divisible por 1

74 es divisible por 2

741 es divisible por 3

7415 no es divisible por 4

Definir la función

   ordenDeDivisibilidad :: Integer -> Int

1	ordenDeDivisibilidad :: Integer -> Int

tal que (ordenDeDivisibilidad x) es el orden de divisibilidad de x. Por ejemplo,

   ordenDeDivisibilidad 74156                      ==  3
   ordenDeDivisibilidad 3608528850368400786036725  ==  25

1 2	ordenDeDivisibilidad 74156 == 3 ordenDeDivisibilidad 3608528850368400786036725 == 25

Soluciones

import Data.List (inits)

-- 1ª definición de ordenDeDivisibilidad
-- =====================================

ordenDeDivisibilidad :: Integer -> Int
ordenDeDivisibilidad n = 
    length (takeWhile (\(x,k) -> x `mod` k == 0) (zip (sucDigitos n) [1..]))

-- (sucDigitos x) es la sucesión de los dígitos de x. Por ejemplo,
--    sucDigitos 325    ==  [3,32,325]
--    sucDigitos 32050  ==  [3,32,320,3205,32050]
sucDigitos :: Integer -> [Integer]
sucDigitos n = 
    [n `div` (10^i) | i <- [k-1,k-2..0]]
    where k = length (show n)

-- 2ª definición de sucDigitos
sucDigitos2 :: Integer -> [Integer]
sucDigitos2 n = [read xs | xs <- aux (show n)]
    where aux []     = []
          aux (d:ds) = [d] : map (d:) (aux ds)

-- 3ª definición de sucDigitos
sucDigitos3 :: Integer -> [Integer]
sucDigitos3 n = 
    [read (take k ds) | k <- [1..length ds]]
    where ds = show n

-- 4ª definición de sucDigitos
sucDigitos4 :: Integer -> [Integer]
sucDigitos4 n = [read xs | xs <- tail (inits (show n))]

-- 5ª definición de sucDigitos
sucDigitos5 :: Integer -> [Integer]
sucDigitos5 n = map read (tail (inits (show n)))

-- 6ª definición de sucDigitos
sucDigitos6 :: Integer -> [Integer]
sucDigitos6 = map read . (tail . inits . show)

-- Eficiencia de las definiciones de sucDigitos
--    ghci> length (sucDigitos (10^5000))
--    5001
--    (0.01 secs, 1550688 bytes)
--    ghci> length (sucDigitos2 (10^5000))
--    5001
--    (1.25 secs, 729411872 bytes)
--    ghci> length (sucDigitos3 (10^5000))
--    5001
--    (0.02 secs, 2265120 bytes)
--    ghci> length (sucDigitos4 (10^5000))
--    5001
--    (1.10 secs, 728366872 bytes)
--    ghci> length (sucDigitos5 (10^5000))
--    5001
--    (1.12 secs, 728393864 bytes)
--    ghci> length (sucDigitos6 (10^5000))
--    5001
--    (1.20 secs, 728403052 bytes)
-- 
--    ghci> length (sucDigitos (10^3000000))
--    3000001
--    (2.73 secs, 820042696 bytes)
--    ghci> length (sucDigitos3 (10^3000000))
--    3000001
--    (3.69 secs, 820043688 bytes)

-- 2ª definición de ordenDeDivisibilidad
-- =====================================

ordenDeDivisibilidad :: Integer -> Int
ordenDeDivisibilidad x =
    length $ takeWhile (==0) $ zipWith (mod . read) (tail $ inits $ show x) [1..]

import Data.List (inits)

-- 1ª definición de ordenDeDivisibilidad

-- =====================================

ordenDeDivisibilidad :: Integer -> Int

ordenDeDivisibilidad n =

length (takeWhile (\(x,k) -> x `mod` k == 0) (zip (sucDigitos n) [1..]))

-- (sucDigitos x) es la sucesión de los dígitos de x. Por ejemplo,

-- sucDigitos 325 == [3,32,325]

-- sucDigitos 32050 == [3,32,320,3205,32050]

sucDigitos :: Integer -> [Integer]

sucDigitos n =

[n `div` (10^i) | i <- [k-1,k-2..0]]

where k = length (show n)

-- 2ª definición de sucDigitos

sucDigitos2 :: Integer -> [Integer]

sucDigitos2 n = [read xs | xs <- aux (show n)]

where aux [] = []

aux (d:ds) = [d] : map (d:) (aux ds)

-- 3ª definición de sucDigitos

sucDigitos3 :: Integer -> [Integer]

sucDigitos3 n =

[read (take k ds) | k <- [1..length ds]]

where ds = show n

-- 4ª definición de sucDigitos

sucDigitos4 :: Integer -> [Integer]

sucDigitos4 n = [read xs | xs <- tail (inits (show n))]

-- 5ª definición de sucDigitos

sucDigitos5 :: Integer -> [Integer]

sucDigitos5 n = map read (tail (inits (show n)))

-- 6ª definición de sucDigitos

sucDigitos6 :: Integer -> [Integer]

sucDigitos6 = map read . (tail . inits . show)

-- Eficiencia de las definiciones de sucDigitos

-- ghci> length (sucDigitos (10^5000))

-- 5001

-- (0.01 secs, 1550688 bytes)

-- ghci> length (sucDigitos2 (10^5000))

-- 5001

-- (1.25 secs, 729411872 bytes)

-- ghci> length (sucDigitos3 (10^5000))

-- 5001

-- (0.02 secs, 2265120 bytes)

-- ghci> length (sucDigitos4 (10^5000))

-- 5001

-- (1.10 secs, 728366872 bytes)

-- ghci> length (sucDigitos5 (10^5000))

-- 5001

-- (1.12 secs, 728393864 bytes)

-- ghci> length (sucDigitos6 (10^5000))

-- 5001

-- (1.20 secs, 728403052 bytes)

-- ghci> length (sucDigitos (10^3000000))

-- 3000001

-- (2.73 secs, 820042696 bytes)

-- ghci> length (sucDigitos3 (10^3000000))

-- 3000001

-- (3.69 secs, 820043688 bytes)

-- 2ª definición de ordenDeDivisibilidad

-- =====================================

ordenDeDivisibilidad :: Integer -> Int

ordenDeDivisibilidad x =

length $ takeWhile (==0) $ zipWith (mod . read) (tail $ inits $ show x) [1..]

Números con la misma cantidad de anteriores con 1 que sin 1

PorJosé A. Alonso 6-marzo-201513-marzo-2015

Una propiedad del número 24 es que entre los números menores o iguales que 24 hay la misma cantidad de números con el dígito 1 que sin el 1; en efecto, los que tienen 1 son

   [1, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 21]

1	[1, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 21]

y los que no lo tienen son

   [2,  3,  4,  5,  6,  7,  8,  9, 20, 22, 23, 24]

1	[2, 3, 4, 5, 6, 7, 8, 9, 20, 22, 23, 24]

Diremos que un número es especial si cumple dicha propiedad.

Definir la sucesión

   especiales :: [Integer]

1	especiales :: [Integer]

cuyos elementos son los números especiales. Por ejemplo,

   take 10 especiales  ==  [2,16,24,160,270,272,1456,3398,3418,3420]

1	take 10 especiales == [2,16,24,160,270,272,1456,3398,3418,3420]

Soluciones

import Data.List (genericLength)

especiales :: [Integer]
especiales = [n | n <- [2,4..], especial n]

especial :: Integer -> Bool
especial n = genericLength [x | x <- [1..n], '1' `elem` show x] == n `div` 2

import Data.List (genericLength)

especiales :: [Integer]

especiales = [n | n <- [2,4..], especial n]

especial :: Integer -> Bool

especial n = genericLength [x | x <- [1..n], '1' `elem` show x] == n `div` 2

Listas con los ceros emparejados

PorJosé A. Alonso 4-marzo-201511-marzo-2015

Sea S un conjunto de números. Las listas de ceros emparejados de S son las listas formadas con los elementos de S y en las cuales los ceros aparecen en sublistas de longitud par. Por ejemplo, si S = {0,1,2} entonces [1], [2], [2,1], [2,0,0,2,0,0,1] y [0,0,0,0,1,2] son listas de ceros emparejados de S; pero [0,0,0,2,1,0,0] y [0,0,1,0,1] no lo son.

Definir las funciones

   cerosEmparejados  :: Integer -> Integer -> [[Integer]]
   nCerosEmparejados :: Integer -> Integer -> Integer

1 2	cerosEmparejados :: Integer -> Integer -> [[Integer]] nCerosEmparejados :: Integer -> Integer -> Integer

tales que
+ (cerosEmparejados m n) es la lista de las listas de longitud n de ceros emparejados con los números 0, 1, 2,…, m. Por ejemplo,

     ghci> cerosEmparejados 2 0
     [[]]
     ghci> cerosEmparejados 2 1
     [[1],[2]]
     ghci> cerosEmparejados 3 1
     [[1],[2],[3]]
     ghci> cerosEmparejados 2 2
     [[1,1],[1,2],[2,1],[2,2],[0,0]]
     ghci> cerosEmparejados 2 3
     [[1,1,1],[1,1,2],[1,2,1],[1,2,2],[1,0,0],[2,1,1],[2,1,2],
      [2,2,1],[2,2,2],[2,0,0],[0,0,1],[0,0,2]]
     ghci> cerosEmparejados 2 4
     [[1,1,1,1],[1,1,1,2],[1,1,2,1],[1,1,2,2],[1,1,0,0],[1,2,1,1],
      [1,2,1,2],[1,2,2,1],[1,2,2,2],[1,2,0,0],[1,0,0,1],[1,0,0,2],
      [2,1,1,1],[2,1,1,2],[2,1,2,1],[2,1,2,2],[2,1,0,0],[2,2,1,1],
      [2,2,1,2],[2,2,2,1],[2,2,2,2],[2,2,0,0],[2,0,0,1],[2,0,0,2],
      [0,0,1,1],[0,0,1,2],[0,0,2,1],[0,0,2,2],[0,0,0,0]]

ghci> cerosEmparejados 2 0

[[]]

ghci> cerosEmparejados 2 1

[[1],[2]]

ghci> cerosEmparejados 3 1

[[1],[2],[3]]

ghci> cerosEmparejados 2 2

[[1,1],[1,2],[2,1],[2,2],[0,0]]

ghci> cerosEmparejados 2 3

[[1,1,1],[1,1,2],[1,2,1],[1,2,2],[1,0,0],[2,1,1],[2,1,2],

[2,2,1],[2,2,2],[2,0,0],[0,0,1],[0,0,2]]

ghci> cerosEmparejados 2 4

[[1,1,1,1],[1,1,1,2],[1,1,2,1],[1,1,2,2],[1,1,0,0],[1,2,1,1],

[1,2,1,2],[1,2,2,1],[1,2,2,2],[1,2,0,0],[1,0,0,1],[1,0,0,2],

[2,1,1,1],[2,1,1,2],[2,1,2,1],[2,1,2,2],[2,1,0,0],[2,2,1,1],

[2,2,1,2],[2,2,2,1],[2,2,2,2],[2,2,0,0],[2,0,0,1],[2,0,0,2],

[0,0,1,1],[0,0,1,2],[0,0,2,1],[0,0,2,2],[0,0,0,0]]

(nCerosEmparejados m n) es el número de listas de longitud n de ceros emparejados con los números 0, 1, 2,…, m. Por ejemplo,

     nCerosEmparejados 2 2   ==  5
     nCerosEmparejados 2 3   ==  12
     nCerosEmparejados 2 4   ==  29
     nCerosEmparejados 9 27  ==  79707842493701635611689499

nCerosEmparejados 2 2 == 5

nCerosEmparejados 2 3 == 12

nCerosEmparejados 2 4 == 29

nCerosEmparejados 9 27 == 79707842493701635611689499

Soluciones

import Data.List (genericIndex)
import Data.List (genericLength) 

cerosEmparejados :: Integer -> Integer -> [[Integer]]
cerosEmparejados m 0 = [[]]
cerosEmparejados m 1 = [[k] | k <- [1..m]]
cerosEmparejados m n = 
    [x:ys | x <- [1..m], ys <- cerosEmparejados m (n-1)] ++
    [0:0:ys | ys <- cerosEmparejados m (n-2)]

-- 1ª definición de nCerosEmparejados: 
nCerosEmparejados1 :: Integer -> Integer -> Integer
nCerosEmparejados1 m n = fromIntegral (length (cerosEmparejados m n))

-- 2ª definición de nCerosEmparejados: 
nCerosEmparejados2 :: Integer -> Integer -> Integer
nCerosEmparejados2 _ 0 = 1
nCerosEmparejados2 m 1 = m
nCerosEmparejados2 m n = 
    m * nCerosEmparejados2 m (n-1) + nCerosEmparejados2 m (n-2)

-- 3ª definición de nCerosEmparejados: 
nCerosEmparejados3 :: Integer -> Integer -> Integer
nCerosEmparejados3 m n = aux `genericIndex` n
    where aux = 1 : m : zipWith (\x y -> x+m*y) aux (tail aux)

-- Comparación de eficiencia
--    ghci> nCerosEmparejados1 9 7
--    5144589
--    (22.30 secs, 6556279384 bytes)
--    ghci> nCerosEmparejados2 9 7
--    5144589
--    (0.01 secs, 515464 bytes)
--    ghci> nCerosEmparejados3 9 7
--    5144589
--    (0.01 secs, 518104 bytes)
--
--    ghci> nCerosEmparejados2 9 33
--    45556060883025783396845717812863
--    (21.59 secs, 2676070480 bytes)
--    ghci> nCerosEmparejados3 9 33
--    45556060883025783396845717812863
--    (0.00 secs, 1017240 bytes)

import Data.List (genericIndex)

import Data.List (genericLength)

cerosEmparejados :: Integer -> Integer -> [[Integer]]

cerosEmparejados m 0 = [[]]

cerosEmparejados m 1 = [[k] | k <- [1..m]]

cerosEmparejados m n =

[x:ys | x <- [1..m], ys <- cerosEmparejados m (n-1)] ++

[0:0:ys | ys <- cerosEmparejados m (n-2)]

-- 1ª definición de nCerosEmparejados:

nCerosEmparejados1 :: Integer -> Integer -> Integer

nCerosEmparejados1 m n = fromIntegral (length (cerosEmparejados m n))

-- 2ª definición de nCerosEmparejados:

nCerosEmparejados2 :: Integer -> Integer -> Integer

nCerosEmparejados2 _ 0 = 1

nCerosEmparejados2 m 1 = m

nCerosEmparejados2 m n =

m * nCerosEmparejados2 m (n-1) + nCerosEmparejados2 m (n-2)

-- 3ª definición de nCerosEmparejados:

nCerosEmparejados3 :: Integer -> Integer -> Integer

nCerosEmparejados3 m n = aux `genericIndex` n

where aux = 1 : m : zipWith (\x y -> x+m*y) aux (tail aux)

-- Comparación de eficiencia

-- ghci> nCerosEmparejados1 9 7

-- 5144589

-- (22.30 secs, 6556279384 bytes)

-- ghci> nCerosEmparejados2 9 7

-- 5144589

-- (0.01 secs, 515464 bytes)

-- ghci> nCerosEmparejados3 9 7

-- 5144589

-- (0.01 secs, 518104 bytes)

-- ghci> nCerosEmparejados2 9 33

-- 45556060883025783396845717812863

-- (21.59 secs, 2676070480 bytes)

-- ghci> nCerosEmparejados3 9 33

-- 45556060883025783396845717812863

-- (0.00 secs, 1017240 bytes)

Productos simultáneos de dos y tres números consecutivos

PorJosé A. Alonso 3-marzo-201525-abril-2021

Definir la función

   productos :: Integer -> Integer -> [[Integer]]

1	productos :: Integer -> Integer -> [[Integer]]

tal que (productos n x) es las listas de n elementos consecutivos cuyo producto es x. Por ejemplo,

   productos 2 6     ==  [[2,3]]
   productos 3 6     ==  [[1,2,3]]
   productos 4 1680  ==  [[5,6,7,8]]
   productos 2 5     ==  []

productos 2 6 == [[2,3]]

productos 3 6 == [[1,2,3]]

productos 4 1680 == [[5,6,7,8]]

productos 2 5 == []

Comprobar con QuickCheck que si n > 0 y x > 0, entonces

   productos n (product [x..x+n-1]) == [[x..x+n-1]]

1	productos n (product [x..x+n-1]) == [[x..x+n-1]]

Usando productos, definir la función

   productosDe2y3consecutivos :: [Integer]

1	productosDe2y3consecutivos :: [Integer]

cuyos elementos son los números naturales (no nulos) que pueden expresarse simultáneamente como producto de dos y tres números consecutivos. Por ejemplo,

   head productosDe2y3consecutivos  ==  6

1	head productosDe2y3consecutivos == 6

Nota. Según demostró Mordell en 1962, productosDe2y3consecutivos sólo tiene dos elementos.

Soluciones

import Test.QuickCheck

-- 1ª definición
productos1 :: Integer -> Integer -> [[Integer]]
productos1 n x = [[y..y+n-1] | y <- [1..x],
                               product [y..y+n-1] == x]

-- 2ª definición
-- =============

-- Se puede reducir el intervalo de búsqueda teniendo en cuenta las
-- siguientes desigualdades
--    y*(y+1)* ... (y+n-1) = x
--    y^n <= x <= (y+n-1)^n
--    y <= x^(1/n), x^(1/n)-n+1 <= y
--    x^(1/n)-n+1 <= y <= x^(1/n)

productos2 :: Integer -> Integer -> [[Integer]]
productos2 n x = [[z..z+n-1] | z <- [y-n+1..y],
                               product [z..z+n-1] == x]
    where y = floor ((fromIntegral x)**(1/(fromIntegral n)))

productos :: Integer -> Integer -> [[Integer]]
productos = productos2

prop_productos n x =
    n > 0 && x > 0 ==> productos n (product [x..x+n-1]) == [[x..x+n-1]]

-- La comprobación es
--    ghci> quickCheck prop_productos
--    +++ OK, passed 100 tests.
--    (0.10 secs, 26409644 bytes)

productosDe2y3consecutivos :: [Integer]
productosDe2y3consecutivos = [x| x <- [1..], 
                                 let ys = productos 2 x,
                                 not (null ys), 
                                 let zs = productos 3 x,
                                 not (null zs)] 

-- El cálculo es
--    ghci> take 2 productosDe2y3consecutivos
--    [6,210]
--    ghci> productos 2 210
--    [[14,15]]
--    ghci> productos 3 210
--    [[5,6,7]]

import Test.QuickCheck

-- 1ª definición

productos1 :: Integer -> Integer -> [[Integer]]

productos1 n x = [[y..y+n-1] | y <- [1..x],

product [y..y+n-1] == x]

-- 2ª definición

-- =============

-- Se puede reducir el intervalo de búsqueda teniendo en cuenta las

-- siguientes desigualdades

-- y*(y+1)* ... (y+n-1) = x

-- y^n <= x <= (y+n-1)^n

-- y <= x^(1/n), x^(1/n)-n+1 <= y

-- x^(1/n)-n+1 <= y <= x^(1/n)

productos2 :: Integer -> Integer -> [[Integer]]

productos2 n x = [[z..z+n-1] | z <- [y-n+1..y],

product [z..z+n-1] == x]

where y = floor ((fromIntegral x)**(1/(fromIntegral n)))

productos :: Integer -> Integer -> [[Integer]]

productos = productos2

prop_productos n x =

n > 0 && x > 0 ==> productos n (product [x..x+n-1]) == [[x..x+n-1]]

-- La comprobación es

-- ghci> quickCheck prop_productos

-- +++ OK, passed 100 tests.

-- (0.10 secs, 26409644 bytes)

productosDe2y3consecutivos :: [Integer]

productosDe2y3consecutivos = [x| x <- [1..],

let ys = productos 2 x,

not (null ys),

let zs = productos 3 x,

not (null zs)]

-- El cálculo es

-- ghci> take 2 productosDe2y3consecutivos

-- [6,210]

-- ghci> productos 2 210

-- [[14,15]]

-- ghci> productos 3 210

-- [[5,6,7]]

Cálculo del número de islas rectangulares en una matriz

PorJosé A. Alonso 2-marzo-201525-abril-2021

En este problema se consideran matrices cuyos elementos son 0 y 1. Los valores 1 aparecen en forma de islas rectangulares separadas por 0 de forma que como máximo las islas son diagonalmente adyacentes. Por ejemplo,

   ej1, ej2 :: Array (Int,Int) Int
   ej1 = listArray ((1,1),(6,3))
                   [0,0,0,
                    1,1,0, 
                    1,1,0,
                    0,0,1,
                    0,0,1,
                    1,1,0]
   ej2 = listArray ((1,1),(6,6))
                   [1,0,0,0,0,0,
                    1,0,1,1,1,1,
                    0,0,0,0,0,0,
                    1,1,1,0,1,1,
                    1,1,1,0,1,1,
                    0,0,0,0,1,1]

ej1, ej2 :: Array (Int,Int) Int

ej1 = listArray ((1,1),(6,3))

[0,0,0,

1,1,0,

0,0,1,

1,1,0]

ej2 = listArray ((1,1),(6,6))

[1,0,0,0,0,0,

1,0,1,1,1,1,

0,0,0,0,0,0,

1,1,1,0,1,1,

0,0,0,0,1,1]

Definir la función

   numeroDeIslas :: Array (Int,Int) Int -> Int

1	numeroDeIslas :: Array (Int,Int) Int -> Int

tal que (numeroDeIslas p) es el número de islas de la matriz p. Por ejemplo,

   numeroDeIslas ej1  ==  3
   numeroDeIslas ej2  ==  4

1 2	numeroDeIslas ej1 == 3 numeroDeIslas ej2 == 4

Soluciones

import Data.Array

type Matriz = Array (Int,Int) Int

ej1, ej2 :: Array (Int,Int) Int
ej1 = listArray ((1,1),(6,3))
                [0,0,0,
                 1,1,0,
                 1,1,0,
                 0,0,1,
                 0,0,1,
                 1,1,0]
ej2 = listArray ((1,1),(6,6))
                [1,0,0,0,0,0,
                 1,0,1,1,1,1,
                 0,0,0,0,0,0,
                 1,1,1,0,1,1,
                 1,1,1,0,1,1,
                 0,0,0,0,1,1]

numeroDeIslas :: Array (Int,Int) Int -> Int
numeroDeIslas p = 
    length [(i,j) | (i,j) <- indices p, 
                     verticeSuperiorIzquierdo p (i,j)]

-- (verticeSuperiorIzquierdo p (i,j)) se verifica si (i,j) es el
-- vértice superior izquierdo de algunas de las islas de la matriz p,
-- Por ejemplo, 
--    ghci> [(i,j) | (i,j) <- indices ej1, verticeSuperiorIzquierdo ej1 (i,j)]
--    [(2,1),(4,3),(6,1)]
--    ghci> [(i,j) | (i,j) <- indices ej2, verticeSuperiorIzquierdo ej2 (i,j)]
--    [(1,1),(2,3),(4,1),(4,5)]
verticeSuperiorIzquierdo :: Matriz -> (Int,Int) -> Bool
verticeSuperiorIzquierdo p (i,j) =
    enLadoSuperior p (i,j) && enLadoIzquierdo p (i,j) 

-- (enLadoSuperior p (i,j)) se verifica si (i,j) está en el lado
-- superior de algunas de las islas de la matriz p, Por ejemplo,
--    ghci> [(i,j) | (i,j) <- indices ej1, enLadoSuperior ej1 (i,j)]
--    [(2,1),(2,2),(4,3),(6,1),(6,2)]
--    ghci> [(i,j) | (i,j) <- indices ej2, enLadoSuperior ej2 (i,j)]
--    [(1,1),(2,3),(2,4),(2,5),(2,6),(4,1),(4,2),(4,3),(4,5),(4,6)]
enLadoSuperior :: Matriz -> (Int,Int) -> Bool
enLadoSuperior p (1,j) = p!(1,j) == 1
enLadoSuperior p (i,j) = p!(i,j) == 1 && p!(i-1,j) == 0

-- (enLadoIzquierdo p (i,j)) se verifica si (i,j) está en el lado
-- izquierdo de algunas de las islas de la matriz p, Por ejemplo,
--    ghci> [(i,j) | (i,j) <- indices ej1, enLadoIzquierdo ej1 (i,j)]
--    [(2,1),(3,1),(4,3),(5,3),(6,1)]
--    ghci> [(i,j) | (i,j) <- indices ej2, enLadoIzquierdo ej2 (i,j)]
--    [(1,1),(2,1),(2,3),(4,1),(4,5),(5,1),(5,5),(6,5)]
enLadoIzquierdo :: Matriz -> (Int,Int) -> Bool
enLadoIzquierdo p (i,1) = p!(i,1) == 1
enLadoIzquierdo p (i,j) = p!(i,j) == 1 && p!(i,j-1) == 0

-- 2ª solución
-- ===========

numeroDeIslas2 :: Array (Int,Int) Int -> Int
numeroDeIslas2 p = 
    length [(i,j) | (i,j) <- indices p, 
                    p!(i,j) == 1,
                    i == 1 || p!(i-1,j) == 0,
                    j == 1 || p!(i,j-1) == 0]

import Data.Array

type Matriz = Array (Int,Int) Int

ej1, ej2 :: Array (Int,Int) Int

ej1 = listArray ((1,1),(6,3))

[0,0,0,

1,1,0,

0,0,1,

1,1,0]

ej2 = listArray ((1,1),(6,6))

[1,0,0,0,0,0,

1,0,1,1,1,1,

0,0,0,0,0,0,

1,1,1,0,1,1,

0,0,0,0,1,1]

numeroDeIslas :: Array (Int,Int) Int -> Int

numeroDeIslas p =

length [(i,j) | (i,j) <- indices p,

verticeSuperiorIzquierdo p (i,j)]

-- (verticeSuperiorIzquierdo p (i,j)) se verifica si (i,j) es el

-- vértice superior izquierdo de algunas de las islas de la matriz p,

-- Por ejemplo,

-- ghci> [(i,j) | (i,j) <- indices ej1, verticeSuperiorIzquierdo ej1 (i,j)]

-- [(2,1),(4,3),(6,1)]

-- ghci> [(i,j) | (i,j) <- indices ej2, verticeSuperiorIzquierdo ej2 (i,j)]

-- [(1,1),(2,3),(4,1),(4,5)]

verticeSuperiorIzquierdo :: Matriz -> (Int,Int) -> Bool

verticeSuperiorIzquierdo p (i,j) =

enLadoSuperior p (i,j) && enLadoIzquierdo p (i,j)

-- (enLadoSuperior p (i,j)) se verifica si (i,j) está en el lado

-- superior de algunas de las islas de la matriz p, Por ejemplo,

-- ghci> [(i,j) | (i,j) <- indices ej1, enLadoSuperior ej1 (i,j)]

-- [(2,1),(2,2),(4,3),(6,1),(6,2)]

-- ghci> [(i,j) | (i,j) <- indices ej2, enLadoSuperior ej2 (i,j)]

-- [(1,1),(2,3),(2,4),(2,5),(2,6),(4,1),(4,2),(4,3),(4,5),(4,6)]

enLadoSuperior :: Matriz -> (Int,Int) -> Bool

enLadoSuperior p (1,j) = p!(1,j) == 1

enLadoSuperior p (i,j) = p!(i,j) == 1 && p!(i-1,j) == 0

-- (enLadoIzquierdo p (i,j)) se verifica si (i,j) está en el lado

-- izquierdo de algunas de las islas de la matriz p, Por ejemplo,

-- ghci> [(i,j) | (i,j) <- indices ej1, enLadoIzquierdo ej1 (i,j)]

-- [(2,1),(3,1),(4,3),(5,3),(6,1)]

-- ghci> [(i,j) | (i,j) <- indices ej2, enLadoIzquierdo ej2 (i,j)]

-- [(1,1),(2,1),(2,3),(4,1),(4,5),(5,1),(5,5),(6,5)]

enLadoIzquierdo :: Matriz -> (Int,Int) -> Bool

enLadoIzquierdo p (i,1) = p!(i,1) == 1

enLadoIzquierdo p (i,j) = p!(i,j) == 1 && p!(i,j-1) == 0

-- 2ª solución

-- ===========

numeroDeIslas2 :: Array (Int,Int) Int -> Int

numeroDeIslas2 p =

length [(i,j) | (i,j) <- indices p,

p!(i,j) == 1,

i == 1 || p!(i-1,j) == 0,

j == 1 || p!(i,j-1) == 0]

Mayor diferencia progresiva

PorJosé A. Alonso 26-febrero-20151-mayo-2016

La diferencia progresiva entre dos elementos de una lista es la resta entre el que ocupa la mayor posición y la menor. Por ejemplo, en la lista [1,5,8,2,9] la diferencia entre los elementos 5 y 8 es 3 y entre 5 y 2 es -3.

Definir la función

   mayorDiferencia :: [Int] -> Int

1	mayorDiferencia :: [Int] -> Int

tal que (mayorDiferencia xs) es la mayor diferencia progresiva entre los elementos de xs. Por ejemplo,

   mayorDiferencia [1,5,8,2,9]  ==  8
   mayorDiferencia [9,5,8,2,1]  ==  3
   mayorDiferencia [7,2,6]      ==  4
   mayorDiferencia [3,2,1]      ==  0
   mayorDiferencia [1..10^7]    ==  9999999

mayorDiferencia [1,5,8,2,9] == 8

mayorDiferencia [9,5,8,2,1] == 3

mayorDiferencia [7,2,6] == 4

mayorDiferencia [3,2,1] == 0

mayorDiferencia [1..10^7] == 9999999

Soluciones

import Data.List (inits)

-- 1ª definición (por recursión):
mayorDiferencia :: [Int] -> Int
mayorDiferencia ([_])  = 0
mayorDiferencia (x:xs) = 
    max (maximum [y-x | y <- xs]) (mayorDiferencia xs) 

-- 2ª definición (por comprensión)
mayorDiferencia2 :: [Int] -> Int
mayorDiferencia2 xs = 
    maximum [x-y | (x,y) <- zip xs (map minimum (tail (inits xs)))]

-- 3ª definición:
mayorDiferencia3 :: [Int] -> Int
mayorDiferencia3 xs = maximum (zipWith (-) xs (scanl1 min xs))

-- 4ª definición:
mayorDiferencia4 :: [Int] -> Int
mayorDiferencia4 xs = maximum . zipWith (-) xs $ scanl1 min xs

-- Comparación de eficiencia
--    ghci> mayorDiferencia [1..3000]
--    2999
--    (3.43 secs, 943439560 bytes)
--    
--    ghci> mayorDiferencia2 [1..3000]
--    2999
--    (3.38 secs, 978359192 bytes)
--    
--    ghci> mayorDiferencia3 [1..3000]
--    2999
--    (0.01 secs, 2877960 bytes)
--    
--    ghci> mayorDiferencia4 [1..3000]
--    2999
--    (0.01 secs, 2062616 bytes)

import Data.List (inits)

-- 1ª definición (por recursión):

mayorDiferencia :: [Int] -> Int

mayorDiferencia ([_]) = 0

mayorDiferencia (x:xs) =

max (maximum [y-x | y <- xs]) (mayorDiferencia xs)

-- 2ª definición (por comprensión)

mayorDiferencia2 :: [Int] -> Int

mayorDiferencia2 xs =

maximum [x-y | (x,y) <- zip xs (map minimum (tail (inits xs)))]

-- 3ª definición:

mayorDiferencia3 :: [Int] -> Int

mayorDiferencia3 xs = maximum (zipWith (-) xs (scanl1 min xs))

-- 4ª definición:

mayorDiferencia4 :: [Int] -> Int

mayorDiferencia4 xs = maximum . zipWith (-) xs $ scanl1 min xs

-- Comparación de eficiencia

-- ghci> mayorDiferencia [1..3000]

-- 2999

-- (3.43 secs, 943439560 bytes)

-- ghci> mayorDiferencia2 [1..3000]

-- 2999

-- (3.38 secs, 978359192 bytes)

-- ghci> mayorDiferencia3 [1..3000]

-- 2999

-- (0.01 secs, 2877960 bytes)

-- ghci> mayorDiferencia4 [1..3000]

-- 2999

-- (0.01 secs, 2062616 bytes)

Mínimo número de cambios para igualar una lista

PorJosé A. Alonso 23-febrero-201525-abril-2021

Definir la función

   nMinimoCambios :: Ord a => [a] -> Int

1	nMinimoCambios :: Ord a => [a] -> Int

tal que (nMinimoCambios xs) es el menor número de elementos de xs que hay que cambiar para que todos sean iguales. Por ejemplo,

   nMinimoCambios [3,5,3,7,9,6]      ==  4
   nMinimoCambios [3,5,3,7,3,3]      ==  2
   nMinimoCambios "Salamanca"        ==  5
   nMinimoCambios (4 : [1..500000])  ==  499999

nMinimoCambios [3,5,3,7,9,6] == 4

nMinimoCambios [3,5,3,7,3,3] == 2

nMinimoCambios "Salamanca" == 5

nMinimoCambios (4 : [1..500000]) == 499999

En el primer ejemplo, los elementos que hay que cambiar son 5, 7, 9 y 6.

Soluciones

import Data.List (group, nub, sort)

-- 1ª definición
-- =============

nMinimoCambios1 :: Ord a => [a] -> Int
nMinimoCambios1 xs = 
    length xs - fst (last (sort (frecuencias xs)))

-- (frecuencias xs) es la lista de los pares de los elementos de xs y el
-- número de veces que ocurren en xs. Por ejemplo,
--    frecuencias [3,5,3,7,9,6]  ==  [(2,3),(1,5),(1,7),(1,9),(1,6)]
--    frecuencias [3,5,3,7,5,5]  ==  [(2,3),(3,5),(1,7)]
frecuencias :: Ord a => [a] -> [(Int,a)]
frecuencias xs = [(cuenta x xs,x) | x <- nub xs]

-- (cuenta x ys) es el número de veces que ocurre x en ys. Por ejemplo,
--    cuenta 3 [3,5,3,7,9,6]  ==  2
cuenta :: Ord a => a -> [a] -> Int
cuenta x ys = length [y | y <- ys, y == x]

-- 2ª definición
-- =============

nMinimoCambios2 :: Ord a => [a] -> Int
nMinimoCambios2 xs = 
    length xs - fst (last (sort (frecuencias2 xs)))

-- (frecuencias2 xs) es la lista de los pares de los elementos de xs y el
-- número de veces que ocurren en xs. Por ejemplo,
--    frecuencias2 [3,5,3,7,9,6]  ==  [(2,3),(1,5),(1,7),(1,9),(1,6)]
--    frecuencias2 [3,5,3,7,5,5]  ==  [(2,3),(3,5),(1,7)]
frecuencias2 :: Ord a  => [a] -> [(Int,a)]
frecuencias2 xs = 
    [(1 + length ys, y) | (y:ys) <- group (sort xs)] 

-- 3ª definición
-- =============

nMinimoCambios3 :: Ord a => [a] -> Int
nMinimoCambios3 xs = sum ys - maximum ys
    where ys = [length ys | ys <- group (sort xs)]

import Data.List (group, nub, sort)

-- 1ª definición

-- =============

nMinimoCambios1 :: Ord a => [a] -> Int

nMinimoCambios1 xs =

length xs - fst (last (sort (frecuencias xs)))

-- (frecuencias xs) es la lista de los pares de los elementos de xs y el

-- número de veces que ocurren en xs. Por ejemplo,

-- frecuencias [3,5,3,7,9,6] == [(2,3),(1,5),(1,7),(1,9),(1,6)]

-- frecuencias [3,5,3,7,5,5] == [(2,3),(3,5),(1,7)]

frecuencias :: Ord a => [a] -> [(Int,a)]

frecuencias xs = [(cuenta x xs,x) | x <- nub xs]

-- (cuenta x ys) es el número de veces que ocurre x en ys. Por ejemplo,

-- cuenta 3 [3,5,3,7,9,6] == 2

cuenta :: Ord a => a -> [a] -> Int

cuenta x ys = length [y | y <- ys, y == x]

-- 2ª definición

-- =============

nMinimoCambios2 :: Ord a => [a] -> Int

nMinimoCambios2 xs =

length xs - fst (last (sort (frecuencias2 xs)))

-- (frecuencias2 xs) es la lista de los pares de los elementos de xs y el

-- número de veces que ocurren en xs. Por ejemplo,

-- frecuencias2 [3,5,3,7,9,6] == [(2,3),(1,5),(1,7),(1,9),(1,6)]

-- frecuencias2 [3,5,3,7,5,5] == [(2,3),(3,5),(1,7)]

frecuencias2 :: Ord a => [a] -> [(Int,a)]

frecuencias2 xs =

[(1 + length ys, y) | (y:ys) <- group (sort xs)]

-- 3ª definición

-- =============

nMinimoCambios3 :: Ord a => [a] -> Int

nMinimoCambios3 xs = sum ys - maximum ys

where ys = [length ys | ys <- group (sort xs)]

Diagonales secundarias de una matriz

PorJosé A. Alonso 20-febrero-201526-abril-2015

Definir la función

   diagonalesSecundarias :: Matriz a -> [[a]]

1	diagonalesSecundarias :: Matriz a -> [[a]]

tal que (diagonalesSecundarias p) es la lista de las diagonales secundarias de p. Por ejemplo, para la matriz

   1  2  3  4
   5  6  7  8
   9 10 11 12

1 2 3 4

5 6 7 8

9 10 11 12

la lista de sus diagonales secundarias es

   [[1],[2,5],[3,6,9],[4,7,10],[8,11],[12]]

1	[[1],[2,5],[3,6,9],[4,7,10],[8,11],[12]]

En Haskell,

   ghci> diagonalesSecundarias (listArray ((1,1),(3,4)) [1..12])
   [[1],[2,5],[3,6,9],[4,7,10],[8,11],[12]]

1 2	ghci> diagonalesSecundarias (listArray ((1,1),(3,4)) [1..12]) [[1],[2,5],[3,6,9],[4,7,10],[8,11],[12]]

Soluciones

import Data.Array

type Matriz a = Array (Int,Int) a

diagonalesSecundarias :: Matriz a -> [[a]]
diagonalesSecundarias p = 
    [[p!ij1 | ij1 <- extension ij] | ij <- iniciales]
    where (_,(m,n)) = bounds p
          iniciales = [(1,j) | j <- [1..n]] ++ [(i,n) | i <- [2..m]] 
          extension (i,j) = [(i+k,j-k) | k <- [0..min (j-1) (m-i)]]

import Data.Array

type Matriz a = Array (Int,Int) a

diagonalesSecundarias :: Matriz a -> [[a]]

diagonalesSecundarias p =

[[p!ij1 | ij1 <- extension ij] | ij <- iniciales]

where (_,(m,n)) = bounds p

iniciales = [(1,j) | j <- [1..n]] ++ [(i,n) | i <- [2..m]]

extension (i,j) = [(i+k,j-k) | k <- [0..min (j-1) (m-i)]]

Menor número triangular con más de n divisores

PorJosé A. Alonso 6-febrero-201525-abril-2021

La sucesión de los números triangulares se obtiene sumando los números naturales.

Así, el 7º número triangular es

   1 + 2 + 3 + 4 + 5 + 6 + 7 = 28.

1	1 + 2 + 3 + 4 + 5 + 6 + 7 = 28.

Los primeros 10 números triangulares son

   1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...

1	1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...

Los divisores de los primeros 7 números triangulares son:

    1: 1
    3: 1,3
    6: 1,2,3,6
   10: 1,2,5,10
   15: 1,3,5,15
   21: 1,3,7,21
   28: 1,2,4,7,14,28

1: 1

3: 1,3

6: 1,2,3,6

10: 1,2,5,10

15: 1,3,5,15

21: 1,3,7,21

28: 1,2,4,7,14,28

Como se puede observar, 28 es el menor número triangular con más de 5 divisores.

Definir la función

   menorTriangularConAlMenosNDivisores :: Int -> Integer

1	menorTriangularConAlMenosNDivisores :: Int -> Integer

tal que (menorTriangularConAlMenosNDivisores n) es el menor número triangular que tiene al menos n divisores. Por ejemplo,

   menorTriangularConAlMenosNDivisores 5    ==  28
   menorTriangularConAlMenosNDivisores 50   ==  25200
   menorTriangularConAlMenosNDivisores 500  ==  76576500

menorTriangularConAlMenosNDivisores 5 == 28

menorTriangularConAlMenosNDivisores 50 == 25200

menorTriangularConAlMenosNDivisores 500 == 76576500

Soluciones

import Data.List (group)
import Data.Numbers.Primes (primes,primeFactors)

-- 1ª definición
-- =============

menorTriangularConAlMenosNDivisores1 :: Int -> Integer
menorTriangularConAlMenosNDivisores1 n = 
    head [x | x <- triangulares, nDivisores x >= n]

-- triangulares es la sucesión de los números triangulares. Por ejemplo,
--    take 10 triangulares  ==  [1,3,6,10,15,21,28,36,45,55]
triangulares :: [Integer]
triangulares = scanl (+) 1 [2..]

-- (nDivisores x) es el número de divisores de x. Por ejemplo,
--    nDivisores 28  ==  6
nDivisores :: Integer -> Int
nDivisores x = 
    1 + length [y | y <- [1..x `div` 2], mod x y == 0]

-- 2ª solución
-- ===========

menorTriangularConAlMenosNDivisores2 :: Int -> Integer
menorTriangularConAlMenosNDivisores2 n = 
    head [x | x <- triangulares, nDivisores2 x >= n]

-- (nDivisores2 x) es el número de divisores de x. Por ejemplo,
--    nDivisores2 28  ==  6
nDivisores2 :: Integer -> Int
nDivisores2 n = product [1 + length xs | xs <- group (factoresPrimos n)]    

-- (factoresPrimos n) es la lista de los factores primos de n. Por
-- ejemplo, 
--    factoresPrimos 28  ==  [2,2,7]
factoresPrimos :: Integer -> [Integer]
factoresPrimos n = aux n primos
    where aux n (p:ps) 
              | p*p > n        = [n]
              | n `mod` p == 0 = p : aux (n `div` p) (p:ps)
              | otherwise      = aux n ps

-- primos es la lista de los números primos. Por ejemplo,
--    take 10 primos  ==  [2,3,5,7,11,13,17,19,23,29]
primos :: [Integer]
primos = 2 : filter ((==1) . length . factoresPrimos) [3,5..]

-- 3ª solución (usando primes)
-- ===========================

menorTriangularConAlMenosNDivisores3 :: Int -> Integer
menorTriangularConAlMenosNDivisores3 n = 
    head [x | x <- triangulares, nDivisores3 x >= n]

-- (nDivisores3 x) es el número de divisores de x. Por ejemplo,
--    nDivisores3 28  ==  6
nDivisores3 :: Integer -> Int
nDivisores3 n = product [1 + length xs | xs <- group (factoresPrimos3 n)]    

-- (factoresPrimos3 n) es la lista de los factores primos de n. Por
-- ejemplo, 
--    factoresPrimos3 28  ==  [2,2,7]
factoresPrimos3 n = aux n primes
  where
    aux n (p:ps) 
        | p*p > n        = [n]
        | n `mod` p == 0 = p : aux (n `div` p) (p:ps)
        | otherwise      = aux n ps

-- 4ª solución (usando primeFactors)
-- =================================

menorTriangularConAlMenosNDivisores4 :: Int -> Integer
menorTriangularConAlMenosNDivisores4 n = 
    head [x | x <- triangulares, nDivisores4 x >= n]

-- (nDivisores4 x) es el número de divisores de x. Por ejemplo,
--    nDivisores4 28  ==  6
nDivisores4 :: Integer -> Int
nDivisores4 n = product [1 + length xs | xs <- group (primeFactors n)]    

-- ---------------------------------------------------------------------
-- § Comparación de eficiencia                                        --
-- ---------------------------------------------------------------------

-- La comparación es
--    ghci> menorTriangularConAlMenosNDivisores1 50
--    25200
--    (1.25 secs, 200236512 bytes)
--    
--    ghci> menorTriangularConAlMenosNDivisores2 50
--    25200
--    (0.02 secs, 4199904 bytes)
--    
--    ghci> menorTriangularConAlMenosNDivisores3 50
--    25200
--    (0.03 secs, 6265128 bytes)
--    
--    ghci> menorTriangularConAlMenosNDivisores4 50
--    25200
--    (0.01 secs, 5753048 bytes)

100

101

102

import Data.List (group)

import Data.Numbers.Primes (primes,primeFactors)

-- 1ª definición

-- =============

menorTriangularConAlMenosNDivisores1 :: Int -> Integer

menorTriangularConAlMenosNDivisores1 n =

head [x | x <- triangulares, nDivisores x >= n]

-- triangulares es la sucesión de los números triangulares. Por ejemplo,

-- take 10 triangulares == [1,3,6,10,15,21,28,36,45,55]

triangulares :: [Integer]

triangulares = scanl (+) 1 [2..]

-- (nDivisores x) es el número de divisores de x. Por ejemplo,

-- nDivisores 28 == 6

nDivisores :: Integer -> Int

nDivisores x =

1 + length [y | y <- [1..x `div` 2], mod x y == 0]

-- 2ª solución

-- ===========

menorTriangularConAlMenosNDivisores2 :: Int -> Integer

menorTriangularConAlMenosNDivisores2 n =

head [x | x <- triangulares, nDivisores2 x >= n]

-- (nDivisores2 x) es el número de divisores de x. Por ejemplo,

-- nDivisores2 28 == 6

nDivisores2 :: Integer -> Int

nDivisores2 n = product [1 + length xs | xs <- group (factoresPrimos n)]

-- (factoresPrimos n) es la lista de los factores primos de n. Por

-- ejemplo,

-- factoresPrimos 28 == [2,2,7]

factoresPrimos :: Integer -> [Integer]

factoresPrimos n = aux n primos

where aux n (p:ps)

| p*p > n = [n]

| n `mod` p == 0 = p : aux (n `div` p) (p:ps)

| otherwise = aux n ps

-- primos es la lista de los números primos. Por ejemplo,

-- take 10 primos == [2,3,5,7,11,13,17,19,23,29]

primos :: [Integer]

primos = 2 : filter ((==1) . length . factoresPrimos) [3,5..]

-- 3ª solución (usando primes)

-- ===========================

menorTriangularConAlMenosNDivisores3 :: Int -> Integer

menorTriangularConAlMenosNDivisores3 n =

head [x | x <- triangulares, nDivisores3 x >= n]

-- (nDivisores3 x) es el número de divisores de x. Por ejemplo,

-- nDivisores3 28 == 6

nDivisores3 :: Integer -> Int

nDivisores3 n = product [1 + length xs | xs <- group (factoresPrimos3 n)]

-- (factoresPrimos3 n) es la lista de los factores primos de n. Por

-- ejemplo,

-- factoresPrimos3 28 == [2,2,7]

factoresPrimos3 n = aux n primes

where

aux n (p:ps)

| p*p > n = [n]

| n `mod` p == 0 = p : aux (n `div` p) (p:ps)

| otherwise = aux n ps

-- 4ª solución (usando primeFactors)

-- =================================

menorTriangularConAlMenosNDivisores4 :: Int -> Integer

menorTriangularConAlMenosNDivisores4 n =

head [x | x <- triangulares, nDivisores4 x >= n]

-- (nDivisores4 x) es el número de divisores de x. Por ejemplo,

-- nDivisores4 28 == 6

nDivisores4 :: Integer -> Int

nDivisores4 n = product [1 + length xs | xs <- group (primeFactors n)]

-- ---------------------------------------------------------------------

-- § Comparación de eficiencia --

-- ---------------------------------------------------------------------

-- La comparación es

-- ghci> menorTriangularConAlMenosNDivisores1 50

-- 25200

-- (1.25 secs, 200236512 bytes)

-- ghci> menorTriangularConAlMenosNDivisores2 50

-- 25200

-- (0.02 secs, 4199904 bytes)

-- ghci> menorTriangularConAlMenosNDivisores3 50

-- 25200

-- (0.03 secs, 6265128 bytes)

-- ghci> menorTriangularConAlMenosNDivisores4 50

-- 25200

-- (0.01 secs, 5753048 bytes)

Mayor capicúa producto de dos números de n cifras

PorJosé A. Alonso 3-febrero-201525-abril-2021

Un capicúa es un número que es igual leído de izquierda a derecha que de derecha a izquierda.

Definir la función

   mayorCapicuaP :: Integer -> Integer

1	mayorCapicuaP :: Integer -> Integer

tal que (mayorCapicuaP n) es el mayor capicúa que es el producto de dos números de n cifras. Por ejemplo,

   mayorCapicuaP 2  ==  9009
   mayorCapicuaP 3  ==  906609
   mayorCapicuaP 4  ==  99000099
   mayorCapicuaP 5  ==  9966006699

mayorCapicuaP 2 == 9009

mayorCapicuaP 3 == 906609

mayorCapicuaP 4 == 99000099

mayorCapicuaP 5 == 9966006699

Soluciones

-- 1ª solución
-- ===========

mayorCapicuaP1 :: Integer -> Integer
mayorCapicuaP1 n = head (capicuasP n)

-- (capicuasP n) es la lista de las capicúas de 2*n cifras que
-- pueden escribirse como productos de dos números de n cifras. Por
-- ejemplo, Por ejemplo,
--    ghci> capicuasP 2
--    [9009,8448,8118,8008,7227,7007,6776,6336,6006,5775,5445,5335,
--     5225,5115,5005,4884,4774,4664,4554,4224,4004,3773,3663,3003,
--     2992,2772,2552,2442,2332,2112,2002,1881,1771,1551,1221,1001]
capicuasP n = [x | x <- capicuas n,
                        not (null (productosDosNumerosCifras n x))]

-- (capicuas n) es la lista de las capicúas de 2*n cifras de mayor a
-- menor. Por ejemplo, 
--    capicuas 1           ==  [99,88,77,66,55,44,33,22,11]
--    take 7 (capicuas 2)  ==  [9999,9889,9779,9669,9559,9449,9339]
capicuas :: Integer -> [Integer]
capicuas n = [capicua x | x <- numerosCifras n]

-- (numerosCifras n) es la lista de los números de n cifras de mayor a
-- menor. Por ejemplo,
--    numerosCifras 1           ==  [9,8,7,6,5,4,3,2,1]
--    take 7 (numerosCifras 2)  ==  [99,98,97,96,95,94,93]
--    take 7 (numerosCifras 3)  ==  [999,998,997,996,995,994,993]
numerosCifras :: Integer -> [Integer]
numerosCifras n = [a,a-1..b]
    where a = 10^n-1
          b = 10^(n-1) 

-- (capicua n) es la capicúa formada añadiendo el inverso de n a
--  continuación de n. Por ejemplo,
--    capicua 93  ==  9339
capicua :: Integer -> Integer
capicua n = read (xs ++ (reverse xs))
    where xs = show n

-- (productosDosNumerosCifras n x) es la lista de los números y de n
-- cifras tales que existe un z de n cifras y x es el producto de y por
-- z. Por ejemplo, 
--    productosDosNumerosCifras 2 9009  ==  [99,91]
productosDosNumerosCifras n x = [y | y <- numeros,
                                     mod x y == 0,
                                     div x y `elem` numeros]
    where numeros = numerosCifras n

-- 2ª solución
-- ===========

mayorCapicuaP2 :: Integer -> Integer
mayorCapicuaP2 n = maximum [x*y | x <- [a,a-1..b],
                                  y <- [a,a-1..b],
                                  esCapicua (x*y)] 
    where a = 10^n-1
          b = 10^(n-1)

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 353  ==  True
--    esCapicua 357  ==  False
esCapicua :: Integer -> Bool
esCapicua n = xs == reverse xs
    where xs = show n

-- 3ª solución
-- ===========

mayorCapicuaP3 :: Integer -> Integer
mayorCapicuaP3 n = maximum [x*y | (x,y) <- pares a b, 
                                  esCapicua (x*y)] 
     where a = 10^n-1
           b = 10^(n-1)

-- (pares a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares a b = [(x,z-x) | z <- [a1,a1-1..b1],
                       x <- [a,a-1..b],
                       x <= z-x, z-x <= a]
            where a1 = 2*a
                  b1 = 2*b

-- 4ª solución
-- ===========

mayorCapicuaP4 :: Integer -> Integer
mayorCapicuaP4 n = maximum [x | y <- [a..b],
                                z <- [y..b],
                                let x = y * z,
                                let s = show x,
                                s == reverse s]
     where a = 10^(n-1)
           b = 10^n-1
     
-- 5ª solución
-- ===========

mayorCapicuaP5 :: Integer -> Integer
mayorCapicuaP5 n = maximum [x*y | (x,y) <- pares2 b a, esCapicua (x*y)]
     where a = 10^(n-1)
           b = 10^n-1
                       
-- (pares2 a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares2 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares2 a b = [(x,y) | x <- [a,a-1..b], y <- [a,a-1..x]]

-- 6ª solución
-- ===========

mayorCapicuaP6 :: Integer -> Integer
mayorCapicuaP6 n = maximum [x*y | x <- [a..b], 
                                  y <- [x..b] , 
                                  esCapicua (x*y)]
     where a = 10^(n-1)
           b = 10^n-1
 
-- (cifras n) es la lista de las cifras de n en orden inverso. Por
-- ejemplo,  
--    cifras 325  == [5,2,3]
cifras :: Integer -> [Integer]
cifras n 
    | n < 10    = [n]
    | otherwise = (ultima n) : (cifras (quitarUltima n))

-- (ultima n) es la última cifra de n. Por ejemplo,
--    ultima 325  ==  5
ultima  :: Integer -> Integer
ultima n =  n - (n `div` 10)*10

-- (quitarUltima n) es el número obtenido al quitarle a n su última
-- cifra. Por ejemplo,
--    quitarUltima 325  =>  32 
quitarUltima :: Integer -> Integer
quitarUltima n = (n - (ultima n)) `div` 10

-- 7ª solución
-- ===========

mayorCapicuaP7 :: Integer -> Integer
mayorCapicuaP7 n = head [x | x <- capicuas n, esFactorizable x n]

-- (esFactorizable x n) se verifica si x se puede escribir como producto
-- de dos números de n dígitos. Por ejemplo,
--    esFactorizable 1219 2  ==  True
--    esFactorizable 1217 2  ==  False
esFactorizable x n = aux i x
    where b = 10^n-1
          i = floor (sqrt (fromIntegral x))
          aux i x | i > b          = False
                  | x `mod` i == 0 = x `div` i < b 
                  | otherwise      = aux (i+1) x

-- ---------------------------------------------------------------------
-- Comparación de soluciones                                          --
-- ---------------------------------------------------------------------

-- Tiempo (en segundos) de cálculo de (mayorCapicuaP n) con las 7
-- definiciones
--    +------+------+------+------+
--    | Def. | 2    | 3    | 4    |
--    |------+------+------+------|
--    |    1 | 0.01 | 0.13 | 1.39 |
--    |    2 | 0.03 | 2.07 |      |
--    |    3 | 0.05 | 3.86 |      |
--    |    4 | 0.01 | 0.89 |      |
--    |    5 | 0.03 | 1.23 |      |
--    |    6 | 0.02 | 1.03 |      |
--    |    7 | 0.01 | 0.02 | 0.02 |
--    +------+------+------+------+

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

-- 1ª solución

-- ===========

mayorCapicuaP1 :: Integer -> Integer

mayorCapicuaP1 n = head (capicuasP n)

-- (capicuasP n) es la lista de las capicúas de 2*n cifras que

-- pueden escribirse como productos de dos números de n cifras. Por

-- ejemplo, Por ejemplo,

-- ghci> capicuasP 2

-- [9009,8448,8118,8008,7227,7007,6776,6336,6006,5775,5445,5335,

-- 5225,5115,5005,4884,4774,4664,4554,4224,4004,3773,3663,3003,

-- 2992,2772,2552,2442,2332,2112,2002,1881,1771,1551,1221,1001]

capicuasP n = [x | x <- capicuas n,

not (null (productosDosNumerosCifras n x))]

-- (capicuas n) es la lista de las capicúas de 2*n cifras de mayor a

-- menor. Por ejemplo,

-- capicuas 1 == [99,88,77,66,55,44,33,22,11]

-- take 7 (capicuas 2) == [9999,9889,9779,9669,9559,9449,9339]

capicuas :: Integer -> [Integer]

capicuas n = [capicua x | x <- numerosCifras n]

-- (numerosCifras n) es la lista de los números de n cifras de mayor a

-- menor. Por ejemplo,

-- numerosCifras 1 == [9,8,7,6,5,4,3,2,1]

-- take 7 (numerosCifras 2) == [99,98,97,96,95,94,93]

-- take 7 (numerosCifras 3) == [999,998,997,996,995,994,993]

numerosCifras :: Integer -> [Integer]

numerosCifras n = [a,a-1..b]

where a = 10^n-1

b = 10^(n-1)

-- (capicua n) es la capicúa formada añadiendo el inverso de n a

-- continuación de n. Por ejemplo,

-- capicua 93 == 9339

capicua :: Integer -> Integer

capicua n = read (xs ++ (reverse xs))

where xs = show n

-- (productosDosNumerosCifras n x) es la lista de los números y de n

-- cifras tales que existe un z de n cifras y x es el producto de y por

-- z. Por ejemplo,

-- productosDosNumerosCifras 2 9009 == [99,91]

productosDosNumerosCifras n x = [y | y <- numeros,

mod x y == 0,

div x y `elem` numeros]

where numeros = numerosCifras n

-- 2ª solución

-- ===========

mayorCapicuaP2 :: Integer -> Integer

mayorCapicuaP2 n = maximum [x*y | x <- [a,a-1..b],

y <- [a,a-1..b],

esCapicua (x*y)]

where a = 10^n-1

b = 10^(n-1)

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,

-- esCapicua 353 == True

-- esCapicua 357 == False

esCapicua :: Integer -> Bool

esCapicua n = xs == reverse xs

where xs = show n

-- 3ª solución

-- ===========

mayorCapicuaP3 :: Integer -> Integer

mayorCapicuaP3 n = maximum [x*y | (x,y) <- pares a b,

esCapicua (x*y)]

where a = 10^n-1

b = 10^(n-1)

-- (pares a b) es la lista de los pares de números entre a y b de forma

-- que su suma es decreciente. Por ejemplo,

-- pares 9 7 == [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]

pares a b = [(x,z-x) | z <- [a1,a1-1..b1],

x <- [a,a-1..b],

x <= z-x, z-x <= a]

where a1 = 2*a

b1 = 2*b

-- 4ª solución

-- ===========

mayorCapicuaP4 :: Integer -> Integer

mayorCapicuaP4 n = maximum [x | y <- [a..b],

z <- [y..b],

let x = y * z,

let s = show x,

s == reverse s]

where a = 10^(n-1)

b = 10^n-1

-- 5ª solución

-- ===========

mayorCapicuaP5 :: Integer -> Integer

mayorCapicuaP5 n = maximum [x*y | (x,y) <- pares2 b a, esCapicua (x*y)]

where a = 10^(n-1)

b = 10^n-1

-- (pares2 a b) es la lista de los pares de números entre a y b de forma

-- que su suma es decreciente. Por ejemplo,

-- pares2 9 7 == [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]

pares2 a b = [(x,y) | x <- [a,a-1..b], y <- [a,a-1..x]]

-- 6ª solución

-- ===========

mayorCapicuaP6 :: Integer -> Integer

mayorCapicuaP6 n = maximum [x*y | x <- [a..b],

y <- [x..b] ,

esCapicua (x*y)]

where a = 10^(n-1)

b = 10^n-1

-- (cifras n) es la lista de las cifras de n en orden inverso. Por

-- ejemplo,

-- cifras 325 == [5,2,3]

cifras :: Integer -> [Integer]

cifras n

| n < 10 = [n]

| otherwise = (ultima n) : (cifras (quitarUltima n))

-- (ultima n) es la última cifra de n. Por ejemplo,

-- ultima 325 == 5

ultima :: Integer -> Integer

ultima n = n - (n `div` 10)*10

-- (quitarUltima n) es el número obtenido al quitarle a n su última

-- cifra. Por ejemplo,

-- quitarUltima 325 => 32

quitarUltima :: Integer -> Integer

quitarUltima n = (n - (ultima n)) `div` 10

-- 7ª solución

-- ===========

mayorCapicuaP7 :: Integer -> Integer

mayorCapicuaP7 n = head [x | x <- capicuas n, esFactorizable x n]

-- (esFactorizable x n) se verifica si x se puede escribir como producto

-- de dos números de n dígitos. Por ejemplo,

-- esFactorizable 1219 2 == True

-- esFactorizable 1217 2 == False

esFactorizable x n = aux i x

where b = 10^n-1

i = floor (sqrt (fromIntegral x))

aux i x | i > b = False

| x `mod` i == 0 = x `div` i < b

| otherwise = aux (i+1) x

-- ---------------------------------------------------------------------

-- Comparación de soluciones --

-- ---------------------------------------------------------------------

-- Tiempo (en segundos) de cálculo de (mayorCapicuaP n) con las 7

-- definiciones

-- +------+------+------+------+

-- | Def. | 2 | 3 | 4 |

-- |------+------+------+------|

-- | 1 | 0.01 | 0.13 | 1.39 |

-- | 2 | 0.03 | 2.07 | |

-- | 3 | 0.05 | 3.86 | |

-- | 4 | 0.01 | 0.89 | |

-- | 5 | 0.03 | 1.23 | |

-- | 6 | 0.02 | 1.03 | |

-- | 7 | 0.01 | 0.02 | 0.02 |

-- +------+------+------+------+

Soluciones

Soluciones

Soluciones

Referencia

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico