Tipos de datos algebraicos

Evaluación de expresiones aritméticas

PorJosé A. Alonso 29-marzo-201626-marzo-2022

Las expresiones aritméticas se pueden definir mediante el siguiente tipo de dato

   data Expr  = N Int | V Char | Sum Expr Expr | Mul Expr Expr 
                deriving Show

1 2	data Expr = N Int \| V Char \| Sum Expr Expr \| Mul Expr Expr deriving Show

Por ejemplo, (x+3)+(7*y) se representa por

   ejExpr :: Expr
   ejExpr = Sum (Sum (V 'x') (N 3))(Mul (N 7) (V 'y'))

1 2	ejExpr :: Expr ejExpr = Sum (Sum (V 'x') (N 3))(Mul (N 7) (V 'y'))

Definir la función

   valor :: Expr -> Maybe Int

1	valor :: Expr -> Maybe Int

tal que (valor e) es ‘Just v’ si la expresión e es numérica y v es su valor, o bien ‘Nothing’ si e no es numérica. Por ejemplo:

   valor (Sum (N 7) (N 9))                            == Just 16
   valor (Sum (Sum (V 'x') (N 3))(Mul (N 7) (V 'y'))) == Nothing
   valor (Sum (Sum (N 1) (N 3))(Mul (N 7) (N 2)))     == Just 18

valor (Sum (N 7) (N 9)) == Just 16

valor (Sum (Sum (V 'x') (N 3))(Mul (N 7) (V 'y'))) == Nothing

valor (Sum (Sum (N 1) (N 3))(Mul (N 7) (N 2))) == Just 18

Soluciones

data Expr  = N Int | V Char | Sum Expr Expr | Mul Expr Expr 
             deriving Show

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

valor1 :: Expr -> Maybe Int
valor1 e | null (aux e) = Nothing
         | otherwise    = Just (head (aux e))
    where aux (N x)       = [x]
          aux (V _)       = []
          aux (Sum e1 e2) = [x+y| x <- aux e1, y <- aux e2]
          aux (Mul e1 e2) = [x*y| x <- aux e1, y <- aux e2]

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

valor2 :: Expr -> Maybe Int
valor2 e | numerico e = Just (aux e)
         | otherwise  = Nothing
    where aux (N x)       = x
          aux (Sum e1 e2) = aux e1 + aux e2
          aux (Mul e1 e2) = aux e1 * aux e2

numerico :: Expr -> Bool
numerico (N _)       = True
numerico (V _)       = False
numerico (Sum e1 e2) = numerico e1 && numerico e2
numerico (Mul e1 e2) = numerico e1 && numerico e2

data Expr = N Int | V Char | Sum Expr Expr | Mul Expr Expr

deriving Show

-- 1ª solución

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

valor1 :: Expr -> Maybe Int

valor1 e | null (aux e) = Nothing

| otherwise = Just (head (aux e))

where aux (N x) = [x]

aux (V _) = []

aux (Sum e1 e2) = [x+y| x <- aux e1, y <- aux e2]

aux (Mul e1 e2) = [x*y| x <- aux e1, y <- aux e2]

-- 2ª solución

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

valor2 :: Expr -> Maybe Int

valor2 e | numerico e = Just (aux e)

| otherwise = Nothing

where aux (N x) = x

aux (Sum e1 e2) = aux e1 + aux e2

aux (Mul e1 e2) = aux e1 * aux e2

numerico :: Expr -> Bool

numerico (N _) = True

numerico (V _) = False

numerico (Sum e1 e2) = numerico e1 && numerico e2

numerico (Mul e1 e2) = numerico e1 && numerico e2

Lista tautológica de literales

PorJosé A. Alonso 14-enero-201621-enero-2016

En lógica matemática, un literal http://bit.ly/1RQ5yJU es una fórmula atómica o su negación. Se puede definir por el tipo de dato

   data Literal = Atom String
                | Neg Literal
                deriving (Eq, Show)

data Literal = Atom String

| Neg Literal

deriving (Eq, Show)

Por ejemplo, el literal los literales p y ¬q se representan por las expresiones (Atom «p») y (Neg (Atom «q»)), respectivamente.

Una lista de literales (que se interpreta como su disyunción) es un tautología si contiene a una fórmula atómica y su negación.

Definir la función

   tautologia :: [Literal] -> Bool

1	tautologia :: [Literal] -> Bool

tal que (tautologia xs) se verifica si la lista de literales xs es una tautología. Por ejemplo,

   λ> tautologia [Atom "p", Neg (Atom "q"), Neg (Atom "p")]
   True
   λ> tautologia [Atom "p", Neg (Atom "q"), Neg (Atom "r")]
   False
   λ> tautologia [Atom "p", Neg (Atom "q"), Neg (Atom "q")]
   False

λ> tautologia [Atom "p", Neg (Atom "q"), Neg (Atom "p")]

True

λ> tautologia [Atom "p", Neg (Atom "q"), Neg (Atom "r")]

False

λ> tautologia [Atom "p", Neg (Atom "q"), Neg (Atom "q")]

False

Soluciones

[schedule expon=’2016-01-21′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 21 de enero.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2016-01-21′ at=»06:00″]

import Data.List (intersect)

data Literal = Atom String
             | Neg Literal
             deriving (Eq, Show)

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

tautologia1 :: [Literal] -> Bool
tautologia1 xs = or [elem x xs && elem (Neg x) xs | x <- xs]

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

tautologia2 :: [Literal] -> Bool
tautologia2 xs = 
    not (null (intersect ns (map neg ps)))
    where (ps,ns) = span esPositivo xs
          neg x   = Neg x

esPositivo :: Literal -> Bool
esPositivo (Atom _) = True
esPositivo _        = False

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

--    λ> tautologia1 (replicate 4000 (Atom "p"))
--    False
--    (6.70 secs, 1031428 bytes)
--    λ> tautologia2 (replicate 4000 (Atom "p"))
--    False
--    (0.01 secs, 1061604 bytes)

import Data.List (intersect)

data Literal = Atom String

| Neg Literal

deriving (Eq, Show)

-- 1ª solución

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

tautologia1 :: [Literal] -> Bool

tautologia1 xs = or [elem x xs && elem (Neg x) xs | x <- xs]

-- 2ª solución

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

tautologia2 :: [Literal] -> Bool

tautologia2 xs =

not (null (intersect ns (map neg ps)))

where (ps,ns) = span esPositivo xs

neg x = Neg x

esPositivo :: Literal -> Bool

esPositivo (Atom _) = True

esPositivo _ = False

-- Comparación de eficiencia

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

-- λ> tautologia1 (replicate 4000 (Atom "p"))

-- False

-- (6.70 secs, 1031428 bytes)

-- λ> tautologia2 (replicate 4000 (Atom "p"))

-- False

-- (0.01 secs, 1061604 bytes)

[/schedule]

Fórmula dual

PorJosé A. Alonso 7-enero-201615-enero-2016

Las fórmulas proposicionales construidas con las constantes verdadero (⊤), falso (⊥), las variables proposicionales y las conectivas de negación (¬), conjunción (∧) y disyunción (∨) se pueden definir usando el siguiente tipo de datos

   data Prop = Const Bool
             | Var Char
             | Neg Prop
             | Conj Prop Prop
             | Disj Prop Prop
             deriving (Eq, Show)

data Prop = Const Bool

| Var Char

| Neg Prop

| Conj Prop Prop

| Disj Prop Prop

deriving (Eq, Show)

Por ejemplo, la fórmula (A ∧ ⊥) ∨ (⊤ ∧ B) se representa por

   Disj (Conj (Var 'A') (Const False)) (Conj (Const True) (Var 'B'))

1	Disj (Conj (Var 'A') (Const False)) (Conj (Const True) (Var 'B'))

La fórmula dual de una fórmula p es la fórmula obtenida intercambiando en p las ∧ por ∨ y también las ⊤ por ⊥. Por ejemplo, la dual de (A ∧ ⊥) ∨ (⊤ ∧ B) es (A ∨ ⊤) ∧ (⊥ ∨ B)

Definir la función

   dual :: Prop -> Prop

1	dual :: Prop -> Prop

tal que (dual p) es la dual de p. Por ejemplo,

   λ> dual (Disj (Conj (Var 'A') (Const False)) (Conj (Const True) (Var 'B')))
   Conj (Disj (Var 'A') (Const True)) (Disj (Const False) (Var 'B'))

1 2	λ> dual (Disj (Conj (Var 'A') (Const False)) (Conj (Const True) (Var 'B'))) Conj (Disj (Var 'A') (Const True)) (Disj (Const False) (Var 'B'))

Soluciones

data Prop = Const Bool
          | Var Char
          | Neg Prop
          | Conj Prop Prop
          | Disj Prop Prop
          deriving (Eq, Show)

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

dual1 :: Prop -> Prop
dual1 (Const True)  = Const False
dual1 (Const False) = Const True
dual1 (Var x)       = Var x
dual1 (Neg p)       = Neg  (dual1 p)
dual1 (Conj p q)    = Disj (dual1 p) (dual1 q) 
dual1 (Disj p q)    = Conj (dual1 p) (dual1 q) 

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

dual2 :: Prop -> Prop
dual2 (Const b)  = Const (not b)
dual2 (Conj p q) = Disj (dual2 p) (dual2 q)
dual2 (Disj p q) = Conj (dual2 p) (dual2 q)
dual2 p          = p

data Prop = Const Bool

| Var Char

| Neg Prop

| Conj Prop Prop

| Disj Prop Prop

deriving (Eq, Show)

-- 1ª solución

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

dual1 :: Prop -> Prop

dual1 (Const True) = Const False

dual1 (Const False) = Const True

dual1 (Var x) = Var x

dual1 (Neg p) = Neg (dual1 p)

dual1 (Conj p q) = Disj (dual1 p) (dual1 q)

dual1 (Disj p q) = Conj (dual1 p) (dual1 q)

-- 2ª solución

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

dual2 :: Prop -> Prop

dual2 (Const b) = Const (not b)

dual2 (Conj p q) = Disj (dual2 p) (dual2 q)

dual2 (Disj p q) = Conj (dual2 p) (dual2 q)

dual2 p = p

Caminos en un árbol binario

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

Los caminos en los árboles binarios

       .          .
      / \        / \
     .   .      /   \
    / \        .     .
   .   .      / \   / \
             .   . .   .

. .

/ \ / \

. . / \

/ \ . .

. . / \ / \

. . . .

son [[I,I],[I,D],[D]] y [[I,I],[I,D],[D,I],[D,D]], donde I indica un movimiento hacia la izquierda y D uno hacia la derecha.

Los árboles binarios se pueden representar por

   data Arbol = H | N Arbol Arbol

1	data Arbol = H \| N Arbol Arbol

los movimientos por

   data Mov    = I | D deriving Show

1	data Mov = I \| D deriving Show

y los caminos por

   type Camino = [Mov]

1	type Camino = [Mov]

Definir la función

   caminos :: Arbol -> [Camino]

1	caminos :: Arbol -> [Camino]

tal que (caminos a) es la lista de los caminos en el árbol binario a. Por ejemplo,

   caminos (N (N H H) H)             == [[I,I],[I,D],[D]]
   caminos (N (N H H) (N H H))       == [[I,I],[I,D],[D,I],[D,D]]
   caminos (N H (N (N H H) (N H H))) == [[I],[D,I,I],[D,I,D],[D,D,I],[D,D,D]]

caminos (N (N H H) H) == [[I,I],[I,D],[D]]

caminos (N (N H H) (N H H)) == [[I,I],[I,D],[D,I],[D,D]]

caminos (N H (N (N H H) (N H H))) == [[I],[D,I,I],[D,I,D],[D,D,I],[D,D,D]]

Soluciones

data Arbol  = H | N Arbol Arbol
data Mov    = I | D deriving Show
type Camino = [Mov]

caminos :: Arbol -> [Camino]
caminos H       = [[]]
caminos (N i d) = [I:xs | xs <- caminos i] ++ [D:xs | xs <- caminos d]

data Arbol = H | N Arbol Arbol

data Mov = I | D deriving Show

type Camino = [Mov]

caminos :: Arbol -> [Camino]

caminos H = [[]]

caminos (N i d) = [I:xs | xs <- caminos i] ++ [D:xs | xs <- caminos d]

Conjuntos de puntos enteros en regiones rectangulares

PorJosé A. Alonso 14-enero-201526-abril-2015

Los puntos de una cuadrícula se puede representar mediante pares de números enteros

   type Punto = (Int,Int)

1	type Punto = (Int,Int)

y las regiones rectangulares mediante el siguiente tipo de dato

   data Region = Rectangulo Punto  Punto 
               | Union      Region Region
               | Diferencia Region Region
               deriving (Eq, Show)

data Region = Rectangulo Punto Punto

| Union Region Region

| Diferencia Region Region

deriving (Eq, Show)

donde

(Rectangulo p1 p2) es la región formada por un rectángulo cuyo vértice superior izquierdo es p1 y su vértice inferior derecho es p2.
(Union r1 r2) es la región cuyos puntos pertenecen a alguna de las regiones r1 y r2.
(Diferencia r1 r2) es la región cuyos puntos pertenecen a la región r1 pero no pertenecen a la r2.

Definir la función

   puntos :: Region -> [Punto]

1	puntos :: Region -> [Punto]

tal que (puntos r) es la lista de puntos de la región r. Por ejemplo, usando las regiones definidas por

   r0021, r3051, r4162 :: Region
   r0021 = Rectangulo (0,0) (2,1)
   r3051 = Rectangulo (3,0) (5,1)
   r4162 = Rectangulo (4,1) (6,2)

r0021, r3051, r4162 :: Region

r0021 = Rectangulo (0,0) (2,1)

r3051 = Rectangulo (3,0) (5,1)

r4162 = Rectangulo (4,1) (6,2)

se tiene

   ghci> puntos r0021
   [(0,0),(0,1),(1,0),(1,1),(2,0),(2,1)]
   ghci> puntos r3051
   [(3,0),(3,1),(4,0),(4,1),(5,0),(5,1)]
   ghci> puntos r4162
   [(4,1),(4,2),(5,1),(5,2),(6,1),(6,2)]
   ghci> puntos (Union r0021 r3051)
   [(0,0),(0,1),(1,0),(1,1),(2,0),(2,1),(3,0),(3,1),(4,0),(4,1),(5,0),(5,1)]
   ghci> puntos (Diferencia r3051 r4162)
   [(3,0),(3,1),(4,0),(5,0)]
   ghci> puntos (Union (Diferencia r3051 r4162) r4162)
   [(3,0),(3,1),(4,0),(5,0),(4,1),(4,2),(5,1),(5,2),(6,1),(6,2)]

ghci> puntos r0021

[(0,0),(0,1),(1,0),(1,1),(2,0),(2,1)]

ghci> puntos r3051

[(3,0),(3,1),(4,0),(4,1),(5,0),(5,1)]

ghci> puntos r4162

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

ghci> puntos (Union r0021 r3051)

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

ghci> puntos (Diferencia r3051 r4162)

[(3,0),(3,1),(4,0),(5,0)]

ghci> puntos (Union (Diferencia r3051 r4162) r4162)

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

Comprobar con QuickCheck, usando la función enRegion definida en el ejercicio [Puntos en regiones rectangulares](Puntos en regiones rectangulares) que (enRegion p r) es equivalente a (p elem puntos r).

Nota: Escribir las soluciones usando la siguiente plantilla que contiene un generador de regiones

import Test.QuickCheck
import Control.Monad

type Punto = (Int,Int)

data Region = Rectangulo Punto  Punto
            | Union      Region Region
            | Diferencia Region Region
            deriving (Eq, Show)

r0021, r3051, r4162 :: Region
r0021 = Rectangulo (0,0) (2,1)
r3051 = Rectangulo (3,0) (5,1)
r4162 = Rectangulo (4,1) (6,2)

puntos :: Region -> [Punto]
puntos = undefined

-- La propiedad es
prop_puntos :: Punto -> Region -> Bool
prop_puntos p r = undefined

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

enRegion :: Punto -> Region -> Bool
enRegion (x,y) (Rectangulo (x1,y1) (x2,y2)) =
    x1 <= x && x <= x2 && y1 <= y && y <= y2
enRegion p (Union r1 r2)      = enRegion p r1 || enRegion p r2
enRegion p (Diferencia r1 r2) = enRegion p r1 && not (enRegion p r2)

-- Generador de regiones:
instance Arbitrary Region where
    arbitrary = sized arb where
        arb 0         = liftM2 Rectangulo arbitrary arbitrary
        arb n | n > 0 = oneof [liftM2 Rectangulo arbitrary arbitrary,
                               liftM2 Union sub sub, 
                               liftM2 Diferencia sub sub] 
              where sub = arb (n `div` 2)

import Test.QuickCheck

import Control.Monad

type Punto = (Int,Int)

data Region = Rectangulo Punto Punto

| Union Region Region

| Diferencia Region Region

deriving (Eq, Show)

r0021, r3051, r4162 :: Region

r0021 = Rectangulo (0,0) (2,1)

r3051 = Rectangulo (3,0) (5,1)

r4162 = Rectangulo (4,1) (6,2)

puntos :: Region -> [Punto]

puntos = undefined

-- La propiedad es

prop_puntos :: Punto -> Region -> Bool

prop_puntos p r = undefined

-- La comprobación es

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

-- +++ OK, passed 100 tests.

enRegion :: Punto -> Region -> Bool

enRegion (x,y) (Rectangulo (x1,y1) (x2,y2)) =

x1 <= x && x <= x2 && y1 <= y && y <= y2

enRegion p (Union r1 r2) = enRegion p r1 || enRegion p r2

enRegion p (Diferencia r1 r2) = enRegion p r1 && not (enRegion p r2)

-- Generador de regiones:

instance Arbitrary Region where

arbitrary = sized arb where

arb 0 = liftM2 Rectangulo arbitrary arbitrary

arb n | n > 0 = oneof [liftM2 Rectangulo arbitrary arbitrary,

liftM2 Union sub sub,

liftM2 Diferencia sub sub]

where sub = arb (n `div` 2)

Soluciones

import Data.List 
import Test.QuickCheck
import Control.Monad

type Punto = (Int,Int)

data Region = Rectangulo Punto  Punto
            | Union      Region Region
            | Diferencia Region Region
            deriving (Eq, Show)

r0021, r3051, r4162 :: Region
r0021 = Rectangulo (0,0) (2,1)
r3051 = Rectangulo (3,0) (5,1)
r4162 = Rectangulo (4,1) (6,2)

puntos :: Region -> [Punto]
puntos (Rectangulo (x1,y1) (x2,y2)) = 
    [(x,y) | x <- [x1..x2], y <- [y1..y2]]
puntos (Union r1 r2)      = puntos r1 `union` puntos r2
puntos (Diferencia r1 r2) = puntos r1 \\ puntos r2

-- La propiedad es
prop_puntos :: Punto -> Region -> Bool
prop_puntos p r =
    enRegion p r == (p `elem` puntos r)

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

enRegion :: Punto -> Region -> Bool
enRegion (x,y) (Rectangulo (x1,y1) (x2,y2)) =
    x1 <= x && x <= x2 && y1 <= y && y <= y2
enRegion p (Union r1 r2)      = enRegion p r1 || enRegion p r2
enRegion p (Diferencia r1 r2) = enRegion p r1 && not (enRegion p r2)

-- Generador de regiones:
instance Arbitrary Region where
    arbitrary = sized arb where
        arb 0         = liftM2 Rectangulo arbitrary arbitrary
        arb n | n > 0 = oneof [liftM2 Rectangulo arbitrary arbitrary,
                               liftM2 Union sub sub, 
                               liftM2 Diferencia sub sub] 
              where sub = arb (n `div` 2)

import Data.List

import Test.QuickCheck

import Control.Monad

type Punto = (Int,Int)

data Region = Rectangulo Punto Punto

| Union Region Region

| Diferencia Region Region

deriving (Eq, Show)

r0021, r3051, r4162 :: Region

r0021 = Rectangulo (0,0) (2,1)

r3051 = Rectangulo (3,0) (5,1)

r4162 = Rectangulo (4,1) (6,2)

puntos :: Region -> [Punto]

puntos (Rectangulo (x1,y1) (x2,y2)) =

[(x,y) | x <- [x1..x2], y <- [y1..y2]]

puntos (Union r1 r2) = puntos r1 `union` puntos r2

puntos (Diferencia r1 r2) = puntos r1 \\ puntos r2

-- La propiedad es

prop_puntos :: Punto -> Region -> Bool

prop_puntos p r =

enRegion p r == (p `elem` puntos r)

-- La comprobación es

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

-- +++ OK, passed 100 tests.

enRegion :: Punto -> Region -> Bool

enRegion (x,y) (Rectangulo (x1,y1) (x2,y2)) =

x1 <= x && x <= x2 && y1 <= y && y <= y2

enRegion p (Union r1 r2) = enRegion p r1 || enRegion p r2

enRegion p (Diferencia r1 r2) = enRegion p r1 && not (enRegion p r2)

-- Generador de regiones:

instance Arbitrary Region where

arbitrary = sized arb where

arb 0 = liftM2 Rectangulo arbitrary arbitrary

arb n | n > 0 = oneof [liftM2 Rectangulo arbitrary arbitrary,

liftM2 Union sub sub,

liftM2 Diferencia sub sub]

where sub = arb (n `div` 2)

Evaluación de expresiones aritméticas

Soluciones

Lista tautológica de literales

Soluciones

Fórmula dual

Soluciones

Caminos en un árbol binario

Soluciones

Conjuntos de puntos enteros en regiones rectangulares

Soluciones

Entradas recientes

Buscar

Correo electrónico