Menu Close

Etiqueta: and

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

José A. Alonso, ,

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.

Leer más →

Menor divisible por todos

José A. Alonso, ,

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

Leer más →

Conjetura de las familias estables por uniones

José A. Alonso, ,

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]))

Pensamiento

Pero tampoco es razón
desdeñar
consejo que es confesión.

Antonio Machado

Leer más →

Números altamente compuestos

José A. Alonso, ,

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

Leer más →

Reconocimiento de conmutatividad

José A. Alonso, ,

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

Leer más →