Menu Close

Etiqueta: any

Familias de números con algún dígito en común

Una familia de números es una lista de números tal que todos tienen la misma cantidad de dígitos y, además, dichos números tienen al menos un dígito común.

Por ejemplo, los números 72, 32, 25 y 22 pertenecen a la misma familia ya que son números de dos dígitos y todos tienen el dígito 2, mientras que los números 123, 245 y 568 no pertenecen a la misma familia, ya que no hay un dígito que aparezca en los tres números.

Definir la función

   esFamilia :: [Integer] -> Bool

tal que (esFamilia ns) se verifica si ns es una familia de números. Por ejemplo,

   esFamilia [72, 32, 25, 22]  ==  True
   esFamilia [123,245,568]     ==  False
   esFamilia [72, 32, 25, 223] ==  False
   esFamilia [56]              ==  True
   esFamilia []                ==  True

Soluciones

import Data.List (intersect, nub)
import Test.QuickCheck (quickCheck)
 
-- 1ª solución
-- ===========
 
esFamilia1 :: [Integer] -> Bool
esFamilia1 [] = True
esFamilia1 ns =
  igualNumeroElementos dss && tieneElementoComun dss
  where dss = map show ns
 
-- (igualNumeroElementos xss) se verifica si todas las listas de xss
-- tienen el mismo número de elementos. Por ejemplo,
--    igualNumeroElementos [[1,3],[2,2],[4,9]]    ==  True
--    igualNumeroElementos [[1,3],[2,1,2],[4,9]]  ==  False
igualNumeroElementos :: [[a]] -> Bool
igualNumeroElementos xss =
  iguales (map length xss)
 
-- (iguales xs) se verifica si todos los elementos de xs son
-- iguales. Por ejemplo,
--    iguales [3,3,3,3]  ==  True
--    iguales [3,3,7,3]  ==  False
iguales :: Eq a => [a] -> Bool
iguales []     = True
iguales (x:xs) = all (==x) xs
 
-- (tieneElementoComun xss) se verifican si todas las listas de xss
-- tienen algún elemento común. Por ejemplo,
--    tieneElementoComun [[1,2],[2,3],[4,2,7]]  ==  True
--    tieneElementoComun [[1,2],[2,3],[4,3,7]]  ==  False
tieneElementoComun :: Eq a => [[a]] -> Bool
tieneElementoComun []       = False
tieneElementoComun (xs:xss) = any (`esElementoComun` xss) xs
 
-- (esElementoComun x yss) se verifica si x pertenece a todos los
-- elementos de yss. Por ejemplo,
--    esElementoComun 2 [[1,2],[2,3],[4,2,7]]  ==  True
--    esElementoComun 2 [[1,2],[2,3],[4,3,7]]  ==  False
esElementoComun :: Eq a => a -> [[a]] -> Bool
esElementoComun x = all (x `elem`)
 
-- 2ª solución
-- ===========
 
esFamilia2 :: [Integer] -> Bool
esFamilia2 [] = True
esFamilia2 ns =
  igualNumeroElementos2 dss && tieneElementoComun2 dss
  where dss = map show ns
 
igualNumeroElementos2 :: [[a]] -> Bool
igualNumeroElementos2 xss =
  length (nub (map length xss)) == 1
 
tieneElementoComun2 :: Eq a => [[a]] -> Bool
tieneElementoComun2 xss =
  not (null (foldl1 intersect xss))
 
-- 3ª solución
-- ===========
 
esFamilia3 :: [Integer] -> Bool
esFamilia3 [] = True
esFamilia3 ns =
  igualNumeroElementos3 dss && tieneElementoComun3 dss
  where dss = map show ns
 
igualNumeroElementos3 :: [[a]] -> Bool
igualNumeroElementos3 = ((==1) . length) . nub . map length
 
tieneElementoComun3 :: Eq a => [[a]] -> Bool
tieneElementoComun3 = (not . null) . foldl1 intersect
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_esFamilia :: [Integer] -> Bool
prop_esFamilia xss =
  all (== esFamilia1 xss)
      [esFamilia2 xss,
       esFamilia3 xss]
 
-- La comprobación es
--    λ> quickCheck prop_esFamilia
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> esFamilia1 [10^6..4*10^6]
--    False
--    (1.85 secs, 1,931,162,984 bytes)
--    λ> esFamilia2 [10^6..4*10^6]
--    False
--    (2.31 secs, 2,288,177,752 bytes)
--    λ> esFamilia3 [10^6..4*10^6]
--    False
--    (2.23 secs, 2,288,177,864 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Nuevas soluciones

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

Combinaciones divisibles

Definir la función

   tieneCombinacionDivisible :: [Int] -> Int -> Bool

tal que (tieneCombinacionDivisible xs m) se verifica si existe alguna forma de combinar todos los elementos de la lista (con las operaciones suma o resta) de forma que el resultado sea divisible por m. Por ejemplo,

   tieneCombinacionDivisible [1,3,4,6] 4  ==  True
   tieneCombinacionDivisible [1,3,9]   2  ==  False

En el primer ejemplo, 1 – 2 + 3 + 4 + 6 = 12 es una combinación divisible por 4. En el segundo ejemplo, las combinaciones de [1,3,9] son

   1 + 3 + 9 =  13
  -1 + 3 + 9 =  11
   1 - 3 + 9 =   7
  -1 - 3 + 9 =   5
   1 + 3 - 9 =  -5
  -1 + 3 - 9 =  -7
   1 - 3 - 9 = -11
  -1 - 3 - 9 = -13

y ninguna de las 4 es divisible por 2.

Soluciones

import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
tieneCombinacionDivisible :: [Int] -> Int -> Bool
tieneCombinacionDivisible xs m =
  any esDivisible (valoresCombinaciones xs)
  where esDivisible x = x `mod` m == 0
 
-- (valoresCombinaciones xs) es la lista de los valores de todas las
-- combinaciones de todos los elementos de la lista con las operaciones
-- suma o resta. Por ejemplo,
--    λ> valoresCombinaciones [1,3,4,6]
--    [14,12,8,6,6,4,0,-2,2,0,-4,-6,-6,-8,-12,-14]
--    λ> valoresCombinaciones [1,3,-4,6]
--    [6,4,0,-2,14,12,8,6,-6,-8,-12,-14,2,0,-4,-6]
valoresCombinaciones :: [Int] -> [Int]
valoresCombinaciones []     = []
valoresCombinaciones [x]    = [x,-x]
valoresCombinaciones (x:xs) = concat [[y + x, y - x] | y <- ys]
  where ys = valoresCombinaciones xs
 
-- 2ª solución
-- ===========
 
tieneCombinacionDivisible2 :: [Int] -> Int -> Bool
tieneCombinacionDivisible2 xs m =
  tieneCombinacionCongruente xs m 0
 
-- (tieneCombinacionCongruente xs m a) se verifica si existe alguna
-- forma de combinar todos los elementos de la lista xs (con las
-- operaciones suma o resta) de forma que el resultado sea congruente
-- con a módulo m. Por ejemplo,
--    tieneCombinacionCongruente [1,3,4,6] 4 0  ==  True
--    tieneCombinacionCongruente [1,3,4,6] 4 1  ==  False
--    tieneCombinacionCongruente [1,3,9] 2 0    ==  False
--    tieneCombinacionCongruente [1,3,9] 2 1    ==  True
tieneCombinacionCongruente :: [Int] -> Int -> Int -> Bool
tieneCombinacionCongruente []  _  _ = False
tieneCombinacionCongruente [x] m  a = (x - a) `mod` m == 0
tieneCombinacionCongruente (x:xs) m a =
  tieneCombinacionCongruente xs m (a-x) ||
  tieneCombinacionCongruente xs m (a+x)
 
-- Equivalencia
-- ============
 
-- La propiedad es
prop_tieneCombinacionDivisible :: [Int] -> Positive Int -> Bool
prop_tieneCombinacionDivisible xs (Positive m) =
  tieneCombinacionDivisible xs m == tieneCombinacionDivisible2 xs m
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=25}) prop_tieneCombinacionDivisible
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
--    λ> (n,xs,m) = (200,[-n..n],sum [1..n]) 
--    (0.00 secs, 0 bytes)
--    λ> and [tieneCombinacionDivisible xs a | a <- [1..m]]
--    True
--    (4.74 secs, 6,536,494,976 bytes)
--    λ> and [tieneCombinacionDivisible2 xs a | a <- [1..m]]
--    True
--    (2.97 secs, 3,381,932,664 bytes)

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>

Modelos de FNC (fórmulas en forma normal conjuntiva)

Nota: En este ejercicio usaremos las mismas notaciones que en anterior importando los módulos Interpretaciones_de_FNC y Evaluacion_de_FNC

Una interpretación I es un modelo de un literal L si el valor de L en I es verdadero. Por ejemplo, la interpretación [2,5]

  • es modelo del literal x(2) (porque 2 ∈ [2,5])
  • no es modelo del literal x(3) (porque 3 ∉ [2,5])
  • es modelo del literal -x(4) (porque 4 ∉ [2,5])

Una interpretación I es un modelo de una cláusula C si el valor de C en I es verdadero. Por ejemplo, la interpretación [2,5]

  • es modelo de la cláusula (x(2) v x(3)) (porque x(2) es verdadero)
  • no es modelo de la cláusula (x(3) v x(4)) (porque x(3) y x(4) son falsos)

Una interpretación I es un modelo de una FNC F si el valor de F en I es verdadero. Por ejemplo, la interpretación [2,5]

  • es modelo de la FNC ((x(2) v x(5)) & (-x(4) v x(3)) porque lo es de sus dos cláusulas.

Definir las siguientes funciones

   esModeloLiteral  :: Interpretacion -> Literal -> Bool
   esModeloClausula :: Interpretacion -> Clausula -> Bool
   esModelo         :: Interpretacion -> FNC -> Bool
   modelosClausula  :: Clausula -> [Interpretacion]
   modelos          :: FNC -> [Interpretacion]

tales que

  • (esModeloLiteral i l) se verifica si i es modelo del literal l. Por ejemplo,
     esModeloLiteral [3,5] 3     ==  True
     esModeloLiteral [3,5] 4     ==  False
     esModeloLiteral [3,5] (-3)  ==  False
     esModeloLiteral [3,5] (-4)  ==  True
  • (esModeloClausula i c) se verifica si i es modelo de la cláusula c. Por ejemplo,
     esModeloClausula [3,5] [2,3,-5]  ==  True
     esModeloClausula [3,5] [2,4,-1]  ==  True
     esModeloClausula [3,5] [2,4,1]   ==  False
  • (esModelo i f) se verifica si i es modelo de la fórmula f. Por ejemplo,
     esModelo [1,3] [[1,-2],[3]]  ==  True
     esModelo [1]   [[1,-2],[3]]  ==  False
     esModelo [1]   []            ==  True
  • (modelosClausula c) es la lista de los modelos de la cláusula c. Por ejemplo,
     modelosClausula [-1,2]  ==  [[],[2],[1,2]]
     modelosClausula [-1,1]  ==  [[],[1]]
     modelosClausula []      ==  []
  • (modelos f) es la lista de los modelos de la fórmula f. Por ejemplo,
     modelos [[-1,2],[-2,1]]    ==  [[],[1,2]]
     modelos [[-1,2],[-2],[1]]  ==  []
     modelos [[1,-1,2]]         ==  [[],[1],[2],[1,2]]

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

Soluciones

module Modelos_de_FNC where
 
import Interpretaciones_de_FNC 
import Evaluacion_de_FNC
 
esModeloLiteral :: Interpretacion -> Literal -> Bool
esModeloLiteral i l
  | l > 0     = l `elem` i
  | otherwise = negate l `notElem` i
 
esModeloClausula :: Interpretacion -> Clausula -> Bool
esModeloClausula i = any (esModeloLiteral i)
 
esModelo :: Interpretacion -> FNC -> Bool
esModelo i = all (esModeloClausula i)
 
modelosClausula :: Clausula -> [Interpretacion]
modelosClausula c =
  [i | i <- interpretacionesClausula c,
       esModeloClausula i c]
 
modelos :: FNC -> [Interpretacion]
modelos f =
  [i | i <- interpretaciones f,
       esModelo i f]

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

“Por muy correcto que parezca un teorema matemático, nunca hay que conformarse con que no haya algo imperfecto en él hasta obtener la impresión de qie es bello.”

George Boole.

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.

Árboles cuyas ramas cumplen una propiedad

Los árboles se pueden representar mediante el siguiente tipo de dato

   data Arbol a = N a [Arbol a]
     deriving Show

Por ejemplo, los árboles

      -1           1            1
      / \         / \          /|\
     2   3      -2   3        / | \  
    / \          |          -2  7  3  
   4   5        -4          / \      
                           4   5

se representan por

   ej1, ej2, ej3 :: Arbol Int
   ej1 = N (-1) [N 2 [N 4 [], N 5 []], N 3 []]
   ej2 = N 1 [N (-2) [N (-4) []], N 3 []]
   ej3 = N 1 [N (-2) [N 4 [], N 5 []], N 7 [], N 3 []]

Definir la función

   todasDesdeAlguno :: (a -> Bool) -> Arbol a -> Bool

tal que (todasDesdeAlguno p ar) se verifica si para toda rama existe un elemento a partir del cual todos los elementos de la rama verifican la propiedad p. Por ejemplo,

   todasDesdeAlguno (>0) ej1 == True
   todasDesdeAlguno (>0) ej2 == False
   todasDesdeAlguno (>0) ej3 == True

Soluciones

import Data.List (tails)
 
data Arbol a = N a [Arbol a]
  deriving Show
 
ej1, ej2, ej3 :: Arbol Int
ej1 = N (-1) [N 2 [N 4 [], N 5 []], N 3 []]
ej2 = N 1 [N (-2) [N (-4) []], N 3 []]
ej3 = N 1 [N (-2) [N 4 [], N 5 []], N 7 [], N 3 []]
 
-- 1ª solución
-- ===========
 
todasDesdeAlguno :: (b -> Bool) -> Arbol b -> Bool
todasDesdeAlguno p a = all (desdeAlguno p) (ramas a)
 
-- (desdeAlguno p xs) se verifica si la propiedad xs tiene un elementemo
-- a partir del cual todos los siguientes cumplen la propiedad p. Por
-- ejemplo, 
--    desdeAlguno (>0) [-1,2,4]   ==  True
--    desdeAlguno (>0) [1,-2,-4]  ==  False
--    desdeAlguno (>0) [1,-2,4]   ==  True
 
-- 1ª definición de desdeAlguno
desdeAlguno1 :: (a -> Bool) -> [a] -> Bool
desdeAlguno1 p xs =
  not (null (takeWhile p (reverse xs)))
 
-- 2ª definición de desdeAlguno
desdeAlguno2 :: (a -> Bool) -> [a] -> Bool
desdeAlguno2 p xs = any (all p) (init (tails xs))
 
-- Comparación de eficiencia:
--    λ> desdeAlguno1 (>10^7) [1..1+10^7]
--    True
--    (4.36 secs, 960,101,896 bytes)
--    λ> desdeAlguno2 (>10^7) [1..1+10^7]
--    True
--    (5.62 secs, 3,600,101,424 bytes)
 
-- Usaremos la 1ª definición de desdeAlguno
desdeAlguno :: (a -> Bool) -> [a] -> Bool
desdeAlguno = desdeAlguno1
 
-- (ramas a) es la lista de las ramas de a. Por ejemplo,
--    ramas ej1  ==  [[-1,2,4],[-1,2,5],[-1,3]]
--    ramas ej2  ==  [[1,-2,-4],[1,3]]
--    ramas ej3  ==  [[1,-2,4],[1,-2,5],[1,7],[1,3]]
ramas :: Arbol a -> [[a]]
ramas (N x []) = [[x]]
ramas (N x as) = map (x:) (concatMap ramas as)
 
-- 2ª solución
-- ===========
 
todasDesdeAlguno2 :: (b -> Bool) -> Arbol b -> Bool
todasDesdeAlguno2 p (N x []) = p x
todasDesdeAlguno2 p (N _ as) = all (todasDesdeAlguno2 p) as

Pensamiento

Por dar al viento trabajo,
cosía con hilo doble
las hojas secas del árbol.

Antonio Machado

Combinaciones divisibles

Definir la función

   tieneCombinacionDivisible :: [Int] -> Int -> Bool

tal que (tieneCombinacionDivisible xs m) se verifica si existe alguna forma de combinar todos los elementos de la lista (con las operaciones suma o resta) de forma que el resultado sea divisible por m. Por ejemplo,

   tieneCombinacionDivisible [1,3,4,6] 4  ==  True
   tieneCombinacionDivisible [1,3,9]   2  ==  False

En el primer ejemplo, 1 – 2 + 3 + 4 + 6 = 12 es una combinación divisible por 4. En el segundo ejemplo, las combinaciones de [1,3,9] son

   1 + 3 + 9 =  13
  -1 + 3 + 9 =  11
   1 - 3 + 9 =   7
  -1 - 3 + 9 =   5
   1 + 3 - 9 =  -5
  -1 + 3 - 9 =  -7
   1 - 3 - 9 = -11
  -1 - 3 - 9 = -13

y ninguna de las 4 es divisible por 2.

Soluciones

import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
tieneCombinacionDivisible :: [Int] -> Int -> Bool
tieneCombinacionDivisible xs m =
  any esDivisible (valoresCombinaciones xs)
  where esDivisible x = x `mod` m == 0
 
-- (valoresCombinaciones xs) es la lista de los valores de todas las
-- combinaciones de todos los elementos de la lista con las operaciones
-- suma o resta. Por ejemplo,
--    λ> valoresCombinaciones [1,3,4,6]
--    [14,12,8,6,6,4,0,-2,2,0,-4,-6,-6,-8,-12,-14]
--    λ> valoresCombinaciones [1,3,-4,6]
--    [6,4,0,-2,14,12,8,6,-6,-8,-12,-14,2,0,-4,-6]
valoresCombinaciones :: [Int] -> [Int]
valoresCombinaciones []     = []
valoresCombinaciones [x]    = [x,-x]
valoresCombinaciones (x:xs) = concat [[y + x, y - x] | y <- ys]
  where ys = valoresCombinaciones xs
 
-- 2ª solución
-- ===========
 
tieneCombinacionDivisible2 :: [Int] -> Int -> Bool
tieneCombinacionDivisible2 xs m =
  tieneCombinacionCongruente xs m 0
 
-- (tieneCombinacionCongruente xs m a) se verifica si existe alguna
-- forma de combinar todos los elementos de la lista xs (con las
-- operaciones suma o resta) de forma que el resultado sea congruente
-- con a módulo m. Por ejemplo,
--    tieneCombinacionCongruente [1,3,4,6] 4 0  ==  True
--    tieneCombinacionCongruente [1,3,4,6] 4 1  ==  False
--    tieneCombinacionCongruente [1,3,9] 2 0    ==  False
--    tieneCombinacionCongruente [1,3,9] 2 1    ==  True
tieneCombinacionCongruente :: [Int] -> Int -> Int -> Bool
tieneCombinacionCongruente []  _  _ = False
tieneCombinacionCongruente [x] m  a = (x - a) `mod` m == 0
tieneCombinacionCongruente (x:xs) m a =
  tieneCombinacionCongruente xs m (a-x) ||
  tieneCombinacionCongruente xs m (a+x)
 
-- Equivalencia
-- ============
 
-- La propiedad es
prop_tieneCombinacionDivisible :: [Int] -> Positive Int -> Bool
prop_tieneCombinacionDivisible xs (Positive m) =
  tieneCombinacionDivisible xs m == tieneCombinacionDivisible2 xs m
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=25}) prop_tieneCombinacionDivisible
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
--    λ> (n,xs,m) = (200,[-n..n],sum [1..n]) 
--    (0.00 secs, 0 bytes)
--    λ> and [tieneCombinacionDivisible xs a | a <- [1..m]]
--    True
--    (4.74 secs, 6,536,494,976 bytes)
--    λ> and [tieneCombinacionDivisible2 xs a | a <- [1..m]]
--    True
--    (2.97 secs, 3,381,932,664 bytes)

Pensamiento

El que espera desespera,
dice la voz popular.
¡Qué verdad tan verdadera!
La verdad es lo que es,
y sigue siendo verdad
aunque se piense al revés.

Antonio Machado

Ternas euclídeas

Uno de los problemas planteados por Euclides en los Elementos consiste en encontrar tres números tales que cada uno de sus productos, dos a dos, aumentados en la unidad sea un cuadrado perfecto.

Diremos que (x,y,z) es una terna euclídea si es una solución del problema; es decir, si x <= y <= z y xy+1, yz+1 y zx+1 son cuadrados. Por ejemplo, (4,6,20) es una terna euclídea ya que

   4x6+1 = 5^2, 6x20+1 = 11^2 y 20*4+1 = 9^2

Definir la funciones

   ternasEuclideas        :: [(Integer,Integer,Integer)]
   esMayorDeTernaEuclidea :: Integer -> Bool

tales que

  • ternasEuclideas es la lista de las ternas euclídeas. Por ejemplo,
     λ> take 7 ternasEuclideas
     [(1,3,8),(2,4,12),(1,8,15),(3,5,16),(4,6,20),(3,8,21),(5,7,24)]
  • (esMayorDeTernaEuclidea z) se verifica si existen x, y tales que (x,y,z) es una terna euclídea. Por ejemplo,
     esMayorDeTernaEuclidea 20  ==  True
     esMayorDeTernaEuclidea 22  ==  False

Comprobar con QuickCheck que z es el mayor de una terna euclídea si, y sólo si, existe un número natural x tal que 1 < x < z – 1 y x^2 es congruente con 1 módulo z.

Soluciones

import Test.QuickCheck
 
ternasEuclideas :: [(Integer,Integer,Integer)]
ternasEuclideas =
  [(x,y,z) | z <- [1..]
           , y <- [1..z]
           , esCuadrado (y * z + 1)
           , x <- [1..y]
           , esCuadrado (x * y + 1)
           , esCuadrado (z * x + 1)]
 
-- (esCuadrado x) se verifica si x es un número al cuadrado. Por
-- ejemplo,
--    esCuadrado 25  ==  True
--    esCuadrado 26  ==  False
esCuadrado :: Integer -> Bool
esCuadrado x = (raizEntera x)^2 == x
  where raizEntera :: Integer -> Integer
        raizEntera = floor . sqrt . fromIntegral 
 
esMayorDeTernaEuclidea :: Integer -> Bool
esMayorDeTernaEuclidea z =
  not (null [(x,y) | y <- [1..z]
                   , esCuadrado (y * z + 1)
                   , x <- [1..y]
                   , esCuadrado (x * y + 1)
                   , esCuadrado (z * x + 1)])
 
 
-- La propiedad es
prop_esMayorDeTernaEuclidea :: Positive Integer -> Bool
prop_esMayorDeTernaEuclidea (Positive z) =
  esMayorDeTernaEuclidea z == any (\x -> (x^2) `mod` z == 1) [2..z-2]
 
-- La comprobación es
--    λ> quickCheck prop_esMayorDeTernaEuclidea
--    +++ OK, passed 100 tests.

Pensamiento

Todo pasa y todo queda,
pero lo nuestro es pasar,
pasar haciendo caminos,
caminos sobre la mar.

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

Paridad del número de divisores

Definir la función

   nDivisoresPar :: Integer -> Bool

tal que (nDivisoresPar n) se verifica si n tiene un número par de divisores. Por ejemplo,

   nDivisoresPar 12                     ==  True
   nDivisoresPar 16                     ==  False
   nDivisoresPar (product [1..2*10^4])  ==  True

Soluciones

import Data.List (group)
import Data.Numbers.Primes (primeFactors)
 
-- 1ª definición
-- =============
 
nDivisoresPar1 :: Integer -> Bool
nDivisoresPar1 = even . length . divisores
 
-- (divisores n) es la lista de los divisores de n. Por ejemplo,
--    divisores 12  ==  [1,2,3,4,6,12]
--    divisores 16  ==  [1,2,4,8,16]
divisores :: Integer -> [Integer]
divisores n =
    [x | x <- [1..n], n `mod` x == 0]
 
-- 2ª definición
-- =============
 
nDivisoresPar2 :: Integer -> Bool
nDivisoresPar2 n =
    any odd (map length (group (primeFactors n)))
 
-- Comparación de eficiencia
-- =========================
 
--    λ> nDivisoresPar1 (10^7)
--    True
--    (14.18 secs, 2,078,736,992 bytes)
--    λ> nDivisoresPar2 (10^7)
--    True
--    (0.01 secs, 0 bytes)
--
--    λ> nDivisoresPar2 (product [1..2*10^4])
--    True
--    (2.30 secs, 1,003,013,112 bytes)

Solución en Maxima

/* concat(xs) es la lista obtenida concatenado los elementos de xss. Por
   ejemplo,
      concat([[1,3],[2,4],[5,7]])  ==  [1, 3, 2, 4, 5, 7]             */
concat (xs) := block ([r:[]],
  for x in reverse (xs) do r : append (x,r),
  r)$
 
nDivisoresPares (n) := block(
  [xs : concat (map (rest, ifactors (n))), p : false],
  for x in xs do p: oddp (x) or p,
  p)$

Cuantificadores sobre listas

Enunciado

-- Definir la función 
--    verificaP :: (a -> Bool) -> [[a]] -> Bool
-- tal que (verificaP p xs) se verifica si cada elemento de la lista xss
-- contiene algún elemento que cumple el predicado p. Por ejemplo,
--    verificaP odd [[1,3,4,2], [4,5], [9]] == True
--    verificaP odd [[1,3,4,2], [4,8], [9]] == False

Soluciones

-- 1ª definición (por comprensión):
verificaP :: (a -> Bool) -> [[a]] -> Bool
verificaP p xss = and [any p xs | xs <- xss]
 
-- 2ª definición (por recursión):
verificaP2 :: (a -> Bool) -> [[a]] -> Bool
verificaP2 p []       = True
verificaP2 p (xs:xss) = any p xs && verificaP2 p xss
 
-- 3ª definición (por plegado):
verificaP3 :: (a -> Bool) -> [[a]] -> Bool
verificaP3 p = foldr ((&&) . any p) True
 
-- 4ª definición (con cuantificadores)
verificaP4 :: (a -> Bool) -> [[a]] -> Bool
verificaP4 p = all (any p)
 
-- 5ª definición (con cuantificadores y composición)
verificaP5 :: (a -> Bool) -> [[a]] -> Bool
verificaP5 = all . any