Menu Close

Etiqueta: and

Conjetura de las familias estables por uniones

La conjetura de las familias estables por uniones fue planteada por Péter Frankl en 1979 y aún sigue abierta.

Una familia de conjuntos es estable por uniones si la unión de dos conjuntos cualesquiera de la familia pertenece a la familia. Por ejemplo, {∅, {1}, {2}, {1,2}, {1,3}, {1,2,3}} es estable por uniones; pero {{1}, {2}, {1,3}, {1,2,3}} no lo es.

La conjetura afirma que toda familia no vacía estable por uniones y distinta de {∅} posee algún elemento que pertenece al menos a la mitad de los conjuntos de la familia.

Definir las funciones

   esEstable :: Ord a => Set (Set a) -> Bool
   familiasEstables :: Ord a => Set a -> Set (Set (Set a))
   mayoritarios :: Ord a => Set (Set a) -> [a]
   conjeturaFrankl :: Int -> Bool

tales que

  • (esEstable f) se verifica si la familia f es estable por uniones. Por ejemplo,
     λ> esEstable (fromList [empty, fromList [1,2], fromList [1..5]])
     True
     λ> esEstable (fromList [empty, fromList [1,7], fromList [1..5]])
     False
     λ> esEstable (fromList [fromList [1,2], singleton 3, fromList [1..3]])
     True
  • (familiasEstables c) es el conjunto de las familias estables por uniones formadas por elementos del conjunto c. Por ejemplo,
     λ> familiasEstables (fromList [1..2])
     fromList
       [ fromList []
       , fromList [fromList []]
       , fromList [fromList [],fromList [1]]
       , fromList [fromList [],fromList [1],fromList [1,2]],
         fromList [fromList [],fromList [1],fromList [1,2],fromList [2]]
       , fromList [fromList [],fromList [1,2]]
       , fromList [fromList [],fromList [1,2],fromList [2]]
       , fromList [fromList [],fromList [2]]
       , fromList [fromList [1]]
       , fromList [fromList [1],fromList [1,2]]
       , fromList [fromList [1],fromList [1,2],fromList [2]]
       , fromList [fromList [1,2]]
       , fromList [fromList [1,2],fromList [2]]
       , fromList [fromList [2]]]
     λ> size (familiasEstables (fromList [1,2]))
     14
     λ> size (familiasEstables (fromList [1..3]))
     122
     λ> size (familiasEstables (fromList [1..4]))
     4960
  • (mayoritarios f) es la lista de elementos que pertenecen al menos a la mitad de los conjuntos de la familia f. Por ejemplo,
     mayoritarios (fromList [empty, fromList [1,3], fromList [3,5]]) == [3]
     mayoritarios (fromList [empty, fromList [1,3], fromList [4,5]]) == []
  • (conjeturaFrankl n) se verifica si para toda familia f formada por elementos del conjunto {1,2,…,n} no vacía, estable por uniones y distinta de {∅} posee algún elemento que pertenece al menos a la mitad de los conjuntos de f. Por ejemplo.
     conjeturaFrankl 2  ==  True
     conjeturaFrankl 3  ==  True
     conjeturaFrankl 4  ==  True

Soluciones

 
import Data.Set  as S ( Set
                      , delete
                      , deleteFindMin
                      , empty
                      , filter
                      , fromList
                      , insert
                      , map
                      , member
                      , null
                      , singleton
                      , size
                      , toList
                      , union
                      , unions
                      )
import Data.List as L ( filter
                      , null
                      )
 
esEstable :: Ord a => Set (Set a) -> Bool
esEstable xss =
  and [ys `S.union` zs `member` xss | (ys,yss) <- selecciones xss
                                    , zs <- toList yss]
 
-- (seleccciones xs) es la lista de los pares formada por un elemento de
-- xs y los restantes elementos. Por ejemplo,
--    λ> selecciones (fromList [3,2,5])
--    [(2,fromList [3,5]),(3,fromList [2,5]),(5,fromList [2,3])]
selecciones :: Ord a => Set a -> [(a,Set a)]
selecciones xs =
  [(x,delete x xs) | x <- toList xs] 
 
familiasEstables :: Ord a => Set a -> Set (Set (Set a))
familiasEstables xss =
  S.filter esEstable (familias xss)
 
-- (familias c) es la familia formadas con elementos de c. Por ejemplo,
--    λ> mapM_ print (familias (fromList [1,2]))
--    fromList []
--    fromList [fromList []]
--    fromList [fromList [],fromList [1]]
--    fromList [fromList [],fromList [1],fromList [1,2]]
--    fromList [fromList [],fromList [1],fromList [1,2],fromList [2]]
--    fromList [fromList [],fromList [1],fromList [2]]
--    fromList [fromList [],fromList [1,2]]
--    fromList [fromList [],fromList [1,2],fromList [2]]
--    fromList [fromList [],fromList [2]]
--    fromList [fromList [1]]
--    fromList [fromList [1],fromList [1,2]]
--    fromList [fromList [1],fromList [1,2],fromList [2]]
--    fromList [fromList [1],fromList [2]]
--    fromList [fromList [1,2]]
--    fromList [fromList [1,2],fromList [2]]
--    fromList [fromList [2]]
--    λ> size (familias (fromList [1,2]))
--    16
--    λ> size (familias (fromList [1,2,3]))
--    256
--    λ> size (familias (fromList [1,2,3,4]))
--    65536
familias :: Ord a => Set a -> Set (Set (Set a))
familias c =
  subconjuntos (subconjuntos c)
 
-- (subconjuntos c) es el conjunto de los subconjuntos de c. Por ejemplo,
--    λ> mapM_ print (subconjuntos (fromList [1,2,3]))
--    fromList []
--    fromList [1]
--    fromList [1,2]
--    fromList [1,2,3]
--    fromList [1,3]
--    fromList [2]
--    fromList [2,3]
--    fromList [3]
subconjuntos :: Ord a => Set a -> Set (Set a)
subconjuntos c
  | S.null c  = singleton empty
  | otherwise = S.map (insert x) sr `union` sr
  where (x,rc) = deleteFindMin c
        sr     = subconjuntos rc
 
-- (elementosFamilia f) es el conjunto de los elementos de los elementos
-- de la familia f. Por ejemplo, 
--    λ> elementosFamilia (fromList [empty, fromList [1,2], fromList [2,5]])
--    fromList [1,2,5]
elementosFamilia :: Ord a => Set (Set a) -> Set a
elementosFamilia = unions . toList
 
-- (nOcurrencias f x) es el número de conjuntos de la familia f a los
-- que pertenece el elemento x. Por ejemplo,
--    nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 3 == 2
--    nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 4 == 0
--    nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 5 == 1
nOcurrencias :: Ord a => Set (Set a) -> a -> Int
nOcurrencias f x =
  length (L.filter (x `member`) (toList f))
 
mayoritarios :: Ord a => Set (Set a) -> [a]
mayoritarios f =
  [x | x <- toList (elementosFamilia f)
     , nOcurrencias f x >= n]
  where n = (1 + size f) `div` 2
 
conjeturaFrankl :: Int -> Bool
conjeturaFrankl n =
  and [ not (L.null (mayoritarios f))
      | f <- fs
      , f /= fromList []
      , f /= fromList [empty]]
  where fs = toList (familiasEstables (fromList [1..n]))
 
 
-- conjeturaFrankl' :: Int -> Bool
conjeturaFrankl' n =
  [f | f <- fs
     , L.null (mayoritarios f)
     , f /= fromList []
     , f /= fromList [empty]]
  where fs = toList (familiasEstables (fromList [1..n]))

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Cliques de un grafo

Nota: En este ejercicio usaremos las mismas notaciones que en el anterior importando el módulo Grafo.

Un clique (en español, pandilla) de un grafo g es un conjunto de nodos de g tal que todos sus elementos están conectados en g.

Definir las funciones

   esClique :: Eq a => Grafo a -> [a] -> Bool
   cliques  :: Eq a => Grafo a -> [[a]]

tales que

  • (esClique g xs) se verifica si el conjunto de nodos xs del grafo g es un clique de g. Por ejemplo,
     esClique [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] [2,3,5]  ==  True
     esClique [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] [2,3,4]  ==  False
  • (cliques g) es la lista de los cliques del grafo g. Por ejemplo,
     λ> cliques [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)]
     [[],[1],[2],[1,2],[3],[2,3],[4],[2,4],
      [5],[2,5],[3,5],[2,3,5],[4,5],[2,4,5]]

Nota: Escribir la solución en el módulo Cliques para poderlo usar en los siguientes ejercicios.

Soluciones

module Cliques where
 
import Grafo
import Data.List (tails, subsequences)
 
esClique :: Eq a => Grafo a -> [a] -> Bool
esClique g xs =
  and [conectados g x y | (x,y) <- parejas xs]
 
-- (parejas xs) es la lista de las parejas formados por los elementos de
-- xs y sus siguientes en xs. Por ejemplo, 
--    parejas [1..4] == [(1,2),(1,3),(1,4),(2,3),(2,4),(3,4)]
parejas :: [a] -> [(a,a)]
parejas xs =
  [(x,y) | (x:ys) <- tails xs
         , y <- ys]
 
cliques :: Eq a => Grafo a -> [[a]]
cliques g =
  [xs | xs <- subsequences (nodos g)
      , esClique g xs]

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang=”haskell”> y otra con </pre>

Pensamiento

“Para enseñar de manera efectiva, un profesor debe desarrollar un sentimiento por su asignatura; no puede hacer que sus alumnos sientan su vitalidad si no la siente él mismo. No puede compartir su entusiasmo cuando no tiene entusiasmo que compartir. La forma en que expone su tema puede ser tan importante como el tema que expone; debe sentir personalmente que es importante.”

George Pólya.

Evaluación de FNC (fórmulas en forma normal conjuntiva)

Una FNC (fórmula en forma normal conjuntiva) es una conjunción de cláusulas, donde una cláusula es una disyunción de literales y un literal es un átomo o su negación. Por ejemplo,

   (x(1) v -x(3)) & x(2) & (-x(2) v x(3) v x(1))

es una FNC con tres clásulas tales que la primera cláusula tiene 2 literales (x(1) y -x(3)), la segunda tiene 1 (x(2)) y la tercera tiene 3 (-x(2), x(3) y x(1)).

Usaremos las siguientes representaciones:

  • Los átomos se representan por enteros positivos. Por ejemplo, 3 representa x(3).
  • Los literales se representan por enteros. Por ejemplo, 3 representa el literal positivo x(3) y -5 el literal negativo -x(5).
  • Una cláusula es una lista de literales que representa la disyunción se sus literales. Por ejemplo, [3,2,-4] representa a (x(3) v x(2) v -x(4)).
  • Una fórmula en forma normal conjuntiva (FNC) es una lista de cláusulas que representa la conjunción de sus cláusulas. Por ejemplo, [[3,2],[-1,2,5]] representa a ((x(3) v x(2)) & (-x(1) v x(2) v x(5))).

Una interpretación I es un conjunto de átomos. Se supone que los átomos de I son verdaderos y los restantes son falsos. Por ejemplo, en la interpretación [2,5]

  • el literal x(2) es verdadero (porque 2 ∈ [2,5])
  • el literal x(3) es falso (porque 3 ∉ [2,5])
  • el literal -x(4) es verdadero (porque 4 ∉ [2,5])
  • la cláusula (x(2) v x(3)) es verdadera (porque x(2) es verdadero)
  • la cláusula (x(3) v x(4)) es falsa (porque x(3) y x(4) son falsos)
  • la FNC ((x(2) v x(5)) & (-x(4) v x(3)) es verdadera porque lo son sus dos cláusulas

En el ejercicio se usarán los siguientes tipos de datos

   type Atomo          = Int
   type Literal        = Int
   type Clausula       = [Literal]
   type FNC            = [Clausula]
   type Interpretacion = [Atomo]

Definir las siguientes funciones

   valorLiteral  :: Interpretacion -> Literal -> Bool
   valorClausula :: Interpretacion -> Clausula -> Bool
   valor         :: Interpretacion -> FNC -> Bool

tales que

  • (valorLiteral i l) es el valor del literal l en la interpretación i. Por ejemplo,
     valorLiteral [3,5] 3     ==  True
     valorLiteral [3,5] 4     ==  False
     valorLiteral [3,5] (-3)  ==  False
     valorLiteral [3,5] (-4)  ==  True
  • (valorClausula i c) es el valor de la cláusula c en la interpretación i. Por ejemplo,
     valorClausula [3,5] [2,3,-5]  ==  True
     valorClausula [3,5] [2,4,-1]  ==  True
     valorClausula [3,5] [2,4,1]   ==  False
  • (valor i f) es el valor de la fórmula en FNC f en la interpretación i. Por ejemplo,
     valor [1,3] [[1,-2],[3]]  ==  True
     valor [1]   [[1,-2],[3]]  ==  False
     valor [1]   []            ==  True

Nota: Escribir la solución en el módulo Evaluacion_de_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Evaluacion_de_FNC where
 
type Atomo          = Int
type Literal        = Int
type Clausula       = [Literal]
type FNC            = [Clausula]
type Interpretacion = [Atomo]
 
-- Definición de valorLiteral
-- ==========================
 
valorLiteral :: Interpretacion -> Literal -> Bool
valorLiteral i l
  | l > 0     = l `elem` i
  | otherwise = negate l `notElem` i
 
-- Definiciones de valorClausula
-- =============================
 
-- 1ª definición
valorClausula :: Interpretacion -> Clausula -> Bool
valorClausula i c = or [valorLiteral i l | l <- c]
 
-- 2ª definición
valorClausula2 :: Interpretacion -> Clausula -> Bool
valorClausula2 i = any (valorLiteral i)
 
-- Definiciones de valor de FNC
-- ============================
 
-- 1ª definición
valor :: Interpretacion -> FNC -> Bool
valor i f = and [valorClausula i c | c <- f]
 
-- 2ª definición
valor2 :: Interpretacion -> FNC -> Bool
valor2 i = all (valorClausula i)

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang=”haskell”> y otra con </pre>

Pensamiento

“Todo buen matemático es al menos medio filósofo, y todo buen filósofo es al menos medio matemático.”

Gottlob Frege.

Menor divisible por todos

Definir la función

   menorDivisible :: Integer -> Integer -> Integer

tal que (menorDivisible a b) es el menor número divisible por todos los números desde a hasta b, ambos inclusive. Por ejemplo,

   menorDivisible 1 10                        ==  2520
   length (show (menorDivisible 1 (3*10^5)))  ==  130141

Nota: Este ejercicio está basado en el problema 5 del Proyecto Euler

Soluciones

import Data.List (foldl')
 
-- 1ª solución
-- ===========
 
menorDivisible :: Integer -> Integer -> Integer
menorDivisible a b =
  head [x | x <- [b..]
          , and [x `mod` y == 0 | y <- [a..b]]]
 
-- 2ª solución
-- ===========
 
menorDivisible2 :: Integer -> Integer -> Integer
menorDivisible2 a b  
  | a == b    = a
  | otherwise = lcm a (menorDivisible (a+1) b)
 
-- 3ª solución
-- ============
 
menorDivisible3 :: Integer -> Integer -> Integer
menorDivisible3 a b = foldl lcm 1 [a..b] 
 
-- 4ª solución
-- ===========
 
menorDivisible4 :: Integer -> Integer -> Integer
menorDivisible4 a b = foldl1 lcm [a..b] 
 
-- 5ª solución
-- ===========
 
menorDivisible5 :: Integer -> Integer -> Integer
menorDivisible5 a b = foldl' lcm 1 [a..b] 
 
-- 6ª solución
-- ===========
 
menorDivisible6 :: Integer -> Integer -> Integer
menorDivisible6 a b = foldr1 lcm [a..b] 
 
-- 7ª solución
-- ===========
 
menorDivisible7 :: Integer -> Integer -> Integer
menorDivisible7 a = foldr1 lcm . enumFromTo a
 
-- Comparación de eficiencia
-- =========================
 
--   λ> menorDivisible 1 17
--   12252240
--   (18.63 secs, 15,789,475,488 bytes)
--   λ> menorDivisible2 1 17
--   12252240
--   (13.29 secs, 11,868,764,272 bytes)
--   λ> menorDivisible3 1 17
--   12252240
--   (0.00 secs, 114,688 bytes)
--   λ> menorDivisible4 1 17
--   12252240
--   (0.01 secs, 114,752 bytes)
--   λ> menorDivisible5 1 17
--   12252240
--   (0.01 secs, 110,640 bytes)
--   λ> menorDivisible6 1 17
--   12252240
--   (0.01 secs, 114,752 bytes)
--   λ> menorDivisible7 1 17
--   12252240
--   (0.00 secs, 110,912 bytes)
--   
--   λ> length (show (menorDivisible3 1 (10^5)))
--   43452
--   (1.54 secs, 2,021,887,000 bytes)
--   λ> length (show (menorDivisible4 1 (10^5)))
--   43452
--   (1.47 secs, 2,021,886,616 bytes)
--   λ> length (show (menorDivisible5 1 (10^5)))
--   43452
--   (0.65 secs, 2,009,595,568 bytes)
--   λ> length (show (menorDivisible6 1 (10^5)))
--   43452
--   (0.30 secs, 172,986,840 bytes)
--   λ> length (show (menorDivisible7 1 (10^5)))
--   43452
--   (0.30 secs, 172,986,920 bytes)
--   
--   λ> length (show (menorDivisible5 1 (2*10^5)))
--   86871
--   (2.47 secs, 7,989,147,304 bytes)
--   λ> length (show (menorDivisible6 1 (2*10^5)))
--   86871
--   (0.89 secs, 533,876,496 bytes)
--   λ> length (show (menorDivisible7 1 (2*10^5)))
--   86871
--   (0.88 secs, 533,875,608 bytes)

Pensamiento

Será el peor de los malos
bribón que olvide
su vocación de diablo.

Antonio Machado

Conjunto de primos relativos

Dos números enteros son primos relativos si no tienen ningún factor primo en común, o, dicho de otra manera, si no tienen otro divisor común más que 1 y -1. Equivalentemente son primos entre sí, si y sólo si, su máximo común divisor es igual a 1.

Por ejemplo, 6 y 35 son primos entre sí, pero 6 y 27 no lo son porque ambos son divisibles por 3

Definir la función

   primosRelativos :: [Int] -> Bool

tal que (primosRelativos xs) se verifica si los elementos de xs son primos relativos dos a dos. Por ejemplo,

   primosRelativos [6,35]         ==  True
   primosRelativos [6,27]         ==  False
   primosRelativos [2,3,4]        ==  False
   primosRelativos [6,35,11]      ==  True
   primosRelativos [6,35,11,221]  ==  True
   primosRelativos [6,35,11,231]  ==  False

Soluciones

import Data.List (delete)
 
-- 1ª solución (por recursión):
primosRelativos :: [Int] -> Bool
primosRelativos []     = True
primosRelativos (x:xs) =
  and [gcd x y == 1 | y <- xs] && primosRelativos xs
 
-- 2ª solución (por comprensión):
primosRelativos2 :: [Int] -> Bool
primosRelativos2 xs = and [gcd x y == 1 | x <- xs, y <- delete x xs]

Pensamiento

Busca en tu prójimo espejo;
pero no para afeitarte,
ni para teñirte el pelo.

Antonio Machado

Números altamente compuestos

Un número altamente compuesto es un entero positivo con más divisores que cualquier entero positivo más pequeño. Por ejemplo,

  • 4 es un número altamente compuesto porque es el menor con 3 divisores,
  • 5 no es altamente compuesto porque tiene menos divisores que 4 y
  • 6 es un número altamente compuesto porque es el menor con 4 divisores,

Los primeros números altamente compuestos son

   1, 2, 4, 6, 12, 24, 36, 48, 60, 120, 180, 240, 360, ...

Definir las funciones

   esAltamenteCompuesto       :: Int -> Bool
   altamenteCompuestos        :: [Int]
   graficaAltamenteCompuestos :: Int -> IO ()

tales que

  • (esAltamanteCompuesto x) se verifica si x es altamente compuesto. Por ejemplo,
     esAltamenteCompuesto 4      ==  True
     esAltamenteCompuesto 5      ==  False
     esAltamenteCompuesto 6      ==  True
     esAltamenteCompuesto 1260   ==  True
     esAltamenteCompuesto 2520   ==  True
     esAltamenteCompuesto 27720  ==  True
  • altamente compuestos es la sucesión de los números altamente compuestos. Por ejemplo,
     λ> take 20 altamenteCompuestos
     [1,2,4,6,12,24,36,48,60,120,180,240,360,720,840,1260,1680,2520,5040,7560]
  • (graficaAltamenteCompuestos n) dibuja la gráfica de los n primeros números altamente compuestos. Por ejemplo, (graficaAltamenteCompuestos 25) dibuja

Soluciones

import Data.List (group)
import Data.Numbers.Primes (primeFactors)
import Graphics.Gnuplot.Simple
 
-- 1ª definición de esAltamenteCompuesto
-- =====================================
 
esAltamenteCompuesto :: Int -> Bool
esAltamenteCompuesto x =
  and [nDivisores x > nDivisores y | y <- [1..x-1]]
 
-- (nDivisores x) es el número de divisores de x. Por ejemplo,
--    nDivisores 30  ==  8
nDivisores :: Int -> Int
nDivisores x = length (divisores x)
 
-- (divisores x) es la lista de los divisores de x. Por ejemplo,
--    divisores 30  ==  [1,2,3,5,6,10,15,30]
divisores :: Int -> [Int]
divisores x =
  [y | y <- [1..x]
     , x `mod` y == 0]
 
-- 2ª definición de esAltamenteCompuesto
-- =====================================
 
esAltamenteCompuesto2 :: Int -> Bool
esAltamenteCompuesto2 x =
  all (nDivisores2 x >) [nDivisores2 y | y <- [1..x-1]]
 
-- (nDivisores2 x) es el número de divisores de x. Por ejemplo,
--    nDivisores2 30  ==  8
nDivisores2 :: Int -> Int
nDivisores2 = succ . length . divisoresPropios
 
-- (divisoresPropios x) es la lista de los divisores de x menores que
-- x. Por ejemplo, 
--    divisoresPropios 30  ==  [1,2,3,5,6,10,15]
divisoresPropios :: Int -> [Int]
divisoresPropios x =
  [y | y <- [1..x `div` 2]
     , x `mod` y == 0]
 
-- 3ª definición de esAltamenteCompuesto
-- =====================================
 
esAltamenteCompuesto3 :: Int -> Bool
esAltamenteCompuesto3 x =
  all (nDivisores3 x >) [nDivisores3 y | y <- [1..x-1]]
 
-- (nDivisores3 x) es el número de divisores de x. Por ejemplo,
--    nDivisores3 30  ==  8
nDivisores3 :: Int -> Int
nDivisores3 x =
  product [1 + length xs | xs <- group (primeFactors x)]
 
-- 4ª definición de esAltamenteCompuesto
-- =====================================
 
esAltamenteCompuesto4 :: Int -> Bool
esAltamenteCompuesto4 x =
  x `pertenece` altamenteCompuestos2
 
-- 1ª definición de altamenteCompuestos 
-- ====================================
 
altamenteCompuestos :: [Int]
altamenteCompuestos =
  filter esAltamenteCompuesto4 [1..]
 
-- 2ª definición de altamenteCompuestos 
-- ====================================
 
altamenteCompuestos2 :: [Int]
altamenteCompuestos2 =
  1 : [y | ((x,n),(y,m)) <- zip sucMaxDivisores (tail sucMaxDivisores)
         , m > n]
 
-- sucMaxDivisores es la sucesión formada por los números enteros
-- positivos y el máximo número de divisores hasta cada número. Por
-- ejemplo,
--    λ> take 12 sucMaxDivisores
--    [(1,1),(2,2),(3,2),(4,3),(5,3),(6,4),(7,4),(8,4),(9,4),(10,4),(11,4),(12,6)]
sucMaxDivisores :: [(Int,Int)]
sucMaxDivisores =
  zip [1..] (scanl1 max (map nDivisores3 [1..]))
 
pertenece :: Int -> [Int] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)
 
-- Comparación de eficiencia de esAltamenteCompuesto
-- =================================================
 
--    λ> esAltamenteCompuesto 1260
--    True
--    (2.99 secs, 499,820,296 bytes)
--    λ> esAltamenteCompuesto2 1260
--    True
--    (0.51 secs, 83,902,744 bytes)
--    λ> esAltamenteCompuesto3 1260
--    True
--    (0.04 secs, 15,294,192 bytes)
--    λ> esAltamenteCompuesto4 1260
--    True
--    (0.04 secs, 15,594,392 bytes)
--    
--    λ> esAltamenteCompuesto2 2520
--    True
--    (2.10 secs, 332,940,168 bytes)
--    λ> esAltamenteCompuesto3 2520
--    True
--    (0.09 secs, 37,896,168 bytes)
--    λ> esAltamenteCompuesto4 2520
--    True
--    (0.06 secs, 23,087,456 bytes)
--
--    λ> esAltamenteCompuesto3 27720
--    True
--    (1.32 secs, 841,010,624 bytes)
--    λ> esAltamenteCompuesto4 27720
--    True
--    (1.33 secs, 810,870,384 bytes)
 
-- Comparación de eficiencia de altamenteCompuestos
-- ================================================
 
--    λ> altamenteCompuestos !! 25
--    45360
--    (2.84 secs, 1,612,045,976 bytes)
--    λ> altamenteCompuestos2 !! 25
--    45360
--    (0.01 secs, 102,176 bytes)
 
-- Definición de graficaAltamenteCompuestos
-- ========================================
 
graficaAltamenteCompuestos :: Int -> IO ()
graficaAltamenteCompuestos n =
  plotList [ Key Nothing
           , PNG ("Numeros_altamente_compuestos.png")
           ]
           (take n altamenteCompuestos2)

Pensamiento

Nuestras horas son minutos
cuando esperamos saber,
y siglos cuando sabemos
lo que se puede aprender.

Antonio Machado

Reconocimiento de conmutatividad

Para representar las operaciones binarias en un conjunto finito A con n elementos se pueden numerar sus elementos desde el 0 al n-1. Entonces cada operación binaria en A se puede ver como una lista de listas xss tal que el valor de aplicar la operación a los elementos i y j es el j-ésimo elemento del i-ésimo elemento de xss. Por ejemplo, si A = {0,1,2} entonces las tabla de la suma y de la resta módulo 3 en A son

   0 1 2    0 2 1
   1 2 0    1 0 2
   2 0 1    2 1 0
   Suma     Resta

Definir la función

   conmutativa :: [[Int]] -> Bool

tal que (conmutativa xss) se verifica si la operación cuya tabla es xss es conmutativa. Por ejemplo,

   conmutativa [[0,1,2],[1,0,1],[2,1,0]]  ==  True
   conmutativa [[0,1,2],[1,0,0],[2,1,0]]  ==  False
   conmutativa [[i+j `mod` 2000 | j <- [0..1999]] | i <- [0..1999]] == True
   conmutativa [[i-j `mod` 2000 | j <- [0..1999]] | i <- [0..1999]] == False

Soluciones

import Data.List (transpose)
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
conmutativa :: [[Int]] -> Bool
conmutativa xss =
  and [producto i j == producto j i | i <- [0..n-1], j <- [0..n-1]]
  where producto i j = (xss !! i) !! j
        n            = length xss
 
-- 2ª solución
-- ===========
 
conmutativa2 :: [[Int]] -> Bool
conmutativa2 []         = True
conmutativa2 t@(xs:xss) = xs == map head t
                          && conmutativa2 (map tail xss)
 
-- 3ª solución
-- ===========
 
conmutativa3 :: [[Int]] -> Bool
conmutativa3 xss = xss == transpose xss
 
-- 4ª solución
-- ===========
 
conmutativa4 :: [[Int]] -> Bool
conmutativa4 = (==) <*> transpose 
 
-- Equivalencia de las definiciones
-- ================================
 
-- Para comprobar la equivalencia se define el tipo de tabla de
-- operciones binarias:
newtype Tabla = T [[Int]]
  deriving Show
 
-- genTabla es un generador de tablas de operciones binaria. Por ejemplo,
--    λ> sample genTabla
--    T [[2,0,0],[1,2,1],[1,0,2]]
--    T [[0,3,0,1],[0,1,2,1],[0,2,1,2],[3,0,0,2]]
--    T [[2,0,1],[1,0,0],[2,1,2]]
--    T [[1,0],[0,1]]
--    T [[1,1],[0,1]]
--    T [[1,1,2],[1,0,1],[2,1,0]]
--    T [[4,4,3,0,2],[2,2,0,1,2],[4,0,1,0,0],[0,4,4,3,3],[3,0,4,2,1]]
--    T [[3,4,1,4,1],[2,4,4,0,4],[1,2,1,4,3],[3,1,4,4,2],[4,1,3,2,3]]
--    T [[2,0,1],[2,1,0],[0,2,2]]
--    T [[3,2,0,3],[2,1,1,1],[0,2,1,0],[3,3,2,3]]
--    T [[2,0,2,0],[0,0,3,1],[1,2,3,2],[3,3,0,2]]
genTabla :: Gen Tabla
genTabla = do
  n  <- choose (2,20)
  xs <- vectorOf (n^2) (elements [0..n-1])
  return (T (separa n xs))
 
-- (separa n xs) es la lista obtenidaseparando los elementos de xs en
-- grupos de n elementos. Por ejemplo,
--    separa 3 [1..9]  ==  [[1,2,3],[4,5,6],[7,8,9]]
separa :: Int -> [a] -> [[a]]
separa _ [] = []
separa n xs = take n xs : separa n (drop n xs)
 
-- Generación arbitraria de tablas
instance Arbitrary Tabla where
  arbitrary = genTabla
 
-- La propiedad es
prop_conmutativa :: Tabla -> Bool
prop_conmutativa (T xss) =
  conmutativa xss  == conmutativa2 xss &&
  conmutativa2 xss == conmutativa3 xss &&
  conmutativa2 xss == conmutativa4 xss
 
-- La comprobación es
--    λ> quickCheck prop_conmutativa
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- Para las comparaciones se usará la función tablaSuma tal que
-- (tablaSuma n) es la tabla de la suma módulo n en [0..n-1]. Por
-- ejemplo, 
--    tablaSuma 3  ==  [[0,1,2],[1,2,3],[2,3,4]]
tablaSuma ::  Int -> [[Int]]
tablaSuma n =
  [[i + j `mod` n | j <- [0..n-1]] | i <- [0..n-1]]
 
-- La comparación es
--    λ> conmutativa (tablaSuma 400)
--    True
--    (1.92 secs, 147,608,696 bytes)
--    λ> conmutativa2 (tablaSuma 400)
--    True
--    (0.14 secs, 63,101,112 bytes)
--    λ> conmutativa3 (tablaSuma 400)
--    True
--    (0.10 secs, 64,302,608 bytes)
--    λ> conmutativa4 (tablaSuma 400)
--    True
--    (0.10 secs, 61,738,928 bytes)
--    
--    λ> conmutativa2 (tablaSuma 2000)
--    True
--    (1.81 secs, 1,569,390,480 bytes)
--    λ> conmutativa3 (tablaSuma 2000)
--    True
--    (3.07 secs, 1,601,006,840 bytes)
--    λ> conmutativa4 (tablaSuma 2000)
--    True
--    (3.14 secs, 1,536,971,288 bytes)

Pensamiento

“Nuestras horas son minutos cuando esperamos saber, y siglos cuando
sabemos lo que se puede aprender.”

Antonio Machado

Menor contenedor de primos

El n-ésimo menor contenenedor de primos es el menor número que contiene como subcadenas los primeros n primos. Por ejemplo, el 6º menor contenedor de primos es 113257 ya que es el menor que contiene como subcadenas los 6 primeros primos (2, 3, 5, 7, 11 y 13).

Definir la función

   menorContenedor :: Int -> Int

tal que (menorContenedor n) es el n-ésimo menor contenenedor de primos. Por ejemplo,

   menorContenedor 1  ==  2
   menorContenedor 2  ==  23
   menorContenedor 3  ==  235
   menorContenedor 4  ==  2357
   menorContenedor 5  ==  112357
   menorContenedor 6  ==  113257

Soluciones

import Data.List           (isInfixOf)
import Data.Numbers.Primes (primes)
 
-- 1ª solución
-- ===========
 
menorContenedor :: Int -> Int
menorContenedor n =
  head [x | x <- [2..]
          , and [contenido y x | y <- take n primes]]
 
contenido :: Int -> Int -> Bool
contenido x y =
  show x `isInfixOf` show y
 
-- 2ª solución
-- ===========
 
menorContenedor2 :: Int -> Int
menorContenedor2 n =
  head [x | x <- [2..]
          , all (`contenido` x) (take n primes)]

Pensamiento

¡Ya hay hombres activos!
Soñaba la charca
con sus mosquitos.

Antonio Machado

Números colinas

Se dice que un número natural n es una colina si su primer dígito es igual a su último dígito, los primeros dígitos son estrictamente creciente hasta llegar al máximo, el máximo se puede repetir y los dígitos desde el máximo al final son estrictamente decrecientes.

Definir la función

   esColina :: Integer -> Bool

tal que (esColina n) se verifica si n es un número colina. Por ejemplo,

   esColina 12377731  ==  True
   esColina 1237731   ==  True
   esColina 123731    ==  True
   esColina 122731    ==  False
   esColina 12377730  ==  False
   esColina 12377730  ==  False
   esColina 10377731  ==  False
   esColina 12377701  ==  False
   esColina 33333333  ==  True

Soluciones

import Data.Char (digitToInt)
 
-- 1ª definición
-- =============
 
esColina :: Integer -> Bool
esColina n =
  head ds == last ds &&
  esCreciente xs &&
  esDecreciente ys
  where ds = digitos n
        m  = maximum ds
        xs = takeWhile (<m) ds
        ys = dropWhile (==m) (dropWhile (<m) ds)
 
-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 425  ==  [4,2,5]
digitos :: Integer -> [Int]
digitos n = map digitToInt (show n)
 
-- (esCreciente xs) se verifica si la lista xs es estrictamente
-- creciente. Por ejemplo,
--    esCreciente [2,4,7]  ==  True
--    esCreciente [2,2,7]  ==  False
--    esCreciente [2,1,7]  ==  False
esCreciente :: [Int] -> Bool
esCreciente xs = and [x < y | (x,y) <- zip xs (tail xs)]
 
-- (esDecreciente xs) se verifica si la lista xs es estrictamente
-- decreciente. Por ejemplo,
--    esDecreciente [7,4,2]  ==  True
--    esDecreciente [7,2,2]  ==  False
--    esDecreciente [7,1,2]  ==  False
esDecreciente :: [Int] -> Bool
esDecreciente xs = and [x > y | (x,y) <- zip xs (tail xs)]
 
-- 2ª definición
-- =============
 
esColina2 :: Integer -> Bool
esColina2 n =
  head ds == last ds &&
  null (dropWhile (==(-1)) (dropWhile (==0) (dropWhile (==1) xs)))
  where ds = digitos n
        xs = [signum (y-x) | (x,y) <- zip ds (tail ds)] 
 
-- Equivalencia
-- ============
 
-- La propiedad de equivalencia es
prop_esColina :: Integer -> Property
prop_esColina n =
  n >= 0 ==> esColina n == esColina2 n 
 
-- La comprobación es
--    λ> quickCheck prop_esColina
--    +++ OK, passed 100 tests.

Referencia

Basado en el problema Is this number a hill number? de Code Golf

Pensamiento

Si me tengo que morir
poco me importa aprender.
Y si no puedo saber,
poco me importa vivir.

Antonio Machado

Relación definida por una partición

Dos elementos están relacionados por una partición xss si pertenecen al mismo elemento de xss.

Definir la función

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

tal que (relacionados xss y z) se verifica si los elementos y y z están relacionados por la partición xss. Por ejemplo,

   relacionados [[1,3],[2],[9,5,7]] 7 9  ==  True
   relacionados [[1,3],[2],[9,5,7]] 3 9  ==  False
   relacionados [[1,3],[2],[9,5,7]] 4 9  ==  False

Soluciones

import Data.List ((\\), intersect)
 
-- 1ª definición
-- =============
 
relacionados :: Eq a => [[a]] -> a -> a -> Bool
relacionados [] _ _ = False
relacionados (xs:xss) y z
  | y `elem` xs = z `elem` xs
  | otherwise   = relacionados xss y z
 
-- 2ª definición
-- =============
 
relacionados2 :: Eq a => [[a]] -> a -> a -> Bool
relacionados2 xss y z =
  or [elem y xs && elem z xs | xs <- xss]
 
-- 3ª definición
-- =============
 
relacionados3 :: Eq a => [[a]] -> a -> a -> Bool
relacionados3 xss y z =
  or [[y,z] `subconjunto` xs | xs <- xss]
 
-- (subconjunto xs ys) se verifica si xs es un subconjunto de ys; es
-- decir, si todos los elementos de xs pertenecen a ys. Por ejemplo,  
--    subconjunto [3,2,3] [2,5,3,5]  ==  True
--    subconjunto [3,2,3] [2,5,6,5]  ==  False
subconjunto :: Eq a => [a] -> [a] -> Bool
subconjunto xs ys = and [elem x ys | x <- xs]
 
-- 4ª definición
-- =============
 
relacionados4 :: Eq a => [[a]] -> a -> a -> Bool
relacionados4 xss y z =
  any ([y,z] `subconjunto`) xss

Pensamiento

No hay lío político que no sea un trueque, una confusión de máscaras, un mal ensayo de comedia, en que nadie sabe su papel.

Antonio Machado