José A. Alonso

Los números de Smith

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

Un número de Smith es un número natural compuesto que cumple que la suma de sus dígitos es igual a la suma de los dígitos de todos sus factores primos (si tenemos algún factor primo repetido lo sumamos tantas veces como aparezca). Por ejemplo, el 22 es un número de Smith ya que

    22 = 2*11 y
   2+2 = 2+(1+1)

1 2	22 = 2*11 y 2+2 = 2+(1+1)

y el 4937775 también lo es ya que

   4937775       = 3*5*5*65837 y 
   4+9+3+7+7+7+5 = 3+5+5+(6+5+8+3+7)

1 2	4937775 = 355*65837 y 4+9+3+7+7+7+5 = 3+5+5+(6+5+8+3+7)

Definir las funciones

   esSmith :: Integer -> Bool
   smith :: [Integer]

1 2	esSmith :: Integer -> Bool smith :: [Integer]

tales que

(esSmith x) se verifica si x es un número de Smith. Por ejemplo,

     esSmith 22          ==  True
     esSmith 29          ==  False
     esSmith 2015        ==  False
     esSmith 4937775     ==  True
     esSmith 4567597056  ==  True

esSmith 22 == True

esSmith 29 == False

esSmith 2015 == False

esSmith 4937775 == True

esSmith 4567597056 == True

smith es la lista cuyos elementos son los números de Smith. Por ejemplo,

     λ> take 17 smith
     [4,22,27,58,85,94,121,166,202,265,274,319,346,355,378,382,391]
     λ> smith !! 2000
     62158

λ> take 17 smith

[4,22,27,58,85,94,121,166,202,265,274,319,346,355,378,382,391]

λ> smith !! 2000

62158

Soluciones

import Data.Numbers.Primes

esSmith :: Integer -> Bool
esSmith x = 
    not (isPrime x) && 
    sumaDigitos x == sum (map sumaDigitos (primeFactors x))

sumaDigitos :: Integer -> Integer
sumaDigitos x | x < 10 = x
              | otherwise = x `mod` 10 + sumaDigitos (x `div` 10)

smith :: [Integer]
smith = [x | x <- [1..], esSmith x]

import Data.Numbers.Primes

esSmith :: Integer -> Bool

esSmith x =

not (isPrime x) &&

sumaDigitos x == sum (map sumaDigitos (primeFactors x))

sumaDigitos :: Integer -> Integer

sumaDigitos x | x < 10 = x

| otherwise = x `mod` 10 + sumaDigitos (x `div` 10)

smith :: [Integer]

smith = [x | x <- [1..], esSmith x]

Los números de Armstrong

PorJosé A. Alonso 3-diciembre-201510-diciembre-2015

Un número de n dígitos es un número de Armstrong si es igual a la suma de las n-ésimas potencias de sus dígitos. Por ejemplo, 371, 8208 y 4210818 son números de Armstrong ya que

       371 = 3^3 + 7 + 1³ y  
      8208 = 8^4 + 2^4 + 0^4 + 8^4 
   4210818 = 4^7 + 2^7 + 1^7 + 0^7 + 8^7 + 1^7 + 8^7

371 = 3^3 + 7 + 1³ y

8208 = 8^4 + 2^4 + 0^4 + 8^4

4210818 = 4^7 + 2^7 + 1^7 + 0^7 + 8^7 + 1^7 + 8^7

Definir las funciones

   esArmstrong :: Integer -> Bool
   armstrong   :: [Integer]

1 2	esArmstrong :: Integer -> Bool armstrong :: [Integer]

tales que

(esArmstrong x) se verifica si x es un número de Armstrong. Por ejemplo,

     esArmstrong 371                                      ==  True
     esArmstrong 8208                                     ==  True
     esArmstrong 4210818                                  ==  True
     esArmstrong 2015                                     ==  False
     esArmstrong 115132219018763992565095597973971522401  ==  True
     esArmstrong 115132219018763992565095597973971522402  ==  False

esArmstrong 371 == True

esArmstrong 8208 == True

esArmstrong 4210818 == True

esArmstrong 2015 == False

esArmstrong 115132219018763992565095597973971522401 == True

esArmstrong 115132219018763992565095597973971522402 == False

armstrong es la lista cuyos elementos son los números de Armstrong. Por ejemplo,

     λ> take 18 armstrong
     [1,2,3,4,5,6,7,8,9,153,370,371,407,1634,8208,9474,54748,92727]

1 2	λ> take 18 armstrong [1,2,3,4,5,6,7,8,9,153,370,371,407,1634,8208,9474,54748,92727]

Comprobar con QuickCheck que los números mayores que
115132219018763992565095597973971522401 no son números de Armstrong.

Soluciones

import Test.QuickCheck

esArmstrong :: Integer -> Bool
esArmstrong x = 
    x == sum [d^n | d <- digitos x]
    where n = length (show x)

-- (digitos x) es la lista de los dígitos de x. Por ejemplo,
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Integer]
digitos x = [read [d] | d <- show x]

armstrong :: [Integer]
armstrong = [n | n <- [1..], esArmstrong n]

-- La propiedad es
prop_Armstrong :: Integer -> Bool
prop_Armstrong n =
    not (esArmstrong (115132219018763992565095597973971522401 + abs n + 1))

-- La comprobación es
--    λ> quickCheck prop_Armstrong
--    +++ OK, passed 100 tests.

import Test.QuickCheck

esArmstrong :: Integer -> Bool

esArmstrong x =

x == sum [d^n | d <- digitos x]

where n = length (show x)

-- (digitos x) es la lista de los dígitos de x. Por ejemplo,

-- digitos 325 == [3,2,5]

digitos :: Integer -> [Integer]

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

armstrong :: [Integer]

armstrong = [n | n <- [1..], esArmstrong n]

-- La propiedad es

prop_Armstrong :: Integer -> Bool

prop_Armstrong n =

not (esArmstrong (115132219018763992565095597973971522401 + abs n + 1))

-- La comprobación es

-- λ> quickCheck prop_Armstrong

-- +++ OK, passed 100 tests.

Raíces enteras de los números primos

PorJosé A. Alonso 2-diciembre-20151-mayo-2016

Definir la sucesión

   raicesEnterasDePrimos :: [Integer]

1	raicesEnterasDePrimos :: [Integer]

cuyos elementos son las partes enteras de las raíces cuadradas de los números primos. Por ejemplo,

   λ> take 30 raicesEnterasDePrimos
   [1,1,2,2,3,3,4,4,4,5,5,6,6,6,6,7,7,7,8,8,8,8,9,9,9,10,10,10,10,10]
   λ> raicesEnterasDePrimos !!  9963
   322
   λ> raicesEnterasDePrimos !!  9964
   323

λ> take 30 raicesEnterasDePrimos

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

λ> raicesEnterasDePrimos !! 9963

322

λ> raicesEnterasDePrimos !! 9964

323

Comprobar con QuickCheck que la diferencia entre dos términos consecutivos de la sucesión es como máximo igual a 1.

Soluciones

import Data.Numbers.Primes (primes)
import Test.QuickCheck

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

raicesEnterasDePrimos1 :: [Integer]
raicesEnterasDePrimos1 = map raizEntera primes

-- (raizEntera x) es la parte entera de la raíz cuadrada de x. Por
-- ejemplo,
--    raizEntera  8  ==  2
--    raizEntera  9  ==  3
--    raizEntera 10  ==  3
raizEntera :: Integer -> Integer
raizEntera = floor . sqrt . fromIntegral 

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

raicesEnterasDePrimos2 :: [Integer]
raicesEnterasDePrimos2 = map raizEntera2 primes

raizEntera2 :: Integer -> Integer
raizEntera2 n = aux 1
    where aux k | k*k > n   = k-1
                | otherwise = aux (k+1)

-- 3º solución
-- ===========

raicesEnterasDePrimos3 :: [Integer]
raicesEnterasDePrimos3 = aux primes [1..]
    where aux (p:ps) (x:xs) | p > x*x   = aux (p:ps) xs
                            | otherwise = (x-1) : aux ps (x:xs)


-- Comparación de eficiencia
--    ghci> raicesEnterasDePrimos1 !! 400000
--    2408
--    (2.86 secs, 1177922500 bytes)
--    ghci> raicesEnterasDePrimos2 !! 400000
--    2408
--    (3.08 secs, 1177432260 bytes)
--    ghci> raicesEnterasDePrimos3 !! 400000
--    2408
--    (3.88 secs, 1260772112 bytes)

-- En lo sucesivo usaremos la 1ª definición
raicesEnterasDePrimos :: [Integer]
raicesEnterasDePrimos = raicesEnterasDePrimos3

-- La propiedad es
prop_raicesEnterasDePrimos :: Int -> Property
prop_raicesEnterasDePrimos n =
    n >= 0 ==> 
    raicesEnterasDePrimos !! (n+1) - raicesEnterasDePrimos !! n <= 1

-- La comprobación es
--    λ> quickCheck prop_raicesEnterasDePrimos
--    +++ OK, passed 100 tests.

import Data.Numbers.Primes (primes)

import Test.QuickCheck

-- 1ª solución

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

raicesEnterasDePrimos1 :: [Integer]

raicesEnterasDePrimos1 = map raizEntera primes

-- (raizEntera x) es la parte entera de la raíz cuadrada de x. Por

-- ejemplo,

-- raizEntera 8 == 2

-- raizEntera 9 == 3

-- raizEntera 10 == 3

raizEntera :: Integer -> Integer

raizEntera = floor . sqrt . fromIntegral

-- 2ª solución

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

raicesEnterasDePrimos2 :: [Integer]

raicesEnterasDePrimos2 = map raizEntera2 primes

raizEntera2 :: Integer -> Integer

raizEntera2 n = aux 1

where aux k | k*k > n = k-1

| otherwise = aux (k+1)

-- 3º solución

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

raicesEnterasDePrimos3 :: [Integer]

raicesEnterasDePrimos3 = aux primes [1..]

where aux (p:ps) (x:xs) | p > x*x = aux (p:ps) xs

| otherwise = (x-1) : aux ps (x:xs)

-- Comparación de eficiencia

-- ghci> raicesEnterasDePrimos1 !! 400000

-- 2408

-- (2.86 secs, 1177922500 bytes)

-- ghci> raicesEnterasDePrimos2 !! 400000

-- 2408

-- (3.08 secs, 1177432260 bytes)

-- ghci> raicesEnterasDePrimos3 !! 400000

-- 2408

-- (3.88 secs, 1260772112 bytes)

-- En lo sucesivo usaremos la 1ª definición

raicesEnterasDePrimos :: [Integer]

raicesEnterasDePrimos = raicesEnterasDePrimos3

-- La propiedad es

prop_raicesEnterasDePrimos :: Int -> Property

prop_raicesEnterasDePrimos n =

n >= 0 ==>

raicesEnterasDePrimos !! (n+1) - raicesEnterasDePrimos !! n <= 1

-- La comprobación es

-- λ> quickCheck prop_raicesEnterasDePrimos

-- +++ OK, passed 100 tests.

Paridad de un árbol

PorJosé A. Alonso 1-diciembre-20158-diciembre-2015

Los árboles binarios con valores en las hojas y en los nodos se definen por

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

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

Por ejemplo, el árbol

        5         
       / \        
      /   \       
     9     7      
    / \   / \     
   1   4 6   8

/ \

9 7

/ \ / \

1 4 6 8

se puede representar por

   N 5 (N 9 (H 1) (H 4)) (N 7 (H 6) (H 8))

1	N 5 (N 9 (H 1) (H 4)) (N 7 (H 6) (H 8))

Decimos que un árbol binario es par si la mayoría de sus valores (en nodos u hojas) son pares e impar en caso contrario.

Para representar la paridad se define el tipo Paridad

   data Paridad = Par | Impar deriving (Eq, Show)

1	data Paridad = Par \| Impar deriving (Eq, Show)

Definir la función

   paridad :: Arbol3 Int -> Paridad

1	paridad :: Arbol3 Int -> Paridad

tal que (paridad a) es la paridad del árbol a. Por ejemplo,

   paridad (N 8 (N 6 (H 3) (H 4)) (H 5))  ==  Par
   paridad (N 8 (N 9 (H 3) (H 4)) (H 5))  ==  Impar

1 2	paridad (N 8 (N 6 (H 3) (H 4)) (H 5)) == Par paridad (N 8 (N 9 (H 3) (H 4)) (H 5)) == Impar

Soluciones

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

data Paridad = Par | Impar deriving (Eq, Show)  
 
paridad :: Arbol Int -> Paridad
paridad a | x > y     = Par 
          | otherwise = Impar
          where (x,y) = paridades a

-- (paridades a) es un par (x,y) donde x es el número de valores pares
-- en el árbol a e i es el número de valores impares en el árbol a. Por
-- ejemplo,  
--    paridades (N (N (H 3) 6 (H 4)) 8 (H 5))  ==  (3,2)
--    paridades (N (N (H 3) 9 (H 4)) 8 (H 5))  ==  (2,3)
paridades :: Arbol Int -> (Int,Int)
paridades (H x) | even x    = (1,0)
                | otherwise = (0,1)
paridades (N x i d) | even x    = (1+a1+a2,b1+b2)
                    | otherwise = (a1+a2,1+b1+b2)
                    where (a1,b1) = paridades i
                          (a2,b2) = paridades d

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

data Paridad = Par | Impar deriving (Eq, Show)

paridad :: Arbol Int -> Paridad

paridad a | x > y = Par

| otherwise = Impar

where (x,y) = paridades a

-- (paridades a) es un par (x,y) donde x es el número de valores pares

-- en el árbol a e i es el número de valores impares en el árbol a. Por

-- ejemplo,

-- paridades (N (N (H 3) 6 (H 4)) 8 (H 5)) == (3,2)

-- paridades (N (N (H 3) 9 (H 4)) 8 (H 5)) == (2,3)

paridades :: Arbol Int -> (Int,Int)

paridades (H x) | even x = (1,0)

| otherwise = (0,1)

paridades (N x i d) | even x = (1+a1+a2,b1+b2)

| otherwise = (a1+a2,1+b1+b2)

where (a1,b1) = paridades i

(a2,b2) = paridades d

Separación y mezcla de listas

PorJosé A. Alonso 30-noviembre-20157-diciembre-2015

Definir las funciones

   separacion :: [a] -> ([a],[a])
   mezcla     :: ([a],[a]) -> [a]

1 2	separacion :: [a] -> ([a],[a]) mezcla :: ([a],[a]) -> [a]

tales que (separacion xs) es el par formado eligiendo alternativamente elementos de xs mientras que mezcla intercala los elementos de las dos listas. Por ejemplo,

   separacion [1..5]                   ==  ([1,3,5],[2,4])
   mezcla ([1,3,5],[2,4])              ==  [1,2,3,4,5]
   separacion "Telescopio"             ==  ("Tlsoi","eecpo")
   mezcla ("Tlsoi","eecpo")            ==  "Telescopio"
   take 5 (fst (separacion [2,4..]))   ==  [2,6,10,14,18]
   take 6 (mezcla ([2,4..],[7,14..]))  ==  [2,7,4,14,6,21]

separacion [1..5] == ([1,3,5],[2,4])

mezcla ([1,3,5],[2,4]) == [1,2,3,4,5]

separacion "Telescopio" == ("Tlsoi","eecpo")

mezcla ("Tlsoi","eecpo") == "Telescopio"

take 5 (fst (separacion [2,4..])) == [2,6,10,14,18]

take 6 (mezcla ([2,4..],[7,14..])) == [2,7,4,14,6,21]

Comprobar con QuickCheck que

   mezcla (separacion xs) == xs

1	mezcla (separacion xs) == xs

Soluciones

import Test.QuickCheck

-- 1ª definición (por recursión):
separacion1 :: [a] -> ([a],[a])
separacion1 []       = ([],  [])
separacion1 [x]      = ([x], [])
separacion1 (x:y:zs) = (x:us,y:vs)
    where (us,vs) = separacion1 zs

-- 2ª definición (por comprensión):
separacion2 :: [a] -> ([a],[a])
separacion2 xs = ([x | (x,n) <- aux, even n], 
                  [x | (x,n) <- aux, odd n])
    where aux = zip xs [0..]                                           

-- 3ª definición 
separacion3 :: [a] -> ([a],[a])
separacion3 []       = ([],[])
separacion3 (x:xs)   = (x:zs, ys)
    where (ys, zs) = separacion3 xs 

-- Comprobación de eficiencia
--    ghci> last (snd (separacion1 [1..10000000]))
--    10000000
--    (10.73 secs, 2,945,794,552 bytes)
--
--    ghci> last (snd (separacion2 [1..10000000]))
--    10000000
--    (16.33 secs, 4,351,366,976 bytes)
--    
--    λ> last (snd (separacion3 [1..10000000]))
--    10000000
--    (15.67 secs, 4,423,573,048 bytes)

mezcla :: ([a],[a]) -> [a]
mezcla ([],ys)     = ys 
mezcla (xs,[])     = xs 
mezcla (x:xs,y:ys) = x : y : mezcla (xs,ys)

-- La propiedad es
prop_mezcla_separacion :: [Int] -> Bool
prop_mezcla_separacion xs =
    mezcla (separacion xs) == xs

-- La comprobación es
--    ghci> quickCheck prop_mezcla_separacion
--    +++ OK, passed 100 tests.

import Test.QuickCheck

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

separacion1 :: [a] -> ([a],[a])

separacion1 [] = ([], [])

separacion1 [x] = ([x], [])

separacion1 (x:y:zs) = (x:us,y:vs)

where (us,vs) = separacion1 zs

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

separacion2 :: [a] -> ([a],[a])

separacion2 xs = ([x | (x,n) <- aux, even n],

[x | (x,n) <- aux, odd n])

where aux = zip xs [0..]

-- 3ª definición

separacion3 :: [a] -> ([a],[a])

separacion3 [] = ([],[])

separacion3 (x:xs) = (x:zs, ys)

where (ys, zs) = separacion3 xs

-- Comprobación de eficiencia

-- ghci> last (snd (separacion1 [1..10000000]))

-- 10000000

-- (10.73 secs, 2,945,794,552 bytes)

-- ghci> last (snd (separacion2 [1..10000000]))

-- 10000000

-- (16.33 secs, 4,351,366,976 bytes)

-- λ> last (snd (separacion3 [1..10000000]))

-- 10000000

-- (15.67 secs, 4,423,573,048 bytes)

mezcla :: ([a],[a]) -> [a]

mezcla ([],ys) = ys

mezcla (xs,[]) = xs

mezcla (x:xs,y:ys) = x : y : mezcla (xs,ys)

-- La propiedad es

prop_mezcla_separacion :: [Int] -> Bool

prop_mezcla_separacion xs =

mezcla (separacion xs) == xs

-- La comprobación es

-- ghci> quickCheck prop_mezcla_separacion

-- +++ OK, passed 100 tests.

Repeticiones según la posición

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

Definir la función

   transformada :: [a] -> [a]

1	transformada :: [a] -> [a]

tal que (transformada xs) es la lista obtenida repitiendo cada elemento tantas veces como indica su posición en la lista. Por ejemplo,

   transformada [7,2,5] == [7,2,2,5,5,5]
   transformada "eco"   == "eccooo"

1 2	transformada [7,2,5] == [7,2,2,5,5,5] transformada "eco" == "eccooo"

Comprobar con QuickCheck si la transformada de una lista de n números enteros, con n ≥ 2, tiene menos de n³ elementos.

Soluciones

import Test.QuickCheck

transformada :: [a] -> [a]
transformada xs = concat [replicate n x | (n,x) <- zip [1..] xs]

-- La propiedad es
prop_transformada :: [Int] -> Property
prop_transformada xs = n >= 2 ==> length (transformada xs) < n^3
    where n = length xs

-- La comprobación es
--    ghci> quickCheck prop_transformada
--    +++ OK, passed 100 tests.

import Test.QuickCheck

transformada :: [a] -> [a]

transformada xs = concat [replicate n x | (n,x) <- zip [1..] xs]

-- La propiedad es

prop_transformada :: [Int] -> Property

prop_transformada xs = n >= 2 ==> length (transformada xs) < n^3

where n = length xs

-- La comprobación es

-- ghci> quickCheck prop_transformada

-- +++ OK, passed 100 tests.

Ganadores de las elecciones

PorJosé A. Alonso 24-noviembre-20151-diciembre-2015

Los resultados de las votaciones a delegado en un grupo de clase se recogen mediante listas de asociación. Por ejemplo,

   votos :: [(String,Int)]
   votos = [("Ana Perez",10),("Juan Lopez",7), ("Julia Rus", 27),
            ("Pedro Val",1), ("Pedro Ruiz",27),("Berta Gomez",11)]

votos :: [(String,Int)]

votos = [("Ana Perez",10),("Juan Lopez",7), ("Julia Rus", 27),

("Pedro Val",1), ("Pedro Ruiz",27),("Berta Gomez",11)]

Definir la función

   ganadores :: [(String,Int)] -> [String]

1	ganadores :: [(String,Int)] -> [String]

tal que (ganadores xs) es la lista de los estudiantes con mayor número de votos en xs. Por ejemplo,

    ganadores votos == ["Julia Rus","Pedro Ruiz"]

1	ganadores votos == ["Julia Rus","Pedro Ruiz"]

Soluciones

votos :: [(String,Int)]
votos = [("Ana Perez",10),("Juan Lopez",7), ("Julia Rus", 27),
         ("Pedro Val",1), ("Pedro Ruiz",27),("Berta Gomez",11)]

ganadores :: [(String,Int)] -> [String]
ganadores xs = [c | (c,x) <- xs, x == maxVotos]
    where maxVotos = maximum [j | (i,j) <- xs]

votos :: [(String,Int)]

votos = [("Ana Perez",10),("Juan Lopez",7), ("Julia Rus", 27),

("Pedro Val",1), ("Pedro Ruiz",27),("Berta Gomez",11)]

ganadores :: [(String,Int)] -> [String]

ganadores xs = [c | (c,x) <- xs, x == maxVotos]

where maxVotos = maximum [j | (i,j) <- xs]

Listas de igual longitud

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

Definir la función

   mismaLongitud :: [[a]] -> Bool

1	mismaLongitud :: [[a]] -> Bool

tal que (mismaLongitud xss) se verifica si todas las listas de la lista de listas xss tienen la misma longitud. Por ejemplo,

   mismaLongitud [[1,2],[6,4],[0,0],[7,4]] == True
   mismaLongitud [[1,2],[6,4,5],[0,0]]     == False

1 2	mismaLongitud [[1,2],[6,4],[0,0],[7,4]] == True mismaLongitud [[1,2],[6,4,5],[0,0]] == False

Soluciones

import Data.List (nub)    

-- 1ª solución:
mismaLongitud1 :: [[a]] -> Bool
mismaLongitud1 []       = True
mismaLongitud1 (xs:xss) = and [length ys == n | ys <- xss]
    where n = length xs

-- 2ª solución:
mismaLongitud2 :: [[a]] -> Bool
mismaLongitud2 xss = 
    and [length xs == length ys | (xs,ys) <- zip xss (tail xss)]

-- 3ª solución:
mismaLongitud3 :: [[a]] -> Bool
mismaLongitud3 (xs:ys:xss) = 
    length xs == length ys && mismaLongitud3 (ys:xss)
mismaLongitud3 _ = True           

-- 4ª solución
mismaLongitud4 :: [[a]] -> Bool
mismaLongitud4 [] = True
mismaLongitud4 (xs:xss) =
    all (\ys -> length ys == n) xss
    where n = length xs 

-- 5ª solución
mismaLongitud5 :: [[a]] -> Bool
mismaLongitud5 xss = length (nub [length xs | xs <- xss]) == 1

-- 6ª solución
mismaLongitud6 :: [[a]] -> Bool
mismaLongitud6 = null . drop 1 . nub . map length

-- Comparación de eficiencia
--    λ> mismaLongitud1 (replicate 20000 (replicate 20000 5))
--    True
--    (5.05 secs, 0 bytes)
--    λ> mismaLongitud2 (replicate 20000 (replicate 20000 5))
--    True
--    (9.98 secs, 0 bytes)
--    λ> mismaLongitud3 (replicate 20000 (replicate 20000 5))
--    True
--    (10.17 secs, 0 bytes)
--    λ> mismaLongitud4 (replicate 20000 (replicate 20000 5))
--    True
--    (5.18 secs, 0 bytes)
--    λ> mismaLongitud5 (replicate 20000 (replicate 20000 5))
--    True
--    (4.30 secs, 0 bytes)
--    λ> mismaLongitud6 (replicate 20000 (replicate 20000 5))
--    True
--    (4.19 secs, 0 bytes)

import Data.List (nub)

-- 1ª solución:

mismaLongitud1 :: [[a]] -> Bool

mismaLongitud1 [] = True

mismaLongitud1 (xs:xss) = and [length ys == n | ys <- xss]

where n = length xs

-- 2ª solución:

mismaLongitud2 :: [[a]] -> Bool

mismaLongitud2 xss =

and [length xs == length ys | (xs,ys) <- zip xss (tail xss)]

-- 3ª solución:

mismaLongitud3 :: [[a]] -> Bool

mismaLongitud3 (xs:ys:xss) =

length xs == length ys && mismaLongitud3 (ys:xss)

mismaLongitud3 _ = True

-- 4ª solución

mismaLongitud4 :: [[a]] -> Bool

mismaLongitud4 [] = True

mismaLongitud4 (xs:xss) =

all (\ys -> length ys == n) xss

where n = length xs

-- 5ª solución

mismaLongitud5 :: [[a]] -> Bool

mismaLongitud5 xss = length (nub [length xs | xs <- xss]) == 1

-- 6ª solución

mismaLongitud6 :: [[a]] -> Bool

mismaLongitud6 = null . drop 1 . nub . map length

-- Comparación de eficiencia

-- λ> mismaLongitud1 (replicate 20000 (replicate 20000 5))

-- True

-- (5.05 secs, 0 bytes)

-- λ> mismaLongitud2 (replicate 20000 (replicate 20000 5))

-- True

-- (9.98 secs, 0 bytes)

-- λ> mismaLongitud3 (replicate 20000 (replicate 20000 5))

-- True

-- (10.17 secs, 0 bytes)

-- λ> mismaLongitud4 (replicate 20000 (replicate 20000 5))

-- True

-- (5.18 secs, 0 bytes)

-- λ> mismaLongitud5 (replicate 20000 (replicate 20000 5))

-- True

-- (4.30 secs, 0 bytes)

-- λ> mismaLongitud6 (replicate 20000 (replicate 20000 5))

-- True

-- (4.19 secs, 0 bytes)

Ternas con suma acotada

PorJosé A. Alonso 20-noviembre-20151-mayo-2016

Definir la función

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

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

tal que (ternasAcotadas xs n) es el conjunto de ternas de números naturales de xs cuya suma es menor que n. Por ejemplo,

   ternasAcotadas [5,1,5,4,7] 12      ==  [(1,4,5),(1,5,5)]
   ternasAcotadas [5,1,5,4,7] 11      ==  [(1,4,5)]
   ternasAcotadas [5,1,5,4,7] 10      ==  []
   ternasAcotadas [1..10^6] 8         ==  [(1,2,3),(1,2,4)]
   ternasAcotadas [10^6,10^6-1..1] 8  ==  [(1,2,3),(1,2,4)]

ternasAcotadas [5,1,5,4,7] 12 == [(1,4,5),(1,5,5)]

ternasAcotadas [5,1,5,4,7] 11 == [(1,4,5)]

ternasAcotadas [5,1,5,4,7] 10 == []

ternasAcotadas [1..10^6] 8 == [(1,2,3),(1,2,4)]

ternasAcotadas [10^6,10^6-1..1] 8 == [(1,2,3),(1,2,4)]

Soluciones

import Data.List (tails, sort, nub)

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

ternasAcotadas :: [Int] -> Int -> [(Int,Int,Int)]
ternasAcotadas xs n =
    nub [(x,y,z) | (x,y,z) <- ternas (sort xs)
                 , x+y+z < n]

-- (ternas xs) es la lista de ternas de elementos de xs. Por ejemplo,
--    λ> ternas [1..5]
--    [(1,2,3),(1,2,4),(1,2,5),(1,3,4),(1,3,5),(1,4,5),
--     (2,3,4),(2,3,5),(2,4,5),
--     (3,4,5)]
ternas :: [a] -> [(a,a,a)]
ternas xs = [(x,y,z) | (x:ys) <- tails xs
                     , (y:zs) <- tails ys
                     , z <- zs]

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

ternasAcotadas2 :: [Int] -> Int -> [(Int,Int,Int)]
ternasAcotadas2 xs n = nub (aux (sort xs))
    where aux xs = [(x,y,z) | (x:ys) <- tails (takeWhile (< n) xs)
                            , (y:zs) <- tails (takeWhile (< (n-x)) ys)
                            , z <- takeWhile (< (n-x-y)) zs]

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

--    λ> ternasAcotadas [1..1000] 10
--    [(1,2,3),(1,2,4),(1,2,5),(1,2,6),(1,3,4),(1,3,5),(2,3,4)]
--    (336.06 secs, 50,595,444,208 bytes)
--    λ> ternasAcotadas2 [1..1000] 10
--    [(1,2,3),(1,2,4),(1,2,5),(1,2,6),(1,3,4),(1,3,5),(2,3,4)]
--    (0.00 secs, 0 bytes)

import Data.List (tails, sort, nub)

-- 1ª definición

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

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

ternasAcotadas xs n =

nub [(x,y,z) | (x,y,z) <- ternas (sort xs)

, x+y+z < n]

-- (ternas xs) es la lista de ternas de elementos de xs. Por ejemplo,

-- λ> ternas [1..5]

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

-- (2,3,4),(2,3,5),(2,4,5),

-- (3,4,5)]

ternas :: [a] -> [(a,a,a)]

ternas xs = [(x,y,z) | (x:ys) <- tails xs

, (y:zs) <- tails ys

, z <- zs]

-- 2ª definición

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

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

ternasAcotadas2 xs n = nub (aux (sort xs))

where aux xs = [(x,y,z) | (x:ys) <- tails (takeWhile (< n) xs)

, (y:zs) <- tails (takeWhile (< (n-x)) ys)

, z <- takeWhile (< (n-x-y)) zs]

-- Comparación de eficiencia

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

-- λ> ternasAcotadas [1..1000] 10

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

-- (336.06 secs, 50,595,444,208 bytes)

-- λ> ternasAcotadas2 [1..1000] 10

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

-- (0.00 secs, 0 bytes)

Subárboles monovalorados

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

Los árboles binarios con valores enteros se pueden representar mediante el tipo Arbol definido por

   data Arbol = H Int 
              | N Int Arbol Arbol
              deriving Show

data Arbol = H Int

| N Int Arbol Arbol

deriving Show

Por ejemplo, el árbol

         7
        / \ 
       /   \
      /     \
     4       9
    / \     / \
   1   3   5   6

/ \

4 9

/ \ / \

1 3 5 6

se puede representar por

   N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))

1	N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))

Un árbol es monovalorado si todos sus elementos son iguales. Por ejemplo, de los siguientes árboles sólo son monovalorados los dos primeros

    5          9           5          9    
   / \        / \         / \        / \   
  5   5      9   9       5   6      9   7  
                / \                    / \ 
               9   9                  9   9

5 9 5 9

/ \ / \ / \ / \

5 5 9 9 5 6 9 7

/ \ / \

9 9 9 9

Definir la función

   monovalorados :: Arbol -> [Arbol]

1	monovalorados :: Arbol -> [Arbol]

tal que (monovalorados a) es la lista de los subárboles monovalorados de a. Por ejemplo,

   λ> monovalorados (N 5 (H 5) (H 5))
   [N 5 (H 5) (H 5),H 5,H 5]
   λ> monovalorados (N 5 (H 5) (H 6))
   [H 5,H 6]
   λ> monovalorados (N 9 (H 9) (N 9 (H 9) (H 9)))
   [N 9 (H 9) (N 9 (H 9) (H 9)),H 9,N 9 (H 9) (H 9),H 9,H 9]
   λ> monovalorados (N 9 (H 9) (N 7 (H 9) (H 9)))
   [H 9,H 9,H 9]
   λ> monovalorados (N 9 (H 9) (N 9 (H 7) (H 9)))
   [H 9,H 7,H 9]

λ> monovalorados (N 5 (H 5) (H 5))

[N 5 (H 5) (H 5),H 5,H 5]

λ> monovalorados (N 5 (H 5) (H 6))

[H 5,H 6]

λ> monovalorados (N 9 (H 9) (N 9 (H 9) (H 9)))

[N 9 (H 9) (N 9 (H 9) (H 9)),H 9,N 9 (H 9) (H 9),H 9,H 9]

λ> monovalorados (N 9 (H 9) (N 7 (H 9) (H 9)))

[H 9,H 9,H 9]

λ> monovalorados (N 9 (H 9) (N 9 (H 7) (H 9)))

[H 9,H 7,H 9]

Soluciones

data Arbol = H Int 
           | N Int Arbol Arbol
           deriving (Show, Eq)

monovalorados :: Arbol -> [Arbol]
monovalorados (H x) = [H x]
monovalorados (N x i d) 
    | todosIguales i x && todosIguales d x =
        (N x i d) : (subarboles i ++ subarboles d)
    | otherwise = monovalorados i ++ monovalorados d

-- (todosIguales a x) se verifica si todos los valores de los nodos y
-- las hojas del árbol a son iguales a x.
todosIguales :: Arbol -> Int -> Bool
todosIguales (H y) x     = y == x
todosIguales (N y i d) x = y == x && todosIguales i x && todosIguales d x

-- (subarboles a) es la lista de los subárboles de a.
subarboles :: Arbol -> [Arbol]
subarboles (H x)     = [H x]
subarboles (N x i d) = (N x i d) : (subarboles i ++ subarboles d)

data Arbol = H Int

| N Int Arbol Arbol

deriving (Show, Eq)

monovalorados :: Arbol -> [Arbol]

monovalorados (H x) = [H x]

monovalorados (N x i d)

| todosIguales i x && todosIguales d x =

(N x i d) : (subarboles i ++ subarboles d)

| otherwise = monovalorados i ++ monovalorados d

-- (todosIguales a x) se verifica si todos los valores de los nodos y

-- las hojas del árbol a son iguales a x.

todosIguales :: Arbol -> Int -> Bool

todosIguales (H y) x = y == x

todosIguales (N y i d) x = y == x && todosIguales i x && todosIguales d x

-- (subarboles a) es la lista de los subárboles de a.

subarboles :: Arbol -> [Arbol]

subarboles (H x) = [H x]

subarboles (N x i d) = (N x i d) : (subarboles i ++ subarboles d)

Productos de N números consecutivos

PorJosé A. Alonso 17-noviembre-201526-marzo-2022

La semana pasada se planteó en Twitter el siguiente problema

Se observa que

      1x2x3x4 = 2x3x4 
      2x3x4x5 = 4x5x6

1 2	1x2x3x4 = 2x3x4 2x3x4x5 = 4x5x6

¿Existen ejemplos de otros productos de cuatro enteros consecutivos iguales a un producto de tres enteros consecutivos?

Definir la función

   esProductoDeNconsecutivos :: Integer -> Integer -> Maybe Integer

1	esProductoDeNconsecutivos :: Integer -> Integer -> Maybe Integer

tal que (esProductoDeNconsecutivos n x) es (Just m) si x es el producto de n enteros consecutivos a partir de m y es Nothing si x no es el producto de n enteros consecutivos. Por ejemplo,

   esProductoDeNconsecutivos 3   6  == Just 1
   esProductoDeNconsecutivos 4   6  == Nothing
   esProductoDeNconsecutivos 4  24  == Just 1
   esProductoDeNconsecutivos 3  24  == Just 2
   esProductoDeNconsecutivos 3 120  == Just 4
   esProductoDeNconsecutivos 4 120  == Just 2

esProductoDeNconsecutivos 3 6 == Just 1

esProductoDeNconsecutivos 4 6 == Nothing

esProductoDeNconsecutivos 4 24 == Just 1

esProductoDeNconsecutivos 3 24 == Just 2

esProductoDeNconsecutivos 3 120 == Just 4

esProductoDeNconsecutivos 4 120 == Just 2

Para ejemplos mayores,

   λ> esProductoDeNconsecutivos 3 (product [10^20..2+10^20])
   Just 100000000000000000000
   λ> esProductoDeNconsecutivos2 4 (product [10^20..2+10^20])
   Nothing
   λ> esProductoDeNconsecutivos2 4 (product [10^20..3+10^20])
   Just 100000000000000000000

λ> esProductoDeNconsecutivos 3 (product [10^20..2+10^20])

Just 100000000000000000000

λ> esProductoDeNconsecutivos2 4 (product [10^20..2+10^20])

Nothing

λ> esProductoDeNconsecutivos2 4 (product [10^20..3+10^20])

Just 100000000000000000000

Usando la función esProductoDeNconsecutivos resolver el problema.

Soluciones

import Data.Maybe

-- 1ª definición
esProductoDeNconsecutivos1 :: Integer -> Integer -> Maybe Integer
esProductoDeNconsecutivos1 n x 
    | null productos = Nothing
    | otherwise      = Just (head productos)
    where productos = [m | m <- [1..x-n], product [m..m+n-1] == x]

-- 2ª definición
esProductoDeNconsecutivos2 :: Integer -> Integer -> Maybe Integer
esProductoDeNconsecutivos2 n x = aux k
    where k = floor (fromIntegral x ** (1/(fromIntegral n))) - (n `div` 2)
          aux m | y == x    = Just m
                | y <  x    = aux (m+1)
                | otherwise = Nothing
                where y = product [m..m+n-1]

-- Comparación de eficiencia
--    λ> esProductoDeNconsecutivos1 3 (product [10^7..2+10^7])
--    Just 10000000
--    (12.37 secs, 5678433692 bytes)
--    λ> esProductoDeNconsecutivos2 3 (product [10^7..2+10^7])
--    Just 10000000
--    (0.00 secs, 1554932 bytes)

-- Solución del problema
-- =====================

soluciones :: [Integer]
soluciones = [x | x <- [121..]
                , isJust (esProductoDeNconsecutivos2 4 x)
                , isJust (esProductoDeNconsecutivos2 3 x)]

-- El cálculo es
--    λ> head soluciones
--    175560
--    λ> esProductoDeNconsecutivos2 4 175560
--    Just 19
--    λ> esProductoDeNconsecutivos2 3 175560
--    Just 55
--    λ> product [19,20,21,22] 
--    175560
--    λ> product [55,56,57]
--    175560
--    λ> product [19,20,21,22] == product [55,56,57]
--    True

-- Se puede definir una función para automatizar el proceso anterior:
soluciones2 :: [(Integer,[Integer],[Integer])]
soluciones2 = [(x,[a..a+3],[b..b+2]) 
               | x <- [121..]
               , let y = esProductoDeNconsecutivos2 4 x
               , isJust y
               , let z = esProductoDeNconsecutivos2 3 x
               , isJust z
               , let a = fromJust y
               , let b = fromJust z
               ]

-- El cálculo es 
--    λ> head soluciones2
--    (175560,[19,20,21,22],[55,56,57])

import Data.Maybe

-- 1ª definición

esProductoDeNconsecutivos1 :: Integer -> Integer -> Maybe Integer

esProductoDeNconsecutivos1 n x

| null productos = Nothing

| otherwise = Just (head productos)

where productos = [m | m <- [1..x-n], product [m..m+n-1] == x]

-- 2ª definición

esProductoDeNconsecutivos2 :: Integer -> Integer -> Maybe Integer

esProductoDeNconsecutivos2 n x = aux k

where k = floor (fromIntegral x ** (1/(fromIntegral n))) - (n `div` 2)

aux m | y == x = Just m

| y < x = aux (m+1)

| otherwise = Nothing

where y = product [m..m+n-1]

-- Comparación de eficiencia

-- λ> esProductoDeNconsecutivos1 3 (product [10^7..2+10^7])

-- Just 10000000

-- (12.37 secs, 5678433692 bytes)

-- λ> esProductoDeNconsecutivos2 3 (product [10^7..2+10^7])

-- Just 10000000

-- (0.00 secs, 1554932 bytes)

-- Solución del problema

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

soluciones :: [Integer]

soluciones = [x | x <- [121..]

, isJust (esProductoDeNconsecutivos2 4 x)

, isJust (esProductoDeNconsecutivos2 3 x)]

-- El cálculo es

-- λ> head soluciones

-- 175560

-- λ> esProductoDeNconsecutivos2 4 175560

-- Just 19

-- λ> esProductoDeNconsecutivos2 3 175560

-- Just 55

-- λ> product [19,20,21,22]

-- 175560

-- λ> product [55,56,57]

-- 175560

-- λ> product [19,20,21,22] == product [55,56,57]

-- True

-- Se puede definir una función para automatizar el proceso anterior:

soluciones2 :: [(Integer,[Integer],[Integer])]

soluciones2 = [(x,[a..a+3],[b..b+2])

| x <- [121..]

, let y = esProductoDeNconsecutivos2 4 x

, isJust y

, let z = esProductoDeNconsecutivos2 3 x

, isJust z

, let a = fromJust y

, let b = fromJust z

]

-- El cálculo es

-- λ> head soluciones2

-- (175560,[19,20,21,22],[55,56,57])

Dígitos visibles y ocultos

PorJosé A. Alonso 16-noviembre-201526-marzo-2022

Una cadena clave es una cadena que contiene dígitos visibles y ocultos. Los dígitos se ocultan mediante las primeras letras minúsculas: la ‘a’ oculta el ‘0’, la ‘b’ el ‘1’ y así sucesivamente hasta la ‘j’ que oculta el ‘9’. Los restantes símbolos de la cadena no tienen significado y se pueden ignorar.

Definir la función

   numeroOculto :: String -> Maybe Integer

1	numeroOculto :: String -> Maybe Integer

tal que (numeroOculto cs) es justo el número formado por los dígitos visibles u ocultos de la cadena clave cs, si cs tiene dígitos y Nothing en caso contrario. Por ejemplo,

   numeroOculto "jihgfedcba"            ==  Just 9876543210
   numeroOculto "JIHGFEDCBA"            ==  Nothing
   numeroOculto "el 23 de Enero"        ==  Just 423344
   numeroOculto "El 23 de Enero"        ==  Just 23344
   numeroOculto "El 23 de enero"        ==  Just 233444
   numeroOculto "Todo para nada"        ==  Just 300030
   numeroOculto (replicate (10^6) 'A')  ==  Nothing

numeroOculto "jihgfedcba" == Just 9876543210

numeroOculto "JIHGFEDCBA" == Nothing

numeroOculto "el 23 de Enero" == Just 423344

numeroOculto "El 23 de Enero" == Just 23344

numeroOculto "El 23 de enero" == Just 233444

numeroOculto "Todo para nada" == Just 300030

numeroOculto (replicate (10^6) 'A') == Nothing

Soluciones

import Data.Char (isDigit, ord, chr)

numeroOculto :: String -> Maybe Integer
numeroOculto cs | null aux  = Nothing
                | otherwise = Just (read aux)
    where aux = filter isDigit (map visible cs)

visible :: Char -> Char
visible c | c `elem` ['a'..'j'] = chr (ord c - n)
          | otherwise           = c
          where n = ord 'a' - ord '0'

import Data.Char (isDigit, ord, chr)

numeroOculto :: String -> Maybe Integer

numeroOculto cs | null aux = Nothing

| otherwise = Just (read aux)

where aux = filter isDigit (map visible cs)

visible :: Char -> Char

visible c | c `elem` ['a'..'j'] = chr (ord c - n)

| otherwise = c

where n = ord 'a' - ord '0'

Números muy pares

PorJosé A. Alonso 13-noviembre-201520-noviembre-2015

Un entero positivo x es muy par si tanto x como x² sólo contienen cifras pares. Por ejemplo, 200 es muy par porque todas las cifras de 200 y 200² = 40000 son pares; pero 26 no lo es porque 26² = 676 tiene cifras impares.

Definir la función

   siguienteMuyPar :: Integer -> Integer

1	siguienteMuyPar :: Integer -> Integer

tal que (siguienteMuyPar x) es menor número mayor que x que es muy par. Por ejemplo,

   siguienteMuyPar 300           ==  668
   siguienteMuyPar 668           ==  680
   siguienteMuyPar 828268400000  ==  828268460602

siguienteMuyPar 300 == 668

siguienteMuyPar 668 == 680

siguienteMuyPar 828268400000 == 828268460602

Soluciones

siguienteMuyPar :: Integer -> Integer
siguienteMuyPar x = 
    head [n | n <- [y,y+2..], muyPar n]
    where y = siguientePar x

-- (siguientePar x) es el primer número mayor que x que es par. Por
-- ejemplo, 
--    siguientePar 3  ==  4
--    siguientePar 4  ==  6
siguientePar :: Integer -> Integer
siguientePar x | odd x     = x+1
               | otherwise = x+2

-- (muyPar x) se verifica si x es muy par. Por ejemplo,
--    muyPar 200           == True
--    muyPar 26            == False
muyPar :: Integer -> Bool
muyPar n = all even (digitos n) && all even (digitos (n*n))

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Int]
digitos n = [read [d] | d <- show n]

siguienteMuyPar :: Integer -> Integer

siguienteMuyPar x =

head [n | n <- [y,y+2..], muyPar n]

where y = siguientePar x

-- (siguientePar x) es el primer número mayor que x que es par. Por

-- ejemplo,

-- siguientePar 3 == 4

-- siguientePar 4 == 6

siguientePar :: Integer -> Integer

siguientePar x | odd x = x+1

| otherwise = x+2

-- (muyPar x) se verifica si x es muy par. Por ejemplo,

-- muyPar 200 == True

-- muyPar 26 == False

muyPar :: Integer -> Bool

muyPar n = all even (digitos n) && all even (digitos (n*n))

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,

-- digitos 325 == [3,2,5]

digitos :: Integer -> [Int]

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

Listas decrecientes

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

Definir la función

   listasDecrecientesDesde :: Int -> [[Int]]

1	listasDecrecientesDesde :: Int -> [[Int]]

tal que (listasDecrecientesDesde n) es la lista de las sucesiones estrictamente decrecientes cuyo primer elemento es n. Por ejemplo,

   ghci> listasDecrecientesDesde 2
   [[2],[2,1],[2,1,0],[2,0]]
   ghci> listasDecrecientesDesde 3
   [[3],[3,2],[3,2,1],[3,2,1,0],[3,2,0],[3,1],[3,1,0],[3,0]]

ghci> listasDecrecientesDesde 2

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

ghci> listasDecrecientesDesde 3

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

Soluciones

listasDecrecientesDesde :: Int -> [[Int]]
listasDecrecientesDesde 0 = [[0]]
listasDecrecientesDesde n =
    [n] : [n:ys | m <- [n-1,n-2..0], ys <- listasDecrecientesDesde m]

listasDecrecientesDesde :: Int -> [[Int]]

listasDecrecientesDesde 0 = [[0]]

listasDecrecientesDesde n =

[n] : [n:ys | m <- [n-1,n-2..0], ys <- listasDecrecientesDesde m]

Primos gemelos próximos a múltiplos de 6

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

Un par de números primos (p,q) es un par de números primos gemelos si su distancia de 2; es decir, si q = p+2. Por ejemplo, (17,19) es una par de números primos gemelos.

Se dice que un par de números (x,y) está próximo a un múltiplo de 6 si es de la forma (6*n-1,6*n+1). Por ejemplo, (17,19) está cerca de un múltiplo de 6 porque (17,19) = (6*3-1,6*3+1).

Definir las funciones

   primosGemelos :: Integer -> [(Integer,Integer)]
   primosGemelosNoProximosAmultiplosDe6 :: Integer -> [(Integer,Integer)]

1 2	primosGemelos :: Integer -> [(Integer,Integer)] primosGemelosNoProximosAmultiplosDe6 :: Integer -> [(Integer,Integer)]

tales que

(primosGemelos n) es la lista de los primos gemelos menores que n. Por ejemplo,

     primosGemelos 50  == [(3,5),(5,7),(11,13),(17,19),(29,31),(41,43)]
     primosGemelos 43  == [(3,5),(5,7),(11,13),(17,19),(29,31)]

1 2	primosGemelos 50 == [(3,5),(5,7),(11,13),(17,19),(29,31),(41,43)] primosGemelos 43 == [(3,5),(5,7),(11,13),(17,19),(29,31)]

(primosGemelosNoProximosAmultiplosDe6 n) es la lista de los primos gemelos menores que n que no están próximos a un múltiplo de 6. Por ejemplo,

     primosGemelosNoProximosAmultiplosDe6 50              == [(3,5)]
     length (primosGemelosNoProximosAmultiplosDe6 (10^9)) == 1

1 2	primosGemelosNoProximosAmultiplosDe6 50 == [(3,5)] length (primosGemelosNoProximosAmultiplosDe6 (10^9)) == 1

Soluciones

primosGemelos :: Integer -> [(Integer,Integer)]
primosGemelos n = [(x,x+2) | x <- [3,5..n-3], 
                             primo x,
                             primo (x+2)]

primo :: Integer -> Bool
primo n = divisores n == [1,n]

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

proximosAmultiplosDe6 :: (Integer,Integer) -> Bool
proximosAmultiplosDe6 (x,y) =
    (x+1) `mod` 6 == 0 && y == 6*n+1
    where n = (x+1) `div` 6

primosGemelosNoProximosAmultiplosDe6 :: Integer -> [(Integer,Integer)]
primosGemelosNoProximosAmultiplosDe6 n =
    [p | p <- primosGemelos n,
         not (proximosAmultiplosDe6 p)]


-- Experimentado con primosGemelosNProximosAmultiplosDe6
--    primosGemelosNoProximosAmultiplosDe6 50    == [(3,5)]
--    primosGemelosNoProximosAmultiplosDe6 500   == [(3,5)]
--    primosGemelosNoProximosAmultiplosDe6 5000  == [(3,5)]
-- se observa que el único par de primos gemelos no próximos a múltiplos
-- de 6 es el (3,5). Su demostración es la siguiente:
--
-- Para cualquier n > 3, se tiene que de los tres números n-1, n. n+1
-- uno es divisible por 2 y alguno es divisible por 3. Si n-1 y n+1 son
-- primos, entonces el que es divisible por 2 y por 3 es n y, por tanto,
-- n es divisible por 6 y (n-1,n+1) están próximos a un múltiplo de 6.

-- Usando la propiedad tenemos una definición más eficiente
primosGemelosNoProximosAmultiplosDe6' :: Integer -> [(Integer,Integer)]
primosGemelosNoProximosAmultiplosDe6' n = [(3,5)]

primosGemelos :: Integer -> [(Integer,Integer)]

primosGemelos n = [(x,x+2) | x <- [3,5..n-3],

primo x,

primo (x+2)]

primo :: Integer -> Bool

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

divisores :: Integer -> [Integer]

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

proximosAmultiplosDe6 :: (Integer,Integer) -> Bool

proximosAmultiplosDe6 (x,y) =

(x+1) `mod` 6 == 0 && y == 6*n+1

where n = (x+1) `div` 6

primosGemelosNoProximosAmultiplosDe6 :: Integer -> [(Integer,Integer)]

primosGemelosNoProximosAmultiplosDe6 n =

[p | p <- primosGemelos n,

not (proximosAmultiplosDe6 p)]

-- Experimentado con primosGemelosNProximosAmultiplosDe6

-- primosGemelosNoProximosAmultiplosDe6 50 == [(3,5)]

-- primosGemelosNoProximosAmultiplosDe6 500 == [(3,5)]

-- primosGemelosNoProximosAmultiplosDe6 5000 == [(3,5)]

-- se observa que el único par de primos gemelos no próximos a múltiplos

-- de 6 es el (3,5). Su demostración es la siguiente:

-- Para cualquier n > 3, se tiene que de los tres números n-1, n. n+1

-- uno es divisible por 2 y alguno es divisible por 3. Si n-1 y n+1 son

-- primos, entonces el que es divisible por 2 y por 3 es n y, por tanto,

-- n es divisible por 6 y (n-1,n+1) están próximos a un múltiplo de 6.

-- Usando la propiedad tenemos una definición más eficiente

primosGemelosNoProximosAmultiplosDe6' :: Integer -> [(Integer,Integer)]

primosGemelosNoProximosAmultiplosDe6' n = [(3,5)]

Capicúas productos de dos números de dos dígitos

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

El número 9009 es capicúa y es producto de dos números de dos dígitos, pues 9009 = 91*99.

Definir la lista

   capicuasP2N2D :: [Int]

1	capicuasP2N2D :: [Int]

cuyos elementos son los números capicúas que son producto de 2 números de dos dígitos. Por ejemplo,

   take 5  capicuasP2N2D  ==  [121,242,252,272,323]
   length  capicuasP2N2D  ==  74
   drop 70 capicuasP2N2D  ==  [8008,8118,8448,9009]

take 5 capicuasP2N2D == [121,242,252,272,323]

length capicuasP2N2D == 74

drop 70 capicuasP2N2D == [8008,8118,8448,9009]

Soluciones

import Data.List

capicuasP2N2D :: [Int]
capicuasP2N2D = [x | x <- productos, esCapicua x]

-- productos es la lista de números menores que son productos de 2
-- números de dos dígitos.  
productos :: [Int]
productos = sort (nub [x*y | x <- [10..99], y <- [x..99]])

-- (esCapicua x) se verifica si x es capicúa.
esCapicua :: Int -> Bool
esCapicua x = xs == reverse xs
    where xs = show x

import Data.List

capicuasP2N2D :: [Int]

capicuasP2N2D = [x | x <- productos, esCapicua x]

-- productos es la lista de números menores que son productos de 2

-- números de dos dígitos.

productos :: [Int]

productos = sort (nub [x*y | x <- [10..99], y <- [x..99]])

-- (esCapicua x) se verifica si x es capicúa.

esCapicua :: Int -> Bool

esCapicua x = xs == reverse xs

where xs = show x

Números muy divisibles por 3

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

Se dice que un número n es muy divisible por 3 si es divisible por 3 y sigue siendo divisible por 3 si vamos quitando dígitos por la derecha. Por ejemplo, 96060 es muy divisible por 3 porque 96060, 9606, 960, 96 y 9 son todos divisibles por 3.

Definir las funciones

   muyDivPor3             :: Integer -> Bool
   numeroMuyDivPor3Cifras :: Integer -> Integer

1 2	muyDivPor3 :: Integer -> Bool numeroMuyDivPor3Cifras :: Integer -> Integer

tales que

(muyDivPor3 n) se verifica si n es muy divisible por 3. Por ejemplo,

     muyDivPor3 96060 == True
     muyDivPor3 90616 == False

1 2	muyDivPor3 96060 == True muyDivPor3 90616 == False

(numeroMuyDivPor3CifrasC k) es la cantidad de números de k cifras muy divisibles por 3. Por ejemplo,

     numeroMuyDivPor3Cifras 5                    == 768
     numeroMuyDivPor3Cifras 7                    == 12288
     numeroMuyDivPor3Cifras (10^6) `rem` (10^6)  == 332032

numeroMuyDivPor3Cifras 5 == 768

numeroMuyDivPor3Cifras 7 == 12288

numeroMuyDivPor3Cifras (10^6) `rem` (10^6) == 332032

Soluciones

import Data.List (genericLength)

muyDivPor3 :: Integer -> Bool
muyDivPor3 n 
    | n < 10    = n `rem` 3 == 0
    | otherwise = n `rem` 3 == 0 && muyDivPor3 (n `div` 10)

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

numeroMuyDivPor3Cifras :: Integer -> Integer
numeroMuyDivPor3Cifras k = 
    genericLength [x | x <- [10^(k-1)..10^k-1], muyDivPor3 x]

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

numeroMuyDivPor3Cifras2 :: Integer -> Integer
numeroMuyDivPor3Cifras2 k = 
    genericLength [x | x <- [n,n+3..10^k-1], muyDivPor3 x]
    where n = k*10^(k-1)

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

numeroMuyDivPor3Cifras3 :: Integer -> Integer
numeroMuyDivPor3Cifras3 k = genericLength (numeroMuyDivPor3Cifras3a k)

numeroMuyDivPor3Cifras3a :: Integer -> [Integer]
numeroMuyDivPor3Cifras3a 1 = [3,6,9] 
numeroMuyDivPor3Cifras3a k = 
    [10*x+y | x <- numeroMuyDivPor3Cifras3a (k-1),
              y <- [0,3..9]]

-- 4ª definición
-- =============

numeroMuyDivPor3Cifras4 :: Integer -> Integer
numeroMuyDivPor3Cifras4 1 = 3
numeroMuyDivPor3Cifras4 k = 4 * numeroMuyDivPor3Cifras4 (k-1)

-- 5ª definición
-- =============

numeroMuyDivPor3Cifras5 :: Integer -> Integer
numeroMuyDivPor3Cifras5 k = 3 * 4^(k-1)

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

--    λ> numeroMuyDivPor3Cifras 6
--    3072
--    (3.47 secs, 534,789,608 bytes)
--    λ> numeroMuyDivPor3Cifras2 6
--    2048
--    (0.88 secs, 107,883,432 bytes)
--    λ> numeroMuyDivPor3Cifras3 6
--    3072
--    (0.01 secs, 0 bytes)
--    
--    λ> numeroMuyDivPor3Cifras2 7
--    0
--    (2.57 secs, 375,999,336 bytes)
--    λ> numeroMuyDivPor3Cifras3 7
--    12288
--    (0.02 secs, 0 bytes)
--    λ> numeroMuyDivPor3Cifras4 7
--    12288
--    (0.00 secs, 0 bytes)
--    λ> numeroMuyDivPor3Cifras5 7
--    12288
--    (0.01 secs, 0 bytes)
--
--    λ> numeroMuyDivPor3Cifras4 (10^5) `rem` 100000
--    32032
--    (5.74 secs, 1,408,600,592 bytes)
--    λ> numeroMuyDivPor3Cifras5 (10^5) `rem` 100000
--    32032
--    (0.02 secs, 0 bytes)

import Data.List (genericLength)

muyDivPor3 :: Integer -> Bool

muyDivPor3 n

| n < 10 = n `rem` 3 == 0

| otherwise = n `rem` 3 == 0 && muyDivPor3 (n `div` 10)

-- 1ª definición

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

numeroMuyDivPor3Cifras :: Integer -> Integer

numeroMuyDivPor3Cifras k =

genericLength [x | x <- [10^(k-1)..10^k-1], muyDivPor3 x]

-- 2ª definición

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

numeroMuyDivPor3Cifras2 :: Integer -> Integer

numeroMuyDivPor3Cifras2 k =

genericLength [x | x <- [n,n+3..10^k-1], muyDivPor3 x]

where n = k*10^(k-1)

-- 3ª definición

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

numeroMuyDivPor3Cifras3 :: Integer -> Integer

numeroMuyDivPor3Cifras3 k = genericLength (numeroMuyDivPor3Cifras3a k)

numeroMuyDivPor3Cifras3a :: Integer -> [Integer]

numeroMuyDivPor3Cifras3a 1 = [3,6,9]

numeroMuyDivPor3Cifras3a k =

[10*x+y | x <- numeroMuyDivPor3Cifras3a (k-1),

y <- [0,3..9]]

-- 4ª definición

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

numeroMuyDivPor3Cifras4 :: Integer -> Integer

numeroMuyDivPor3Cifras4 1 = 3

numeroMuyDivPor3Cifras4 k = 4 * numeroMuyDivPor3Cifras4 (k-1)

-- 5ª definición

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

numeroMuyDivPor3Cifras5 :: Integer -> Integer

numeroMuyDivPor3Cifras5 k = 3 * 4^(k-1)

-- Comparación de eficiencia

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

-- λ> numeroMuyDivPor3Cifras 6

-- 3072

-- (3.47 secs, 534,789,608 bytes)

-- λ> numeroMuyDivPor3Cifras2 6

-- 2048

-- (0.88 secs, 107,883,432 bytes)

-- λ> numeroMuyDivPor3Cifras3 6

-- 3072

-- (0.01 secs, 0 bytes)

-- λ> numeroMuyDivPor3Cifras2 7

-- 0

-- (2.57 secs, 375,999,336 bytes)

-- λ> numeroMuyDivPor3Cifras3 7

-- 12288

-- (0.02 secs, 0 bytes)

-- λ> numeroMuyDivPor3Cifras4 7

-- 12288

-- (0.00 secs, 0 bytes)

-- λ> numeroMuyDivPor3Cifras5 7

-- 12288

-- (0.01 secs, 0 bytes)

-- λ> numeroMuyDivPor3Cifras4 (10^5) `rem` 100000

-- 32032

-- (5.74 secs, 1,408,600,592 bytes)

-- λ> numeroMuyDivPor3Cifras5 (10^5) `rem` 100000

-- 32032

-- (0.02 secs, 0 bytes)

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.

Próximos a múltiplos de 6

PorJosé A. Alonso 29-octubre-20155-noviembre-2015

Se dice que un par de números (x,y) está próximo a un múltiplo de 6 si es de la forma (6*n-1,6*n+1). Por ejemplo, (17,19) está cerca de un múltiplo de 6 porque (17,19) = (6*3-1,6*3+1).

Definir la función

   proximosAmultiplosDe6 :: (Integer,Integer) -> Bool

1	proximosAmultiplosDe6 :: (Integer,Integer) -> Bool

tal que (proximosAmultiplosDe6 (x,y)) se verifica si el par (x,y) está próximo a un múltiplo de 6. Por ejemplo,

   proximosAmultiplosDe6 (17,19)                          ==  True
   proximosAmultiplosDe6 (18,20)                          ==  False
   proximosAmultiplosDe6 (5,19)                           ==  False
   proximosAmultiplosDe6 (1,3)                            ==  False
   proximosAmultiplosDe6 (74074073407403,74074073407405)  ==  True
   proximosAmultiplosDe6 (86419752308637,86419752308639)  ==  False

proximosAmultiplosDe6 (17,19) == True

proximosAmultiplosDe6 (18,20) == False

proximosAmultiplosDe6 (5,19) == False

proximosAmultiplosDe6 (1,3) == False

proximosAmultiplosDe6 (74074073407403,74074073407405) == True

proximosAmultiplosDe6 (86419752308637,86419752308639) == False

Soluciones

-- 1ª solución
proximosAmultiplosDe6 :: (Integer,Integer) -> Bool
proximosAmultiplosDe6 (x,y) =
    (x+1) `mod` 6 == 0 && y == 6*n+1
    where n = (x+1) `div` 6

-- 2ª solución
proximosAmultiplosDe6' :: (Integer,Integer) -> Bool
proximosAmultiplosDe6' (a,b) = 
    a+1 == b-1 && mod (a+b) 6 == 0

-- 1ª solución

proximosAmultiplosDe6 :: (Integer,Integer) -> Bool

proximosAmultiplosDe6 (x,y) =

(x+1) `mod` 6 == 0 && y == 6*n+1

where n = (x+1) `div` 6

-- 2ª solución

proximosAmultiplosDe6' :: (Integer,Integer) -> Bool

proximosAmultiplosDe6' (a,b) =

a+1 == b-1 && mod (a+b) 6 == 0

Lista con repeticiones

PorJosé A. Alonso 27-octubre-20153-noviembre-2015

Definir la función

   tieneRepeticiones :: Eq a => [a] -> Bool

1	tieneRepeticiones :: Eq a => [a] -> Bool

tal que (tieneRepeticiones xs) se verifica si xs tiene algún elemento repetido. Por ejemplo,

   tieneRepeticiones [3,2,5,2,7]          ==  True
   tieneRepeticiones [3,2,5,4,7]          ==  False
   tieneRepeticiones (5:[1..2000000000])  ==  True
   tieneRepeticiones [1..20000]           ==  False

tieneRepeticiones [3,2,5,2,7] == True

tieneRepeticiones [3,2,5,4,7] == False

tieneRepeticiones (5:[1..2000000000]) == True

tieneRepeticiones [1..20000] == False

Soluciones

tieneRepeticiones :: Eq a => [a] -> Bool
tieneRepeticiones []     = False
tieneRepeticiones (x:xs) = x `elem` xs || tieneRepeticiones xs

tieneRepeticiones :: Eq a => [a] -> Bool

tieneRepeticiones [] = False

tieneRepeticiones (x:xs) = x `elem` xs || tieneRepeticiones xs

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]

Pandigitales tridivisibles

PorJosé A. Alonso 26-junio-201528-octubre-2015

El número 4106357289 tiene la siguientes dos propiedades:

es pandigital, porque tiene todos los dígitos del 0 al 9 exactamente una vez y
es tridivisible, porque los sucesivos subnúmeros de tres dígitos (a partir del segundo) son divisibles por los sucesivos números primos; es decir, representado por d(i) el i-ésimo dígito, se tiene

     d(2)d(3)d(4)  = 106 es divisible por 2
     d(3)d(4)d(5)  = 063 es divisible por 3
     d(4)d(5)d(6)  = 635 es divisible por 5
     d(5)d(6)d(7)  = 357 es divisible por 7
     d(6)d(7)d(8)  = 572 es divisible por 11
     d(7)d(8)d(9)  = 728 es divisible por 13
     d(8)d(9)d(10) = 289 es divisible por 17

d(2)d(3)d(4) = 106 es divisible por 2

d(3)d(4)d(5) = 063 es divisible por 3

d(4)d(5)d(6) = 635 es divisible por 5

d(5)d(6)d(7) = 357 es divisible por 7

d(6)d(7)d(8) = 572 es divisible por 11

d(7)d(8)d(9) = 728 es divisible por 13

d(8)d(9)d(10) = 289 es divisible por 17

Definir la constante

   pandigitalesTridivisibles :: [Integer]

1	pandigitalesTridivisibles :: [Integer]

cuyos elementos son los números pandigitales tridivisibles. Por ejemplo,

   head pandigitalesTridivisibles  ==  4106357289
   sum pandigitalesTridivisibles   ==  16695334890

1 2	head pandigitalesTridivisibles == 4106357289 sum pandigitalesTridivisibles == 16695334890

Soluciones

import Data.List ((\\))

pandigitalesTridivisibles :: [Integer]
pandigitalesTridivisibles = 
    [entero [d1,d2,d3,d4,d5,d6,d7,d8,d9,d10] 
     | d2 <- [0..9]
     , d3 <- [0..9] \\ [d2]
     , d4 <- [0..9] \\ [d2,d3]
     , divisible [d2,d3,d4] 2
     , d5 <- [0..9] \\ [d2,d3,d4]  
     , divisible [d3,d4,d5] 3
     , d6 <- [0..9] \\ [d2,d3,d4,d5]  
     , divisible [d4,d5,d6] 5
     , d7 <- [0..9] \\ [d2,d3,d4,d5,d6]  
     , d8 <- [0..9] \\ [d2,d3,d4,d5,d6,d7]  
     , divisible [d6,d7,d8] 11
     , divisible [d5,d6,d7] 7
     , d9 <- [0..9] \\ [d2,d3,d4,d5,d6,d7,d8]  
     , divisible [d7,d8,d9] 13
     , d10 <- [0..9] \\ [d2,d3,d4,d5,d6,d7,d8,d9]  
     , divisible [d8,d9,d10] 17
     , d1 <- [1..9] \\ [d2,d3,d4,d5,d6,d7,d8,d9,d10]  
    ]

-- (entero ns) es el número cuyos dígitos son ns. Por ejemplo,
--    entero [3,2,5]  ==  325
entero :: [Integer] -> Integer
entero = read . concatMap show

divisible :: [Integer] -> Integer -> Bool
divisible xs n =
    entero xs `mod` n == 0

import Data.List ((\\))

pandigitalesTridivisibles :: [Integer]

pandigitalesTridivisibles =

[entero [d1,d2,d3,d4,d5,d6,d7,d8,d9,d10]

| d2 <- [0..9]

, d3 <- [0..9] \\ [d2]

, d4 <- [0..9] \\ [d2,d3]

, divisible [d2,d3,d4] 2

, d5 <- [0..9] \\ [d2,d3,d4]

, divisible [d3,d4,d5] 3

, d6 <- [0..9] \\ [d2,d3,d4,d5]

, divisible [d4,d5,d6] 5

, d7 <- [0..9] \\ [d2,d3,d4,d5,d6]

, d8 <- [0..9] \\ [d2,d3,d4,d5,d6,d7]

, divisible [d6,d7,d8] 11

, divisible [d5,d6,d7] 7

, d9 <- [0..9] \\ [d2,d3,d4,d5,d6,d7,d8]

, divisible [d7,d8,d9] 13

, d10 <- [0..9] \\ [d2,d3,d4,d5,d6,d7,d8,d9]

, divisible [d8,d9,d10] 17

, d1 <- [1..9] \\ [d2,d3,d4,d5,d6,d7,d8,d9,d10]

]

-- (entero ns) es el número cuyos dígitos son ns. Por ejemplo,

-- entero [3,2,5] == 325

entero :: [Integer] -> Integer

entero = read . concatMap show

divisible :: [Integer] -> Integer -> Bool

divisible xs n =

entero xs `mod` n == 0

Partición por longitudes

PorJosé A. Alonso 23-junio-201528-octubre-2015

Definir la función

   particion :: [a] -> [Int] -> [[a]]

1	particion :: [a] -> [Int] -> [[a]]

tal que (particion xs ns) es la partición de xs donde la longitud de cada parte está determinada por los elementos de ns. Por ejemplo,

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

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

Soluciones

particion :: [a] -> [Int] -> [[a]]
particion [] []     = []
particion xs (n:ns) = take n xs : particion (drop n xs) ns

particion :: [a] -> [Int] -> [[a]]

particion [] [] = []

particion xs (n:ns) = take n xs : particion (drop n xs) ns

Máximos de una lista

PorJosé A. Alonso 22-junio-201528-octubre-2015

Definir la función

   maximos :: Ord a => [a] -> [a]

1	maximos :: Ord a => [a] -> [a]

tal que (maximos xs) es la lista de los elementos de xs que son mayores que todos sus anteriores. Por ejemplo,

   maximos [1,-3,5,2,3,4,7,6,7]                         ==  [1,5,7]
   maximos "bafcdegag"                                  ==  "bfg"
   maximos (concat (replicate (10^6) "adxbcde")++"yz")  ==  "adxyz"
   length (maximos [1..10^6])                           ==  1000000

maximos [1,-3,5,2,3,4,7,6,7] == [1,5,7]

maximos "bafcdegag" == "bfg"

maximos (concat (replicate (10^6) "adxbcde")++"yz") == "adxyz"

length (maximos [1..10^6]) == 1000000

Soluciones

import Data.List (inits, nub)

-- 1ª definición (por comprensión)
maximos1 :: Ord a => [a] -> [a]
maximos1 xs =
    [x | (ys,x) <- zip (inits xs) xs, all (<x) ys]

-- 2ª definición (por recursión)
maximos2 :: Ord a => [a] -> [a]
maximos2 [] = []
maximos2 (x:xs) = x : maximos2 (filter (>x) xs)

-- 3ª definición (por recursión con acumulador)
maximos3 :: Ord a => [a] -> [a]
maximos3 [] = []
maximos3 (x:xs) = aux xs [x] x
    where aux [] zs _ = reverse zs
          aux (y:ys) zs m | y > m     = aux ys (y:zs) y
                          | otherwise = aux ys zs m 

-- 4ª definición (con scanl1):
maximos4 :: Ord a => [a] -> [a]
maximos4 = nub . scanl1 max 

-- Comparación de eficiencia
--    ghci> maximos1 (concat (replicate (10^3) "adxbcde") ++ "yz")
--    "adxyz"
--    (5.82 secs, 2859603952 bytes)
--    ghci> maximos2 (concat (replicate (10^3) "adxbcde") ++ "yz")
--    "adxyz"
--    (0.02 secs, 5879664 bytes)
--    ghci> maximos3 (concat (replicate (10^3) "adxbcde") ++ "yz")
--    "adxyz"
--    (0.03 secs, 4153680 bytes)
--    ghci> maximos4 (concat (replicate (10^3) "adxbcde") ++ "yz")
--    "adxyz"
--    (0.02 secs, 4163296 bytes)
--    
--    ghci> maximos2 (concat (replicate (10^6) "adxbcde") ++ "yz")
--    "adxyz"
--    (3.64 secs, 1314485320 bytes)
--    ghci> maximos3 (concat (replicate (10^6) "adxbcde") ++ "yz")
--    "adxyz"
--    (6.59 secs, 1706434544 bytes)
--    ghci> maximos4 (concat (replicate (10^6) "adxbcde") ++ "yz")
--    "adxyz"
--    (0.89 secs, 1594567000 bytes)
--    
--    ghci> length (maximos2 [1..10^4])
--    10000
--    (17.34 secs, 4302913816 bytes)
--    ghci> length (maximos3 [1..10^4])
--    10000
--    (0.03 secs, 6602488 bytes)
--    ghci> length (maximos4 [1..10^4])
--    10000
--    (1.37 secs, 6820408 bytes)

import Data.List (inits, nub)

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

maximos1 :: Ord a => [a] -> [a]

maximos1 xs =

[x | (ys,x) <- zip (inits xs) xs, all (<x) ys]

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

maximos2 :: Ord a => [a] -> [a]

maximos2 [] = []

maximos2 (x:xs) = x : maximos2 (filter (>x) xs)

-- 3ª definición (por recursión con acumulador)

maximos3 :: Ord a => [a] -> [a]

maximos3 [] = []

maximos3 (x:xs) = aux xs [x] x

where aux [] zs _ = reverse zs

aux (y:ys) zs m | y > m = aux ys (y:zs) y

| otherwise = aux ys zs m

-- 4ª definición (con scanl1):

maximos4 :: Ord a => [a] -> [a]

maximos4 = nub . scanl1 max

-- Comparación de eficiencia

-- ghci> maximos1 (concat (replicate (10^3) "adxbcde") ++ "yz")

-- "adxyz"

-- (5.82 secs, 2859603952 bytes)

-- ghci> maximos2 (concat (replicate (10^3) "adxbcde") ++ "yz")

-- "adxyz"

-- (0.02 secs, 5879664 bytes)

-- ghci> maximos3 (concat (replicate (10^3) "adxbcde") ++ "yz")

-- "adxyz"

-- (0.03 secs, 4153680 bytes)

-- ghci> maximos4 (concat (replicate (10^3) "adxbcde") ++ "yz")

-- "adxyz"

-- (0.02 secs, 4163296 bytes)

-- ghci> maximos2 (concat (replicate (10^6) "adxbcde") ++ "yz")

-- "adxyz"

-- (3.64 secs, 1314485320 bytes)

-- ghci> maximos3 (concat (replicate (10^6) "adxbcde") ++ "yz")

-- "adxyz"

-- (6.59 secs, 1706434544 bytes)

-- ghci> maximos4 (concat (replicate (10^6) "adxbcde") ++ "yz")

-- "adxyz"

-- (0.89 secs, 1594567000 bytes)

-- ghci> length (maximos2 [1..10^4])

-- 10000

-- (17.34 secs, 4302913816 bytes)

-- ghci> length (maximos3 [1..10^4])

-- 10000

-- (0.03 secs, 6602488 bytes)

-- ghci> length (maximos4 [1..10^4])

-- 10000

-- (1.37 secs, 6820408 bytes)

Menor n tal que el primo n-ésimo cumple una propiedad

PorJosé A. Alonso 18-junio-201528-octubre-2015

Sea p(n) el n-ésimo primo y sea r el resto de dividir (p(n)-1)^n + (p(n)+1)^n por p(n)^2. Por ejemplo,

   si n = 3, entonces p(3) =  5 y r = ( 4^3 +  6^3) mod  (5^2) =   5
   si n = 7, entonces p(7) = 17 y r = (16^7 + 18^7) mod (17^2) = 238

1 2	si n = 3, entonces p(3) = 5 y r = ( 4^3 + 6^3) mod (5^2) = 5 si n = 7, entonces p(7) = 17 y r = (16^7 + 18^7) mod (17^2) = 238

Definir la función

   menorPR :: Integer -> Integer

1	menorPR :: Integer -> Integer

tal que (menorPR x) es el menor n tal que el resto de dividir (p(n)-1)^n + (p(n)+1)^n por p(n)^2 es mayor que x. Por ejemplo,

   menorPR 100     == 5
   menorPR 345     == 9
   menorPR 1000    == 13
   menorPR (10^9)  == 7037
   menorPR (10^10) == 21035
   menorPR (10^12) == 191041

menorPR 100 == 5

menorPR 345 == 9

menorPR 1000 == 13

menorPR (10^9) == 7037

menorPR (10^10) == 21035

menorPR (10^12) == 191041

Soluciones

import Data.Numbers.Primes (primes)

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

menorPR1 :: Integer -> Integer
menorPR1 x = head [n | (n,p) <- zip [1..] primes
                     , (((p-1)^n + (p+1)^n) `mod` (p^2)) > x]

-- Segunda solución (usando el binomio de Newton)
-- ==============================================

-- Desarrollando por el binomio de Newton
--    (p+1)^n = C(n,0)p^n + C(n,1)p^(n-1) +...+ C(n,n-1)p + 1
--    (p-1)^n = C(n,0)p^n - C(n,1)p^(n-1) +...+ C(n,n-1)p + (-1)^n
-- Sumando se obtiene (según n sea par o impar)
--    2*C(n,0)p^n + 2*C(n,n-2)p^(n-1) +...+ 2*C(n,2)p^2 + 2
--    2*C(n,0)p^n + 2*C(n,n-2)p^(n-1) +...+ 2*C(n,1)p^1
-- Al dividir por p^2, el resto es (según n sea par o impar) 2 ó 2*C(n,1)p

-- (restoM n p) es el resto de de dividir (p-1)^n + (p+1)^n por p^2.
restoM :: Integer -> Integer -> Integer
restoM n p | even n    = 2
           | otherwise = 2*n*p `mod`(p^2)

menorPR2 :: Integer -> Integer
menorPR2 x = head [n | (n,p) <- zip [1..] primes, restoM n p > x]

-- Comparación de eficiencia
--    ghci> menorPR1 (3*10^8)
--    3987
--    (2.44 secs, 120291676 bytes)
--    ghci> menorPR2 (3*10^8)
--    3987
--    (0.04 secs, 8073900 bytes)

import Data.Numbers.Primes (primes)

-- 1ª solución

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

menorPR1 :: Integer -> Integer

menorPR1 x = head [n | (n,p) <- zip [1..] primes

, (((p-1)^n + (p+1)^n) `mod` (p^2)) > x]

-- Segunda solución (usando el binomio de Newton)

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

-- Desarrollando por el binomio de Newton

-- (p+1)^n = C(n,0)p^n + C(n,1)p^(n-1) +...+ C(n,n-1)p + 1

-- (p-1)^n = C(n,0)p^n - C(n,1)p^(n-1) +...+ C(n,n-1)p + (-1)^n

-- Sumando se obtiene (según n sea par o impar)

-- 2*C(n,0)p^n + 2*C(n,n-2)p^(n-1) +...+ 2*C(n,2)p^2 + 2

-- 2*C(n,0)p^n + 2*C(n,n-2)p^(n-1) +...+ 2*C(n,1)p^1

-- Al dividir por p^2, el resto es (según n sea par o impar) 2 ó 2*C(n,1)p

-- (restoM n p) es el resto de de dividir (p-1)^n + (p+1)^n por p^2.

restoM :: Integer -> Integer -> Integer

restoM n p | even n = 2

| otherwise = 2*n*p `mod`(p^2)

menorPR2 :: Integer -> Integer

menorPR2 x = head [n | (n,p) <- zip [1..] primes, restoM n p > x]

-- Comparación de eficiencia

-- ghci> menorPR1 (3*10^8)

-- 3987

-- (2.44 secs, 120291676 bytes)

-- ghci> menorPR2 (3*10^8)

-- 3987

-- (0.04 secs, 8073900 bytes)

Polinomio cromático de un grafo

PorJosé A. Alonso 17-junio-201526-marzo-2022

El polinomio cromático de un grafo calcula el número de maneras en las cuales puede ser coloreado el grafo usando un número de colores dado, de forma que dos vértices adyacentes no tengan el mismo color.

En el caso del grafo completo de n vértices, su polinomio cromático es

   P(n,x) = x(x-1)(x-2) ... (x-(n-1))

1	P(n,x) = x(x-1)(x-2) ... (x-(n-1))

Por ejemplo,

   P(3,x) = x(x-1)(x-2)      = x^3 - 3*x^2 + 2*x
   P(4,x) = x(x-1)(x-2)(x-3) = x^4 - 6*x^3 + 11*x^2 - 6*x

1 2	P(3,x) = x(x-1)(x-2) = x^3 - 3x^2 + 2x P(4,x) = x(x-1)(x-2)(x-3) = x^4 - 6x^3 + 11x^2 - 6*x

Lo que significa que P(4)(x) es el número de formas de colorear el grafo completo de 4 vértices con x colores. Por tanto,

   P(4,2) =  0 (no se puede colorear con 2 colores)
   P(4,4) = 24 (hay 24 formas de colorearlo con 4 colores)

1 2	P(4,2) = 0 (no se puede colorear con 2 colores) P(4,4) = 24 (hay 24 formas de colorearlo con 4 colores)

Definir la función

   polGC:: Int -> Polinomio Int

1	polGC:: Int -> Polinomio Int

tal que (polGC n) es el polinomio cromático del grafo completo de n vértices. Por ejemplo,

   polGC 4  ==  x^4 + -6*x^3 + 11*x^2 + -6*x
   polGC 5  ==  x^5 + -10*x^4 + 35*x^3 + -50*x^2 + 24*x

1 2	polGC 4 == x^4 + -6x^3 + 11x^2 + -6x polGC 5 == x^5 + -10x^4 + 35x^3 + -50x^2 + 24*x

Comprobar con QuickCheck que si el número de colores (x) coincide con el número de vértices del grafo (n), el número de maneras de colorear el grafo es n!.

Nota 1. Al hacer la comprobación limitar el tamaño de las pruebas como se indica a continuación

   ghci> quickCheckWith (stdArgs {maxSize=7}) prop_polGC
   +++ OK, passed 100 tests.

1 2	ghci> quickCheckWith (stdArgs {maxSize=7}) prop_polGC +++ OK, passed 100 tests.

Nota 2: Este ejercicio debe realizarse usando únicamente las funciones de la librería de polinomios (I1M.PolOperaciones) que se describe aquí y se encuentra aquí.

Soluciones

import I1M.PolOperaciones
import Test.QuickCheck

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

polGC :: Int -> Polinomio Int
polGC 0 = consPol 0 1 polCero
polGC n = polGC (n-1) `multPol` consPol 1 1 (consPol 0 (-n+1) polCero)

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

polGC2 :: Int -> Polinomio Int
polGC2 n = multLista (map polMon [0..n-1])

-- (polMon n) es el monomio x-n. Por ejemplo,
--    polMon 3  ==  1*x + -3
polMon:: Int -> Polinomio Int
polMon n = consPol 1 1 (consPol 0 (-n) polCero)

-- (multLista ps) es el producto de la lista de polinomios ps.
multLista :: [Polinomio Int] -> Polinomio Int
multLista []     = polUnidad
multLista (p:ps) = multPol p (multLista ps)

-- 3ª solución (por plegado)
-- =========================

polGC3 :: Int -> Polinomio Int
polGC3 n = foldl multPol polUnidad
           [consPol 1 1 (consPol 0 (-i) polCero) | i <- [0..n-1]]

-- Comprobación
-- ============

-- La propiedad es
prop_polGC :: Int -> Property
prop_polGC n = 
    n > 0 ==> valor (polGC n) n == product [1..n]

-- La comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_polGC
--    +++ OK, passed 100 tests.
--    (0.04 secs, 7785800 bytes)

import I1M.PolOperaciones

import Test.QuickCheck

-- 1ª solución

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

polGC :: Int -> Polinomio Int

polGC 0 = consPol 0 1 polCero

polGC n = polGC (n-1) `multPol` consPol 1 1 (consPol 0 (-n+1) polCero)

-- 2ª solución

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

polGC2 :: Int -> Polinomio Int

polGC2 n = multLista (map polMon [0..n-1])

-- (polMon n) es el monomio x-n. Por ejemplo,

-- polMon 3 == 1*x + -3

polMon:: Int -> Polinomio Int

polMon n = consPol 1 1 (consPol 0 (-n) polCero)

-- (multLista ps) es el producto de la lista de polinomios ps.

multLista :: [Polinomio Int] -> Polinomio Int

multLista [] = polUnidad

multLista (p:ps) = multPol p (multLista ps)

-- 3ª solución (por plegado)

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

polGC3 :: Int -> Polinomio Int

polGC3 n = foldl multPol polUnidad

[consPol 1 1 (consPol 0 (-i) polCero) | i <- [0..n-1]]

-- Comprobación

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

-- La propiedad es

prop_polGC :: Int -> Property

prop_polGC n =

n > 0 ==> valor (polGC n) n == product [1..n]

-- La comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=7}) prop_polGC

-- +++ OK, passed 100 tests.

-- (0.04 secs, 7785800 bytes)

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencia

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico