Test.QuickCheck – Página 5

Separación y mezcla de listas

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

Definir las funciones

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

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

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

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

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

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

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

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

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

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

Comprobar con QuickCheck que

   mezcla (separacion xs) == xs

1	mezcla (separacion xs) == xs

Soluciones

import Test.QuickCheck

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

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

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

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

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

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

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

import Test.QuickCheck

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

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

separacion1 [] = ([], [])

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

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

where (us,vs) = separacion1 zs

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

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

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

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

where aux = zip xs [0..]

-- 3ª definición

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

separacion3 [] = ([],[])

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

where (ys, zs) = separacion3 xs

-- Comprobación de eficiencia

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

-- 10000000

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

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

-- 10000000

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

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

-- 10000000

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

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

mezcla ([],ys) = ys

mezcla (xs,[]) = xs

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

-- La propiedad es

prop_mezcla_separacion :: [Int] -> Bool

prop_mezcla_separacion xs =

mezcla (separacion xs) == xs

-- La comprobación es

-- ghci> quickCheck prop_mezcla_separacion

-- +++ OK, passed 100 tests.

Repeticiones según la posición

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

Definir la función

   transformada :: [a] -> [a]

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

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

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

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

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

Soluciones

import Test.QuickCheck

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

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

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

import Test.QuickCheck

transformada :: [a] -> [a]

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

-- La propiedad es

prop_transformada :: [Int] -> Property

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

where n = length xs

-- La comprobación es

-- ghci> quickCheck prop_transformada

-- +++ OK, passed 100 tests.

Polinomio cromático de un grafo

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

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

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

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

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

Por ejemplo,

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

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

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

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

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

Definir la función

   polGC:: Int -> Polinomio Int

1	polGC:: Int -> Polinomio Int

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

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

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

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

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

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

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

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

Soluciones

import I1M.PolOperaciones
import Test.QuickCheck

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

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

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

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

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

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

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

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

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

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

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

import I1M.PolOperaciones

import Test.QuickCheck

-- 1ª solución

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

polGC :: Int -> Polinomio Int

polGC 0 = consPol 0 1 polCero

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

-- 2ª solución

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

polGC2 :: Int -> Polinomio Int

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

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

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

polMon:: Int -> Polinomio Int

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

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

multLista :: [Polinomio Int] -> Polinomio Int

multLista [] = polUnidad

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

-- 3ª solución (por plegado)

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

polGC3 :: Int -> Polinomio Int

polGC3 n = foldl multPol polUnidad

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

-- Comprobación

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

-- La propiedad es

prop_polGC :: Int -> Property

prop_polGC n =

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

-- La comprobación es

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

-- +++ OK, passed 100 tests.

-- (0.04 secs, 7785800 bytes)

Números cuyas cifras coinciden con las de sus factores primos

PorJosé A. Alonso 4-mayo-201525-marzo-2022

Un número n es especial si al unir las cifras de sus factores primos, se obtienen exactamente las cifras de n, aunque puede ser en otro orden. Por ejemplo, 1255 es especial, pues los factores primos de 1255 son 5 y 251.

Definir la función

   esEspecial :: Integer -> Bool

1	esEspecial :: Integer -> Bool

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

   esEspecial 1255 == True
   esEspecial 125  == False

1 2	esEspecial 1255 == True esEspecial 125 == False

Comprobar con QuickCheck que todo número primo es especial.

Calcular los 5 primeros números especiales que no son primos.

Soluciones

import Data.List (nub, sort)
import Data.Numbers.Primes (isPrime, primeFactors)
import Test.QuickCheck

esEspecial :: Integer -> Bool
esEspecial n = 
    sort (show n) == sort (concatMap show (nub (primeFactors n)))

-- La propiedad es
prop_primos:: Integer -> Property
prop_primos n = 
    isPrime (abs n) ==> esEspecial (abs n)

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

-- El cálculo es
--    ghci> take 5 [n | n <- [2..], esEspecial n, not (isPrime n)]
--    [735,1255,3792,7236,11913]

import Data.List (nub, sort)

import Data.Numbers.Primes (isPrime, primeFactors)

import Test.QuickCheck

esEspecial :: Integer -> Bool

esEspecial n =

sort (show n) == sort (concatMap show (nub (primeFactors n)))

-- La propiedad es

prop_primos:: Integer -> Property

prop_primos n =

isPrime (abs n) ==> esEspecial (abs n)

-- La comprobación es

-- ghci> quickCheck prop_primos

-- +++ OK, passed 100 tests.

-- El cálculo es

-- ghci> take 5 [n | n <- [2..], esEspecial n, not (isPrime n)]

-- [735,1255,3792,7236,11913]

Agrupamiento de consecutivos iguales

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

Definir las funciones

   agrupa  :: Eq a => [a] -> [(a,Int)]
   expande :: [(a,Int)] -> [a]

1 2	agrupa :: Eq a => [a] -> [(a,Int)] expande :: [(a,Int)] -> [a]

tales que

(agrupa xs) es la lista obtenida agrupando las ocurrencias consecutivas de elementos de xs junto con el número de dichas ocurrencias. Por ejemplo:

     agrupa "aaabzzaa" == [('a',3),('b',1),('z',2),('a',2)]

1	agrupa "aaabzzaa" == [('a',3),('b',1),('z',2),('a',2)]

(expande xs) es la lista expandida correspondiente a ps (es decir, es la lista xs tal que la comprimida de xs es ps. Por ejemplo,

     expande [('a',2),('b',3),('a',1)] == "aabbba"

1	expande [('a',2),('b',3),('a',1)] == "aabbba"

Comprobar con QuickCheck que dada una lista de enteros, si se la agrupa y después se expande se obtiene la lista inicial.

Soluciones

import Data.List (group)
import Test.QuickCheck

-- Definiciones de agrupa
-- ======================

-- 1ª definición (por recursión)
agrupa :: Eq a => [a] -> [(a,Int)]
agrupa xs = aux xs 1
    where aux (x:y:zs) n | x == y    = aux (y:zs) (n+1)
                         | otherwise = (x,n) : aux (y:zs) 1
          aux [x]      n             = [(x,n)]
          aux []       _             = []

-- 2ª definición (por recursión usando takeWhile):
agrupa2 :: Eq a => [a] -> [(a,Int)]
agrupa2 [] = []
agrupa2 (x:xs) = 
    (x,1 + length (takeWhile (==x) xs)) : agrupa2 (dropWhile (==x) xs)

-- 3ª definición (por comprensión usando group):
agrupa3 :: Eq a => [a] -> [(a,Int)]
agrupa3 xs = [(head ys,length ys) | ys <- group xs]

-- 4ª definición (usando map y group):
agrupa4 :: Eq a => [a] -> [(a,Int)]
agrupa4 = map (\xs -> (head xs, length xs)) . group

-- Definiciones de expande
-- =======================

-- 1ª definición (por comprensión)
expande :: [(a,Int)] -> [a]
expande ps = concat [replicate k x | (x,k) <- ps]

-- 2ª definición (por concatMap)
expande2 :: [(a,Int)] -> [a]
expande2 = concatMap (\(x,k) -> replicate k x) 

-- 3ª definición (por recursión)
expande3 :: [(a,Int)] -> [a]
expande3 [] = []
expande3 ((x,n):ps) = replicate n x ++ expande3 ps

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

-- La propiedad es
prop_expande_agrupa :: [Int] -> Bool 
prop_expande_agrupa xs = expande (agrupa xs) == xs

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

import Data.List (group)

import Test.QuickCheck

-- Definiciones de agrupa

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

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

agrupa :: Eq a => [a] -> [(a,Int)]

agrupa xs = aux xs 1

where aux (x:y:zs) n | x == y = aux (y:zs) (n+1)

| otherwise = (x,n) : aux (y:zs) 1

aux [x] n = [(x,n)]

aux [] _ = []

-- 2ª definición (por recursión usando takeWhile):

agrupa2 :: Eq a => [a] -> [(a,Int)]

agrupa2 [] = []

agrupa2 (x:xs) =

(x,1 + length (takeWhile (==x) xs)) : agrupa2 (dropWhile (==x) xs)

-- 3ª definición (por comprensión usando group):

agrupa3 :: Eq a => [a] -> [(a,Int)]

agrupa3 xs = [(head ys,length ys) | ys <- group xs]

-- 4ª definición (usando map y group):

agrupa4 :: Eq a => [a] -> [(a,Int)]

agrupa4 = map (\xs -> (head xs, length xs)) . group

-- Definiciones de expande

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

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

expande :: [(a,Int)] -> [a]

expande ps = concat [replicate k x | (x,k) <- ps]

-- 2ª definición (por concatMap)

expande2 :: [(a,Int)] -> [a]

expande2 = concatMap (\(x,k) -> replicate k x)

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

expande3 :: [(a,Int)] -> [a]

expande3 [] = []

expande3 ((x,n):ps) = replicate n x ++ expande3 ps

-- Comprobación

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

-- La propiedad es

prop_expande_agrupa :: [Int] -> Bool

prop_expande_agrupa xs = expande (agrupa xs) == xs

-- La comprobación es

-- ghci> quickCheck prop_expande_agrupa

-- +++ OK, passed 100 tests.

División según una propiedad

PorJosé A. Alonso 28-enero-20154-febrero-2015

Enunciado

Definir la función

   divideSegun :: (a -> Bool) -> [a] -> [[a]]

1	divideSegun :: (a -> Bool) -> [a] -> [[a]]

tal que (divideSegun p xs) es la lista de los segmentos de xs cuyos elementos no cumplen la propiedad p. Por ejemplo,

   divideSegun even [3,5,2,7,6,8,9,1]  ==  [[3,5],[7],[9,1]]
   divideSegun odd  [3,5,2,7,6,8,9,1]  ==  [[2],[6,8]]

1 2	divideSegun even [3,5,2,7,6,8,9,1] == [[3,5],[7],[9,1]] divideSegun odd [3,5,2,7,6,8,9,1] == [[2],[6,8]]

Comprobar con QuickCheck que, para cualquier lista xs de números enteros, la concatenación de los elementos de (divideSegun even xs) es la lista de los elementos de xs que no son pares.

Soluciones

import Test.QuickCheck

divideSegun :: (a -> Bool) -> [a] -> [[a]]
divideSegun p xs 
    | null ys   = []
    | otherwise = ys : divideSegun p zs
    where (ys,zs) = break p (dropWhile p xs)

-- La propiedad es
prop_divideSegun :: [Int] -> Bool
prop_divideSegun xs =
    concat (divideSegun even xs) == filter (not . even) xs

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

import Test.QuickCheck

divideSegun :: (a -> Bool) -> [a] -> [[a]]

divideSegun p xs

| null ys = []

| otherwise = ys : divideSegun p zs

where (ys,zs) = break p (dropWhile p xs)

-- La propiedad es

prop_divideSegun :: [Int] -> Bool

prop_divideSegun xs =

concat (divideSegun even xs) == filter (not . even) xs

-- La comprobación es

-- ghci> quickCheck prop_divideSegun

-- +++ OK, passed 100 tests.

Números naturales separados por ceros

PorJosé A. Alonso 26-enero-201525-marzo-2022

Enunciado

Definir la sucesión

   naturales0 :: [Int]

1	naturales0 :: [Int]

cuyos elementos son los números naturales separados por 0. Por ejemplo,

   ghci> take 25 naturales0
   [0,0,1,0,2,0,3,0,4,0,5,0,6,0,7,0,8,0,9,0,10,0,11,0,12]

1 2	ghci> take 25 naturales0 [0,0,1,0,2,0,3,0,4,0,5,0,6,0,7,0,8,0,9,0,10,0,11,0,12]

Comprobar con QuickCheck que el n-ésimo término de la sucesión es n*(1+(-1)^n)/4.

Nota. En la comprobación usar

   quickCheckWith (stdArgs {maxSize=7}) prop_naturales0

1	quickCheckWith (stdArgs {maxSize=7}) prop_naturales0

Soluciones

import Test.QuickCheck

naturales0 :: [Int]
naturales0 = concat [[n,0] | n <- [0..]]

-- La propiedad es
prop_naturales0 :: Int -> Property
prop_naturales0 n = 
    n >= 0  ==>  naturales0 !! n == n*(1+(-1)^n) `div` 4

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

import Test.QuickCheck

naturales0 :: [Int]

naturales0 = concat [[n,0] | n <- [0..]]

-- La propiedad es

prop_naturales0 :: Int -> Property

prop_naturales0 n =

n >= 0 ==> naturales0 !! n == n*(1+(-1)^n) `div` 4

-- La comprobación es

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

-- +++ OK, passed 100 tests.

Enumeración de los números enteros

PorJosé A. Alonso 23-enero-201525-marzo-2022

Exercitium

Definir la sucesión

   enteros :: [Int]

1	enteros :: [Int]

tal que sus elementos son los números enteros comenzando en el 0 e intercalando los positivos y los negativos. Por ejemplo,

   ghci> take 23 enteros
   [0,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,7,-7,8,-8,9,-9,10,-10,11,-11]

1 2	ghci> take 23 enteros [0,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,7,-7,8,-8,9,-9,10,-10,11,-11]

Comprobar con QuickCheck que el n-ésimo término de la sucesión es (1-(2n+1)(-1)^n)/4.

Nota. En la comprobación usar

   quickCheckWith (stdArgs {maxSize=7}) prop_enteros

1	quickCheckWith (stdArgs {maxSize=7}) prop_enteros

Soluciones

import Test.QuickCheck

enteros :: [Int]
enteros = 0 : concat [[n,-n] | n <- [1..]]

-- La propiedad es
prop_enteros :: Int -> Property
prop_enteros n = 
    n >= 0 ==> enteros !! n == (1-(2*n+1)*(-1)^n) `div` 4

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

import Test.QuickCheck

enteros :: [Int]

enteros = 0 : concat [[n,-n] | n <- [1..]]

-- La propiedad es

prop_enteros :: Int -> Property

prop_enteros n =

n >= 0 ==> enteros !! n == (1-(2*n+1)*(-1)^n) `div` 4

-- La comprobación es

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

-- +++ OK, passed 100 tests.

Triparticiones de una lista

PorJosé A. Alonso 21-enero-201530-noviembre-2015

Definir la función

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

1	triparticiones :: [a] -> [([a],[a],[a])]

tal que (triparticiones xs) es la lista de las ternas (xs1,xs2,xs3) tales que su concatenación es xs. Por ejemplo,

   ghci> triparticiones "abc"
   [("","","abc"),("","a","bc"),("","ab","c"),("","abc",""),
    ("a","","bc"),("a","b","c"),("a","bc",""),("ab","","c"),
    ("ab","c",""),("abc","","")]

ghci> triparticiones "abc"

[("","","abc"),("","a","bc"),("","ab","c"),("","abc",""),

("a","","bc"),("a","b","c"),("a","bc",""),("ab","","c"),

("ab","c",""),("abc","","")]

Comprobar con QuickCheck que, suponiendo que xs es una lista de elementos comparables por igualdad, entonces para cada terna de (triparticiones xs) se cumple que la concatenación de sus elementos es xs.

Soluciones

import Test.QuickCheck

triparticiones :: [a] -> [([a],[a],[a])]
triparticiones xs = [(xs1,xs2,xs3) | (xs1,ys)  <- biparticiones xs,
                                     (xs2,xs3) <- biparticiones ys]

-- (biparticiones xs) es la lista de los pares (xs1,xs2) tales que su
-- concatenación es xs. Por ejemplo, 
--    ghci> biparticiones "abc"
--    [("","abc"),("a","bc"),("ab","c"),("abc","")]
biparticiones :: [a] -> [([a],[a])]
biparticiones []     = [([],[])]
biparticiones (x:xs) = ([],x:xs) :
                       [(x:xs1,xs2) | (xs1,xs2) <- biparticiones xs]

-- La propiedad es
prop_triparticiones :: Eq a => [a] -> Bool
prop_triparticiones xs =
    all (\(xs1,xs2,xs3) -> xs1 ++ xs2 ++ xs3 == xs) (triparticiones xs)

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

import Test.QuickCheck

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

triparticiones xs = [(xs1,xs2,xs3) | (xs1,ys) <- biparticiones xs,

(xs2,xs3) <- biparticiones ys]

-- (biparticiones xs) es la lista de los pares (xs1,xs2) tales que su

-- concatenación es xs. Por ejemplo,

-- ghci> biparticiones "abc"

-- [("","abc"),("a","bc"),("ab","c"),("abc","")]

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

biparticiones [] = [([],[])]

biparticiones (x:xs) = ([],x:xs) :

[(x:xs1,xs2) | (xs1,xs2) <- biparticiones xs]

-- La propiedad es

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

prop_triparticiones xs =

all (\(xs1,xs2,xs3) -> xs1 ++ xs2 ++ xs3 == xs) (triparticiones xs)

-- La comprobación es

-- ghci> quickCheck prop_triparticiones

-- +++ OK, passed 100 tests.

Ordenación según una función

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

Definir la función

   ordenaSegun :: Ord b => (a -> b) -> [a] -> [a]

1	ordenaSegun :: Ord b => (a -> b) -> [a] -> [a]

tal que (ordenaSegun f xs) es la lista obtenida ordenando los elementos de xs según sus valores mediante la función f. Por ejemplo,

   ordenaSegun abs [-3,2,5,-2]                           ==  [2,-2,-3,5]
   ordenaSegun abs [-3,-2,5,2]                           ==  [-2,2,-3,5]
   ordenaSegun length ["pq","x","mn"]                    ==  ["x","pq","mn"]
   [g 0 | g <- ordenaSegun (\f -> f 4) [(+5),(+2),(+3)]] == [2,3,5]

ordenaSegun abs [-3,2,5,-2] == [2,-2,-3,5]

ordenaSegun abs [-3,-2,5,2] == [-2,2,-3,5]

ordenaSegun length ["pq","x","mn"] == ["x","pq","mn"]

[g 0 | g <- ordenaSegun (\f -> f 4) [(+5),(+2),(+3)]] == [2,3,5]

Comprobar con QuickCheck que (ordenaSegun id) es equivalente a sort.

Soluciones

import Data.List (sort, sortBy)
import Data.Ord (comparing)
import Test.QuickCheck

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

ordenaSegun :: Ord b => (a -> b) -> [a] -> [a]
ordenaSegun _ []  = []
ordenaSegun f (x:xs) = insertaSegun f x (ordenaSegun f xs)

insertaSegun :: Ord b => (a -> b) -> a -> [a] -> [a]
insertaSegun _ x [] = [x]
insertaSegun f x (y:ys) | f x <= f y = x : y : ys
                        | otherwise  = y : insertaSegun f x ys

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

ordenaSegun2 :: Ord b => (a -> b) -> [a] -> [a]
ordenaSegun2 f xs = [xs!!i | (_,i) <- sort (zip [f x | x <- xs] [0..])]

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

ordenaSegun3 :: Ord b => (a -> b) -> [a] -> [a]
ordenaSegun3 f xs = map ((xs!!) . snd) (sort (zip (map f xs) [0..]))

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

ordenaSegun4 :: Ord b => (a -> b) -> [a] -> [a]
ordenaSegun4 = sortBy . comparing

-- La propiedad es
prop_ordenaSegun :: Ord a => [a] -> Bool
prop_ordenaSegun xs =
    ordenaSegun id xs == sort xs

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

import Data.List (sort, sortBy)

import Data.Ord (comparing)

import Test.QuickCheck

-- 1ª definición

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

ordenaSegun :: Ord b => (a -> b) -> [a] -> [a]

ordenaSegun _ [] = []

ordenaSegun f (x:xs) = insertaSegun f x (ordenaSegun f xs)

insertaSegun :: Ord b => (a -> b) -> a -> [a] -> [a]

insertaSegun _ x [] = [x]

insertaSegun f x (y:ys) | f x <= f y = x : y : ys

| otherwise = y : insertaSegun f x ys

-- 2ª definición

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

ordenaSegun2 :: Ord b => (a -> b) -> [a] -> [a]

ordenaSegun2 f xs = [xs!!i | (_,i) <- sort (zip [f x | x <- xs] [0..])]

-- 3ª definición

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

ordenaSegun3 :: Ord b => (a -> b) -> [a] -> [a]

ordenaSegun3 f xs = map ((xs!!) . snd) (sort (zip (map f xs) [0..]))

-- 4ª definición

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

ordenaSegun4 :: Ord b => (a -> b) -> [a] -> [a]

ordenaSegun4 = sortBy . comparing

-- La propiedad es

prop_ordenaSegun :: Ord a => [a] -> Bool

prop_ordenaSegun xs =

ordenaSegun id xs == sort xs

-- La comprobación es

-- ghci> quickCheck prop_ordenaSegun

-- +++ OK, passed 100 tests.

Simplificación de expresiones booleanas

PorJosé A. Alonso 2-enero-201525-abril-2021

El siguiente tipo de dato algebraico representa las expresiones booleanas construidas con una variable (X), las constantes verdadera (V) y falsa (F), la negación (Neg) y la disyunción (Dis):

   data Expr = X
             | V
             | F
             | Neg Expr
             | Dis Expr Expr
             deriving (Eq, Ord, Show)

data Expr = X

| V

| F

| Neg Expr

| Dis Expr Expr

deriving (Eq, Ord, Show)

Por ejemplo, la expresión (¬X v V) se representa por (Dis (Neg X) V).

Definir las funciones

   valor      :: Expr -> Bool -> Bool 
   simplifica :: Expr -> Expr

1 2	valor :: Expr -> Bool -> Bool simplifica :: Expr -> Expr

tales que (valor p i) es el valor de la expresión p cuando se le asigna a X el valor i. Por ejemplo,

   valor (Neg X) True           ==  False
   valor (Neg F) True           ==  True
   valor (Dis X (Neg X)) True   ==  True
   valor (Dis X (Neg X)) False  ==  True

valor (Neg X) True == False

valor (Neg F) True == True

valor (Dis X (Neg X)) True == True

valor (Dis X (Neg X)) False == True

y (simplifica p) es la expresión obtenida aplicándole a p las siguientes reglas de simplificación:

   Neg V       = F
   Neg F       = V
   Neg (Neg q) = q
   Dis V q     = V
   Dis F q     = q
   Dis q V     = V
   Dis q F     = F
   Dis q q     = q

Neg V = F

Neg F = V

Neg (Neg q) = q

Dis V q = V

Dis F q = q

Dis q V = V

Dis q F = F

Dis q q = q

Por ejemplo,

   simplifica (Dis X (Neg (Neg X)))                      ==  X
   simplifica (Neg (Dis (Neg (Neg X)) F))                ==  Neg X
   simplifica (Dis (Neg F) F)                            ==  V
   simplifica (Dis (Neg V) (Neg (Dis (Neg X) F)))        ==  X
   simplifica (Dis (Neg V) (Neg (Dis (Neg (Neg X)) F)))  ==  Neg X

simplifica (Dis X (Neg (Neg X))) == X

simplifica (Neg (Dis (Neg (Neg X)) F)) == Neg X

simplifica (Dis (Neg F) F) == V

simplifica (Dis (Neg V) (Neg (Dis (Neg X) F))) == X

simplifica (Dis (Neg V) (Neg (Dis (Neg (Neg X)) F))) == Neg X

Comprobar con QuickCheck que para cualquier expresión p y cualquier booleano i se verifica que (valor (simplifica p) i) es igual a (valor p i).

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

import Test.QuickCheck
import Control.Monad 

data Expr = X
          | V
          | F
          | Neg Expr
          | Dis Expr Expr
          deriving (Eq, Ord, Show)

valor :: Expr -> Bool -> Bool 
valor = undefined

simplifica :: Expr -> Expr
simplifica = undefined

-- La propiedad es
prop_simplifica :: Expr -> Bool -> Bool
prop_simplifica p i = undefined

-- La comprobación es

-- Generador de expresións
instance Arbitrary Expr where
    arbitrary = sized expr
        where expr n | n <= 0    = atom
                     | otherwise = oneof [ atom
                                         , liftM Neg subexpr
                                         , liftM2 Dis subexpr subexpr ]
                     where atom    = oneof [elements [X,V,F]]
                           subexpr = expr (n `div` 2)

import Test.QuickCheck

import Control.Monad

data Expr = X

| V

| F

| Neg Expr

| Dis Expr Expr

deriving (Eq, Ord, Show)

valor :: Expr -> Bool -> Bool

valor = undefined

simplifica :: Expr -> Expr

simplifica = undefined

-- La propiedad es

prop_simplifica :: Expr -> Bool -> Bool

prop_simplifica p i = undefined

-- La comprobación es

-- Generador de expresións

instance Arbitrary Expr where

arbitrary = sized expr

where expr n | n <= 0 = atom

| otherwise = oneof [ atom

, liftM Neg subexpr

, liftM2 Dis subexpr subexpr ]

where atom = oneof [elements [X,V,F]]

subexpr = expr (n `div` 2)

Soluciones

import Test.QuickCheck
import Control.Monad 

data Expr = X
          | V
          | F
          | Neg Expr
          | Dis Expr Expr
          deriving (Eq, Ord, Show)

valor :: Expr -> Bool -> Bool 
valor X i         = i
valor V _         = True
valor F _         = False
valor (Neg p) i   = not (valor p i)
valor (Dis p q) i = valor p i || valor q i

simplifica :: Expr -> Expr
simplifica X = X
simplifica V = V
simplifica F = F
simplifica (Neg p) = negacion (simplifica p)
    where negacion V       = F
          negacion F       = V
          negacion (Neg p) = p
          negacion p       = Neg p
simplifica (Dis p q) = disyuncion (simplifica p) (simplifica q)
    where disyuncion V q = V
          disyuncion F q = q
          disyuncion q V = V
          disyuncion q F = q
          disyuncion p q | p == q    = p
                         | otherwise = Dis p q

-- La propiedad es
prop_simplifica :: Expr -> Bool -> Bool
prop_simplifica p i =
    valor (simplifica p) i == valor p i

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

-- Generador de expresiones
instance Arbitrary Expr where
    arbitrary = sized expr
        where expr n | n <= 0    = atom
                     | otherwise = oneof [ atom
                                         , liftM Neg subexpr
                                         , liftM2 Dis subexpr subexpr ]
                     where atom    = oneof [elements [X,V,F]]
                           subexpr = expr (n `div` 2)

import Test.QuickCheck

import Control.Monad

data Expr = X

| V

| F

| Neg Expr

| Dis Expr Expr

deriving (Eq, Ord, Show)

valor :: Expr -> Bool -> Bool

valor X i = i

valor V _ = True

valor F _ = False

valor (Neg p) i = not (valor p i)

valor (Dis p q) i = valor p i || valor q i

simplifica :: Expr -> Expr

simplifica X = X

simplifica V = V

simplifica F = F

simplifica (Neg p) = negacion (simplifica p)

where negacion V = F

negacion F = V

negacion (Neg p) = p

negacion p = Neg p

simplifica (Dis p q) = disyuncion (simplifica p) (simplifica q)

where disyuncion V q = V

disyuncion F q = q

disyuncion q V = V

disyuncion q F = q

disyuncion p q | p == q = p

| otherwise = Dis p q

-- La propiedad es

prop_simplifica :: Expr -> Bool -> Bool

prop_simplifica p i =

valor (simplifica p) i == valor p i

-- La comprobación es

-- ghci> quickCheck prop_simplifica

-- +++ OK, passed 100 tests.

-- Generador de expresiones

instance Arbitrary Expr where

arbitrary = sized expr

where expr n | n <= 0 = atom

| otherwise = oneof [ atom

, liftM Neg subexpr

, liftM2 Dis subexpr subexpr ]

where atom = oneof [elements [X,V,F]]

subexpr = expr (n `div` 2)

Enumeración de los pares de números naturales

PorJosé A. Alonso 29-diciembre-201425-marzo-2022

Los pares de los números naturales se pueden ordenar por la suma de sus componentes y entre los pares con la misma suma elegir antes al que tiene mayos su primera componente.

Definir la función

   pares :: [(Int,Int)]

1	pares :: [(Int,Int)]

tal que pares es la lista de los pares de números naturales con el orden anterior. por ejemplo,

   ghci> take 10 pares
   [(0,0),(1,0),(0,1),(2,0),(1,1),(0,2),(3,0),(2,1),(1,2),(0,3)]

1 2	ghci> take 10 pares [(0,0),(1,0),(0,1),(2,0),(1,1),(0,2),(3,0),(2,1),(1,2),(0,3)]

Usando la definición de pares, definir la función

   posicion :: (Int,Int) -> Int

1	posicion :: (Int,Int) -> Int

tal que (posicion p) es la posición del par p en la lista pares. Por ejemplo,

   posicion (0,0)  ==  0
   posicion (2,0)  ==  3

1 2	posicion (0,0) == 0 posicion (2,0) == 3

Finalmente, comprobar con QuickCheck que para cualquier par (x,y) de números naturales, la (posicion (x,y)) es igual a (y + (x+y+1)*(x+y) div 2).

Nota. En la comprobación usar

   quickCheckWith (stdArgs {maxSize=7}) prop_posicion

1	quickCheckWith (stdArgs {maxSize=7}) prop_posicion

Soluciones

import Test.QuickCheck

pares :: [(Int,Int)]
pares = [(n-y,y) | n <- [0..], y <- [0..n]] 

posicion :: (Int,Int) -> Int
posicion p = length (takeWhile (/=p) pares)

-- La propiedad es
prop_posicion :: (Int,Int) -> Property
prop_posicion (x,y) =
    x >= 0 && y >= 0 ==> 
    posicion (x,y) == y + (x+y+1)*(x+y) `div` 2

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

import Test.QuickCheck

pares :: [(Int,Int)]

pares = [(n-y,y) | n <- [0..], y <- [0..n]]

posicion :: (Int,Int) -> Int

posicion p = length (takeWhile (/=p) pares)

-- La propiedad es

prop_posicion :: (Int,Int) -> Property

prop_posicion (x,y) =

x >= 0 && y >= 0 ==>

posicion (x,y) == y + (x+y+1)*(x+y) `div` 2

-- La comprobación es

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

-- +++ OK, passed 100 tests.

Desemparejamiento de listas

PorJosé A. Alonso 23-diciembre-201430-diciembre-2014

Definir la función

   desemparejada :: [(a,b)] -> ([a],[b])

1	desemparejada :: [(a,b)] -> ([a],[b])

tal que (desemparejada ps) es el par de lista (xs,ys) tal que al emparejar (con zip) xs e ys devuelve ps. Por ejemplo,

   ghci> desemparejada [(3,'l'),(2,'u'),(5,'i'),(9,'s')]
   ([3,2,5,9],"luis")

1 2	ghci> desemparejada [(3,'l'),(2,'u'),(5,'i'),(9,'s')] ([3,2,5,9],"luis")

Comprobar con QuickCheck que

desemparejada es equivalente a la función predefinida unzip.
si el valor de (desemparejada ps) es (xs,ys), entonces (zip xs ys) es igual a ps.

Soluciones

import Test.QuickCheck

-- 1ª definición (por comprensión):
desemparejada1 :: [(a,b)] -> ([a],[b])
desemparejada1 ps = ([x | (x,_) <- ps], [y | (_,y) <- ps])

-- 2ª definición (con map):
desemparejada2 :: [(a,b)] -> ([a],[b])
desemparejada2 ps = (map fst ps, map snd ps)

-- 3ª definición (por recursión):
desemparejada3 :: [(a,b)] -> ([a],[b])
desemparejada3 []         = ([],[])
desemparejada3 ((x,y):ps) = (x:xs,y:ys)
    where (xs,ys) = desemparejada3 ps 

-- 4ª definición (por plegado):
desemparejada4 :: [(a,b)] -> ([a],[b])
desemparejada4 = foldr f ([],[])
    where f (x,y) (xs,ys) = (x:xs, y:ys)

-- 5ª definición (por plegado por la izquierda):
desemparejada5 :: [(a,b)] -> ([a],[b])
desemparejada5 ps = (reverse us, reverse vs)
    where (us,vs) = foldl f ([],[]) ps
          f (xs,ys) (x,y) = (x:xs,y:ys)

-- Comparación de eficiencia-
--    ghci> let ps = zip [1..10^7] [1..10^7]
--    
--    ghci> length (fst (desemparejada1 ps))
--    10000000
--    (3.67 secs, 360441524 bytes)
--    
--    ghci> length (fst (desemparejada2 ps))
--    10000000
--    (0.38 secs, 440476764 bytes)
--    
--    ghci> length (fst (desemparejada3 ps))
--    10000000
--    (14.11 secs, 2160188668 bytes)
--    
--    ghci> length (fst (desemparejada4 ps))
--    10000000
--    (19.08 secs, 1658689692 bytes)
--    
--    ghci> length (fst (desemparejada5 ps))
--    10000000
--    (20.98 secs, 1610061796 bytes)

-- En lo que sigue, usaremos la  2º definición
desemparejada :: [(a,b)] -> ([a],[b])
desemparejada = desemparejada2

-- La primera propiedad es
prop_desemparejada_1 :: (Eq a, Eq b) => [(a,b)] -> Bool
prop_desemparejada_1 ps =
    desemparejada ps == unzip ps

-- Su comprobación es
--    ghci> quickCheck prop_desemparejada_1
--    +++ OK, passed 100 tests.

-- La segunda propiedad es
prop_desemparejada_2 :: (Eq a, Eq b) => [(a,b)] -> Bool
prop_desemparejada_2 ps = zip xs ys == ps
    where (xs,ys) = desemparejada ps

-- Su comprobación es
--    ghci> quickCheck prop_desemparejada_2
--    +++ OK, passed 100 tests.

import Test.QuickCheck

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

desemparejada1 :: [(a,b)] -> ([a],[b])

desemparejada1 ps = ([x | (x,_) <- ps], [y | (_,y) <- ps])

-- 2ª definición (con map):

desemparejada2 :: [(a,b)] -> ([a],[b])

desemparejada2 ps = (map fst ps, map snd ps)

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

desemparejada3 :: [(a,b)] -> ([a],[b])

desemparejada3 [] = ([],[])

desemparejada3 ((x,y):ps) = (x:xs,y:ys)

where (xs,ys) = desemparejada3 ps

-- 4ª definición (por plegado):

desemparejada4 :: [(a,b)] -> ([a],[b])

desemparejada4 = foldr f ([],[])

where f (x,y) (xs,ys) = (x:xs, y:ys)

-- 5ª definición (por plegado por la izquierda):

desemparejada5 :: [(a,b)] -> ([a],[b])

desemparejada5 ps = (reverse us, reverse vs)

where (us,vs) = foldl f ([],[]) ps

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

-- Comparación de eficiencia-

-- ghci> let ps = zip [1..10^7] [1..10^7]

-- ghci> length (fst (desemparejada1 ps))

-- 10000000

-- (3.67 secs, 360441524 bytes)

-- ghci> length (fst (desemparejada2 ps))

-- 10000000

-- (0.38 secs, 440476764 bytes)

-- ghci> length (fst (desemparejada3 ps))

-- 10000000

-- (14.11 secs, 2160188668 bytes)

-- ghci> length (fst (desemparejada4 ps))

-- 10000000

-- (19.08 secs, 1658689692 bytes)

-- ghci> length (fst (desemparejada5 ps))

-- 10000000

-- (20.98 secs, 1610061796 bytes)

-- En lo que sigue, usaremos la 2º definición

desemparejada :: [(a,b)] -> ([a],[b])

desemparejada = desemparejada2

-- La primera propiedad es

prop_desemparejada_1 :: (Eq a, Eq b) => [(a,b)] -> Bool

prop_desemparejada_1 ps =

desemparejada ps == unzip ps

-- Su comprobación es

-- ghci> quickCheck prop_desemparejada_1

-- +++ OK, passed 100 tests.

-- La segunda propiedad es

prop_desemparejada_2 :: (Eq a, Eq b) => [(a,b)] -> Bool

prop_desemparejada_2 ps = zip xs ys == ps

where (xs,ys) = desemparejada ps

-- Su comprobación es

-- ghci> quickCheck prop_desemparejada_2

-- +++ OK, passed 100 tests.

Normalización de expresiones aritméticas

PorJosé A. Alonso 10-diciembre-201425-abril-2021

Enunciado

-- El siguiente tipo de dato representa expresiones construidas con
-- variables, sumas y productos
--    data Expr = V String
--              | S Expr Expr
--              | P Expr Expr
--              deriving (Eq, Show)
-- Por ejemplo, x*(y+z) se representa por (P (V "x") (S (V "y") (V "z"))) 
-- 
-- Una expresión es un término si es un producto de variables. Por
-- ejemplo, x*(y*z) es un término pero x+(y*z) ni x*(y+z) lo son.
--
-- Una expresión está en forma normal si es una suma de términos. Por
-- ejemplo, x*(y*z) y x+(y*z) está en forma normal; pero x*(y+z) y
-- (x+y)*(x+z) no lo están. 
-- 
-- Definir la función 
--    normal :: Expr -> Expr
-- tal que (normal e) es la forma normal de la expresión e obtenida
-- aplicando, mientras que sea posible, las propiedades distributivas:
--    (a+b)*c = a*c+b*c
--    c*(a+b) = c*a+c*b
-- Por ejemplo,
--    ghci> normal (P (S (V "x") (V "y")) (V "z"))
--    S (P (V "x") (V "z")) (P (V "y") (V "z"))
--    ghci> normal (P (V "z") (S (V "x") (V "y")))
--    S (P (V "z") (V "x")) (P (V "z") (V "y"))
--    ghci> normal (P (S (V "x") (V "y")) (S (V "u") (V "v")))
--    S (S (P (V "x") (V "u")) (P (V "x") (V "v"))) 
--      (S (P (V "y") (V "u")) (P (V "y") (V "v")))
--    ghci> normal (S (P (V "x") (V "y")) (V "z"))
--    S (P (V "x") (V "y")) (V "z")
--    ghci> normal (V "x")
--    V "x"
--
-- Comprobar con QuickCheck (usando la función esNormal del ejercicio
-- del 2 de diciembre) que para cualquier expresión e, (normal e) está en
-- forma normal y que (normal (normal e)) es igual a (normal e).
--
-- Nota. Para la comprobación se usará el siguiente generador de
-- expresiones aritméticas:
--    instance Arbitrary Expr where
--        arbitrary = sized arb 
--            where
--              arb 0          =  liftM V arbitrary
--              arb n | n > 0  =  oneof [liftM V arbitrary,
--                                       liftM2 S sub sub, 
--                                       liftM2 P sub sub] 
--                    where sub = arb (n `div` 2)

-- El siguiente tipo de dato representa expresiones construidas con

-- variables, sumas y productos

-- data Expr = V String

-- | S Expr Expr

-- | P Expr Expr

-- deriving (Eq, Show)

-- Por ejemplo, x*(y+z) se representa por (P (V "x") (S (V "y") (V "z")))

-- Una expresión es un término si es un producto de variables. Por

-- ejemplo, x*(y*z) es un término pero x+(y*z) ni x*(y+z) lo son.

-- Una expresión está en forma normal si es una suma de términos. Por

-- ejemplo, x*(y*z) y x+(y*z) está en forma normal; pero x*(y+z) y

-- (x+y)*(x+z) no lo están.

-- Definir la función

-- normal :: Expr -> Expr

-- tal que (normal e) es la forma normal de la expresión e obtenida

-- aplicando, mientras que sea posible, las propiedades distributivas:

-- (a+b)*c = a*c+b*c

-- c*(a+b) = c*a+c*b

-- Por ejemplo,

-- ghci> normal (P (S (V "x") (V "y")) (V "z"))

-- S (P (V "x") (V "z")) (P (V "y") (V "z"))

-- ghci> normal (P (V "z") (S (V "x") (V "y")))

-- S (P (V "z") (V "x")) (P (V "z") (V "y"))

-- ghci> normal (P (S (V "x") (V "y")) (S (V "u") (V "v")))

-- S (S (P (V "x") (V "u")) (P (V "x") (V "v")))

-- (S (P (V "y") (V "u")) (P (V "y") (V "v")))

-- ghci> normal (S (P (V "x") (V "y")) (V "z"))

-- S (P (V "x") (V "y")) (V "z")

-- ghci> normal (V "x")

-- V "x"

-- Comprobar con QuickCheck (usando la función esNormal del ejercicio

-- del 2 de diciembre) que para cualquier expresión e, (normal e) está en

-- forma normal y que (normal (normal e)) es igual a (normal e).

-- Nota. Para la comprobación se usará el siguiente generador de

-- expresiones aritméticas:

-- instance Arbitrary Expr where

-- arbitrary = sized arb

-- where

-- arb 0 = liftM V arbitrary

-- arb n | n > 0 = oneof [liftM V arbitrary,

-- liftM2 S sub sub,

-- liftM2 P sub sub]

-- where sub = arb (n `div` 2)

Soluciones

import Test.QuickCheck
import Control.Monad

data Expr = V String
          | S Expr Expr
          | P Expr Expr
          deriving (Eq, Show)

esTermino :: Expr -> Bool
esTermino (V _)   = True
esTermino (S _ _) = False
esTermino (P a b) = esTermino a && esTermino b

esNormal :: Expr -> Bool
esNormal (S a b) = esNormal a && esNormal b
esNormal a       = esTermino a

normal :: Expr -> Expr
normal (V v)   = V v
normal (S a b) = S (normal a) (normal b)
normal (P a b) = p (normal a) (normal b)
    where p (S a b) c = S (p a c) (p b c)
          p a (S b c) = S (p a b) (p a c)
          p a b       = P a b

prop_normal :: Expr -> Bool
prop_normal e = 
    esNormal (normal e) && normal (normal e) == normal e

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

instance Arbitrary Expr where
    arbitrary = sized arb 
        where
          arb 0          =  liftM V arbitrary
          arb n | n > 0  =  oneof [liftM V arbitrary,
                                   liftM2 S sub sub, 
                                   liftM2 P sub sub] 
                where sub = arb (n `div` 2)

import Test.QuickCheck

import Control.Monad

data Expr = V String

| S Expr Expr

| P Expr Expr

deriving (Eq, Show)

esTermino :: Expr -> Bool

esTermino (V _) = True

esTermino (S _ _) = False

esTermino (P a b) = esTermino a && esTermino b

esNormal :: Expr -> Bool

esNormal (S a b) = esNormal a && esNormal b

esNormal a = esTermino a

normal :: Expr -> Expr

normal (V v) = V v

normal (S a b) = S (normal a) (normal b)

normal (P a b) = p (normal a) (normal b)

where p (S a b) c = S (p a c) (p b c)

p a (S b c) = S (p a b) (p a c)

p a b = P a b

prop_normal :: Expr -> Bool

prop_normal e =

esNormal (normal e) && normal (normal e) == normal e

-- La comprobación es

-- ghci> quickCheck prop_normal

-- +++ OK, passed 100 tests.

instance Arbitrary Expr where

arbitrary = sized arb

where

arb 0 = liftM V arbitrary

arb n | n > 0 = oneof [liftM V arbitrary,

liftM2 S sub sub,

liftM2 P sub sub]

where sub = arb (n `div` 2)

Repetición cíclica

PorJosé A. Alonso 25-noviembre-201425-marzo-2022

Enunciado

-- Definir la función
--    ciclica :: [a] -> [a]
-- tal que (ciclica xs) es la lista obtenida repitiendo cíclicamente los
-- elementos de xs. Por ejemplo,
--    take 10 (ciclica [3,5])    ==  [3,5,3,5,3,5,3,5,3,5]
--    take 10 (ciclica [3,5,7])  ==  [3,5,7,3,5,7,3,5,7,3]
--    take 10 (ciclica [3,5..])  ==  [3,5,7,9,11,13,15,17,19,1]
--    ciclica []                 ==  []
--
-- Comprobar con QuickCheck que la función ciclica es equivalente a la
-- predefinida cycle; es decir, para cualquier número entero n y
-- cualquier lista no vacía xs, se verifica que 
--    take n (ciclica xs) == take n (cycle xs)
-- 
-- Nota. Al hacer la comprobación limitar el tamaño de las pruebas como
-- se indica a continuación
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_ciclica
--    +++ OK, passed 100 tests.

-- Definir la función

-- ciclica :: [a] -> [a]

-- tal que (ciclica xs) es la lista obtenida repitiendo cíclicamente los

-- elementos de xs. Por ejemplo,

-- take 10 (ciclica [3,5]) == [3,5,3,5,3,5,3,5,3,5]

-- take 10 (ciclica [3,5,7]) == [3,5,7,3,5,7,3,5,7,3]

-- take 10 (ciclica [3,5..]) == [3,5,7,9,11,13,15,17,19,1]

-- ciclica [] == []

-- Comprobar con QuickCheck que la función ciclica es equivalente a la

-- predefinida cycle; es decir, para cualquier número entero n y

-- cualquier lista no vacía xs, se verifica que

-- take n (ciclica xs) == take n (cycle xs)

-- Nota. Al hacer la comprobación limitar el tamaño de las pruebas como

-- se indica a continuación

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

-- +++ OK, passed 100 tests.

Soluciones

import Test.QuickCheck

-- 1ª definición
ciclica1 :: [a] -> [a]
ciclica1 [] = []
ciclica1 xs = xs ++ ciclica1 xs

-- 2ª definición
ciclica2 :: [a] -> [a]
ciclica2 [] = []
ciclica2 xs = ys where ys = xs ++ ys

-- Comprobación de eficiencia
--    ghci> last (take 10000000 (ciclica1 [1,2])) 
--    2
--    (3.69 secs, 1521758928 bytes)
--    
--    ghci> last (take 10000000 (ciclica2 [1,2])) 
--    2
--    (0.21 secs, 561468144 bytes)
-- La 2ª definición es más eficiente.

-- La propiedad es
prop_ciclica :: Int -> [Int] -> Property
prop_ciclica n xs =
    not (null xs) ==> 
    take n (ciclica2 xs) == take n (cycle xs)

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

import Test.QuickCheck

-- 1ª definición

ciclica1 :: [a] -> [a]

ciclica1 [] = []

ciclica1 xs = xs ++ ciclica1 xs

-- 2ª definición

ciclica2 :: [a] -> [a]

ciclica2 [] = []

ciclica2 xs = ys where ys = xs ++ ys

-- Comprobación de eficiencia

-- ghci> last (take 10000000 (ciclica1 [1,2]))

-- 2

-- (3.69 secs, 1521758928 bytes)

-- ghci> last (take 10000000 (ciclica2 [1,2]))

-- 2

-- (0.21 secs, 561468144 bytes)

-- La 2ª definición es más eficiente.

-- La propiedad es

prop_ciclica :: Int -> [Int] -> Property

prop_ciclica n xs =

not (null xs) ==>

take n (ciclica2 xs) == take n (cycle xs)

-- La comprobación es

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

-- +++ OK, passed 100 tests.

Inversa a trozos

PorJosé A. Alonso 20-noviembre-201427-diciembre-2014

Enunciado

-- Definir la función 
--    inversa :: Int -> [a] -> [a]
-- tal que (inversa k xs) es la lista obtenida invirtiendo elementos de
-- xs, k elementos cada vez. Si el número de elementos de xs no es un
-- múltiplo de k, entonces los finales elementos de xs se dejen sin
-- invertir. Por ejemplo,
--    inversa 3 [1..11]  ==  [3,2,1,6,5,4,9,8,7,10,11]
--    inversa 4 [1..11]  ==  [4,3,2,1,8,7,6,5,9,10,11]
--
-- Comprobar con QuickCheck que la función inversa es involutiva; es
-- decir, para todo número k>0 y toda lista xs, se tiene que
-- (inversa k (inversa k xs)) es igual a xs

-- Definir la función

-- inversa :: Int -> [a] -> [a]

-- tal que (inversa k xs) es la lista obtenida invirtiendo elementos de

-- xs, k elementos cada vez. Si el número de elementos de xs no es un

-- múltiplo de k, entonces los finales elementos de xs se dejen sin

-- invertir. Por ejemplo,

-- inversa 3 [1..11] == [3,2,1,6,5,4,9,8,7,10,11]

-- inversa 4 [1..11] == [4,3,2,1,8,7,6,5,9,10,11]

-- Comprobar con QuickCheck que la función inversa es involutiva; es

-- decir, para todo número k>0 y toda lista xs, se tiene que

-- (inversa k (inversa k xs)) es igual a xs

Soluciones

[schedule expon=’2014-11-27′ expat=»06:00″]

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

[/schedule]

[schedule on=’2014-11-27′ at=»06:00″]

import Test.QuickCheck

-- 1ª definición
inversa1 :: Int -> [a] -> [a]
inversa1 k xs 
    | length xs < k = xs
    | otherwise     = reverse (take k xs) ++ inversa1 k (drop k xs) 

-- 2ª definición 
inversa2 :: Int -> [a] -> [a]
inversa2 k xs = aux xs (length xs) where
    aux xs n
        | n < k     = xs
        | otherwise = reverse (take k xs) ++ aux (drop k xs) (n-k)


-- La dos definiciones son equivalentes
prop_equivalencia ::Int -> [Int] -> Property
prop_equivalencia k xs =
    k > 0 ==> inversa1 k xs == inversa2 k xs

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

-- La segunda es más eficiente
--    ghci> :set +s 
--    
--    ghci> last (inversa1 3 [1..100000])
--    100000
--    (16.42 secs, 17576420 bytes)
--     
--    ghci> last (inversa2 3 [1..100000])
--    100000
--    (0.11 secs, 18171356 bytes)

-- La propiedad es 
prop_inversa :: Int -> [Int] -> Property
prop_inversa k xs =
    k > 0 ==> inversa2 k (inversa2 k xs) == xs

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

import Test.QuickCheck

-- 1ª definición

inversa1 :: Int -> [a] -> [a]

inversa1 k xs

| length xs < k = xs

| otherwise = reverse (take k xs) ++ inversa1 k (drop k xs)

-- 2ª definición

inversa2 :: Int -> [a] -> [a]

inversa2 k xs = aux xs (length xs) where

aux xs n

| n < k = xs

| otherwise = reverse (take k xs) ++ aux (drop k xs) (n-k)

-- La dos definiciones son equivalentes

prop_equivalencia ::Int -> [Int] -> Property

prop_equivalencia k xs =

k > 0 ==> inversa1 k xs == inversa2 k xs

-- La comprobación es

-- ghci> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- La segunda es más eficiente

-- ghci> :set +s

-- ghci> last (inversa1 3 [1..100000])

-- 100000

-- (16.42 secs, 17576420 bytes)

-- ghci> last (inversa2 3 [1..100000])

-- 100000

-- (0.11 secs, 18171356 bytes)

-- La propiedad es

prop_inversa :: Int -> [Int] -> Property

prop_inversa k xs =

k > 0 ==> inversa2 k (inversa2 k xs) == xs

-- La comprobación es

-- ghci> quickCheck prop_inversa

-- +++ OK, passed 100 tests.

[/schedule]

Mayores elementos de una matriz

PorJosé A. Alonso 17-noviembre-201427-diciembre-2014

Enunciado

-- Las matrices se pueden representar mediante listas de listas. Por
-- ejemplo, la matriz
--    |3 2 5|
--    |4 9 7|
-- se puede representar por [[3,2,5],[4,9,7]].
-- 
-- Definir la función
--    mayores :: Ord a => Int -> [[a]] -> [(a,Int)]
-- tal que (mayores n xss) es la lista de los n mayores elementos de la
-- matriz xss junto con sus correspondientes número de fila. Por
-- ejemplo,
--    ghci> mayores 4 [[4,26,9],[2,37,53],[41,1,8]]
--    [(53,2),(41,3),(37,2),(26,1)]
-- 
-- Comprobar con QuickCheck que todos los elementos de (mayores n xss)
-- son mayores o iguales que los restantes elementos de xss.
-- 
-- Nota: Se pueden usar las funciones sort y (\\) de la librería
-- Data.List.

-- Las matrices se pueden representar mediante listas de listas. Por

-- ejemplo, la matriz

-- |3 2 5|

-- |4 9 7|

-- se puede representar por [[3,2,5],[4,9,7]].

-- Definir la función

-- mayores :: Ord a => Int -> [[a]] -> [(a,Int)]

-- tal que (mayores n xss) es la lista de los n mayores elementos de la

-- matriz xss junto con sus correspondientes número de fila. Por

-- ejemplo,

-- ghci> mayores 4 [[4,26,9],[2,37,53],[41,1,8]]

-- [(53,2),(41,3),(37,2),(26,1)]

-- Comprobar con QuickCheck que todos los elementos de (mayores n xss)

-- son mayores o iguales que los restantes elementos de xss.

-- Nota: Se pueden usar las funciones sort y (\\) de la librería

-- Data.List.

Soluciones

import Data.List (sort, (\\))
import Test.QuickCheck

-- 1ª solución (con auxiliares)
-- ============================

mayores1 :: Ord a => Int -> [[a]] -> [(a,Int)]
mayores1 n xss = take n (reverse (sort (enumeracion xss)))

-- (enumeracion xss) es la lista de los elementos de xs junto con el
-- número de su fila. Por ejemplo,
--    ghci> enumeracion [[4,26,9],[2,37,53],[41,1,8]]
--    [(4,1),(26,1),(9,1),(2,2),(37,2),(53,2),(41,3),(1,3),(8,3)]
enumeracion :: [[a]] -> [(a,Int)]
enumeracion xss =
    [(x,i) | (xs,i) <- enumeracionFilas xss, x <- xs]

-- (enumeracionFilas xss) es la lista de las filas de xs junto con su
-- número. Por ejemplo,
--    ghci> enumeracionFilas [[4,26,9],[2,37,53],[41,1,8]]
--    [([4,26,9],1),([2,37,53],2),([41,1,8],3)]
enumeracionFilas :: [[a]] -> [([a],Int)]
enumeracionFilas xss = zip xss [1..]

-- 2ª solución (sin auxiliares)
-- ============================

mayores2 :: Ord a => Int -> [[a]] -> [(a,Int)]
mayores2 n xss = 
    take n (reverse (sort [(x,i) | (xs,i) <- zip xss [1..], x <- xs]))

-- Comprobaciones
-- ==============

-- Las dos definiciones son equivalentes
prop_equivalencia :: Int -> [[Int]] -> Bool
prop_equivalencia n xss =
    mayores1 n xss == mayores2 n xss

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

-- La propiedad de mayores es
prop_mayores :: Int -> [[Int]] -> Bool
prop_mayores n xss =
    and [x <= y | x <- elementos \\ elementosMayores, y <- elementosMayores]
    where elementos = concat xss
          elementosMayores = [x | (x,_) <- mayores1 n xss]

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

-- Otra forma de expresa la propiedad es
prop_mayores2 :: Int -> [[Int]] -> Bool
prop_mayores2 n xss = 
    all (\x -> all (<=x) elementosRestantes) elementosMayores
    where elementosMayores   = map fst (mayores1 n xss)
          elementosRestantes = concat xss \\ elementosMayores

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

import Data.List (sort, (\\))

import Test.QuickCheck

-- 1ª solución (con auxiliares)

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

mayores1 :: Ord a => Int -> [[a]] -> [(a,Int)]

mayores1 n xss = take n (reverse (sort (enumeracion xss)))

-- (enumeracion xss) es la lista de los elementos de xs junto con el

-- número de su fila. Por ejemplo,

-- ghci> enumeracion [[4,26,9],[2,37,53],[41,1,8]]

-- [(4,1),(26,1),(9,1),(2,2),(37,2),(53,2),(41,3),(1,3),(8,3)]

enumeracion :: [[a]] -> [(a,Int)]

enumeracion xss =

[(x,i) | (xs,i) <- enumeracionFilas xss, x <- xs]

-- (enumeracionFilas xss) es la lista de las filas de xs junto con su

-- número. Por ejemplo,

-- ghci> enumeracionFilas [[4,26,9],[2,37,53],[41,1,8]]

-- [([4,26,9],1),([2,37,53],2),([41,1,8],3)]

enumeracionFilas :: [[a]] -> [([a],Int)]

enumeracionFilas xss = zip xss [1..]

-- 2ª solución (sin auxiliares)

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

mayores2 :: Ord a => Int -> [[a]] -> [(a,Int)]

mayores2 n xss =

take n (reverse (sort [(x,i) | (xs,i) <- zip xss [1..], x <- xs]))

-- Comprobaciones

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

-- Las dos definiciones son equivalentes

prop_equivalencia :: Int -> [[Int]] -> Bool

prop_equivalencia n xss =

mayores1 n xss == mayores2 n xss

-- La comprobación es

-- ghci> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- La propiedad de mayores es

prop_mayores :: Int -> [[Int]] -> Bool

prop_mayores n xss =

and [x <= y | x <- elementos \\ elementosMayores, y <- elementosMayores]

where elementos = concat xss

elementosMayores = [x | (x,_) <- mayores1 n xss]

-- La comprobación es

-- ghci> quickCheck prop_mayores

-- +++ OK, passed 100 tests.

-- Otra forma de expresa la propiedad es

prop_mayores2 :: Int -> [[Int]] -> Bool

prop_mayores2 n xss =

all (\x -> all (<=x) elementosRestantes) elementosMayores

where elementosMayores = map fst (mayores1 n xss)

elementosRestantes = concat xss \\ elementosMayores

-- La comprobación es

-- ghci> quickCheck prop_mayores2

-- +++ OK, passed 100 tests.

Último dígito no nulo del factorial

PorJosé A. Alonso 14-noviembre-201425-abril-2021

Enunciado

-- El factorial de 7 es
--    7! = 1 * 2 * 3 * 4 * 5 * 6 * 7 = 5040
-- por tanto, el último dígito no nulo del factorial de 7 es 4.
-- 
-- Definir la función
--    ultimoNoNuloFactorial :: Integer -> Integer
-- tal que (ultimoNoNuloFactorial n) es el último dígito no nulo del
-- factorial de n. Por ejemplo,
--    ultimoNoNuloFactorial  7  == 4
--    ultimoNoNuloFactorial 10  == 8
--    ultimoNoNuloFactorial 12  == 6
--    ultimoNoNuloFactorial 97  == 2
--    ultimoNoNuloFactorial  0  == 1
--
-- Comprobar con QuickCheck que si n es mayor que 4, entonces el último
-- dígito no nulo del factorial de n es par.

-- El factorial de 7 es

-- 7! = 1 * 2 * 3 * 4 * 5 * 6 * 7 = 5040

-- por tanto, el último dígito no nulo del factorial de 7 es 4.

-- Definir la función

-- ultimoNoNuloFactorial :: Integer -> Integer

-- tal que (ultimoNoNuloFactorial n) es el último dígito no nulo del

-- factorial de n. Por ejemplo,

-- ultimoNoNuloFactorial 7 == 4

-- ultimoNoNuloFactorial 10 == 8

-- ultimoNoNuloFactorial 12 == 6

-- ultimoNoNuloFactorial 97 == 2

-- ultimoNoNuloFactorial 0 == 1

-- Comprobar con QuickCheck que si n es mayor que 4, entonces el último

-- dígito no nulo del factorial de n es par.

Soluciones

import Test.QuickCheck

ultimoNoNuloFactorial :: Integer -> Integer
ultimoNoNuloFactorial n = ultimoNoNulo (factorial n)

-- (ultimoNoNulo n) es el último dígito no nulo de n. Por ejemplo,
--    ultimoNoNulo 5040  ==  4
ultimoNoNulo :: Integer -> Integer
ultimoNoNulo n | m /= 0    = m
               | otherwise = ultimoNoNulo (n `div` 10)
               where m = n `rem` 10

-- 2ª definición (por comprensión)
ultimoNoNulo2 :: Integer -> Integer
ultimoNoNulo2 n = read [head (dropWhile (=='0') (reverse (show n)))]

-- (factorial n) es el factorial de n. Por ejemplo,
--    factorial 7  ==  5040
factorial :: Integer -> Integer
factorial n = product [1..n]


-- La propiedad es
prop_ultimoNoNuloFactorial :: Integer -> Property
prop_ultimoNoNuloFactorial n = 
    n > 4 ==> even (ultimoNoNuloFactorial n)
                  
-- La comprobación es
--    ghci> quickCheck prop_ultimoNoNuloFactorial
--    +++ OK, passed 100 tests.

import Test.QuickCheck

ultimoNoNuloFactorial :: Integer -> Integer

ultimoNoNuloFactorial n = ultimoNoNulo (factorial n)

-- (ultimoNoNulo n) es el último dígito no nulo de n. Por ejemplo,

-- ultimoNoNulo 5040 == 4

ultimoNoNulo :: Integer -> Integer

ultimoNoNulo n | m /= 0 = m

| otherwise = ultimoNoNulo (n `div` 10)

where m = n `rem` 10

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

ultimoNoNulo2 :: Integer -> Integer

ultimoNoNulo2 n = read [head (dropWhile (=='0') (reverse (show n)))]

-- (factorial n) es el factorial de n. Por ejemplo,

-- factorial 7 == 5040

factorial :: Integer -> Integer

factorial n = product [1..n]

-- La propiedad es

prop_ultimoNoNuloFactorial :: Integer -> Property

prop_ultimoNoNuloFactorial n =

n > 4 ==> even (ultimoNoNuloFactorial n)

-- La comprobación es

-- ghci> quickCheck prop_ultimoNoNuloFactorial

-- +++ OK, passed 100 tests.

Repetición de elementos

PorJosé A. Alonso 13-noviembre-201427-diciembre-2014

Enunciado

-- Definir la función
--    repiteElementos :: Int -> [a] -> [a]
-- tal que (repiteElementos k xs) es la lista obtenida repitiendo cada
-- elemento de xs k veces. Por ejemplo,
--    repiteElementos 3 [5,2,7,4]  ==  [5,5,5,2,2,2,7,7,7,4,4,4]
--
-- Comprobar con QuickCheck que, para todo número natural k y toda lista
-- xs, el número de elementos de (repiteElementos k xs) es k veces el
-- número de elementos de xs.
--
-- Nota. Al hacer la comprobación limitar el tamaño de las pruebas como
-- se indica a continuación
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_repiteElementos
--    +++ OK, passed 100 tests.

-- Definir la función

-- repiteElementos :: Int -> [a] -> [a]

-- tal que (repiteElementos k xs) es la lista obtenida repitiendo cada

-- elemento de xs k veces. Por ejemplo,

-- repiteElementos 3 [5,2,7,4] == [5,5,5,2,2,2,7,7,7,4,4,4]

-- Comprobar con QuickCheck que, para todo número natural k y toda lista

-- xs, el número de elementos de (repiteElementos k xs) es k veces el

-- número de elementos de xs.

-- Nota. Al hacer la comprobación limitar el tamaño de las pruebas como

-- se indica a continuación

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

-- +++ OK, passed 100 tests.

Soluciones

import Test.QuickCheck

-- 1ª definición (por comprensión):
repiteElementos1 :: Int -> [a] -> [a]
repiteElementos1 k xs = concat [replicate k x | x <- xs]

-- 2ª definición (con map)
repiteElementos2 :: Int -> [a] -> [a]
repiteElementos2 k xs = concat (map (replicate k) xs)

-- 3ª definición (con concatMap):
repiteElementos3 :: Int -> [a] -> [a]
repiteElementos3 k = concatMap (replicate k)

-- 4ª definición (por recursión):
repiteElementos4 :: Int -> [a] -> [a]
repiteElementos4 k [] = []
repiteElementos4 k (x:xs) = replicate k x ++ repiteElementos4 k xs

-- 5ª definición (por plegado):
repiteElementos5 :: Int -> [a] -> [a]
repiteElementos5 k = foldr ((++) . replicate k) []

-- Propiedad de equivalencia
prop_equivalencia :: Int -> [Int] -> Bool
prop_equivalencia k xs =
    repiteElementos2 k xs == ys &&
    repiteElementos3 k xs == ys &&
    repiteElementos4 k xs == ys &&
    repiteElementos5 k xs == ys 
    where ys = repiteElementos1 k xs

-- Su comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=10}) prop_equivalencia
--    +++ OK, passed 100 tests.

-- La propiedad es
prop_repiteElementos :: Int -> [Int] -> Property
prop_repiteElementos k xs =
    k >= 0 ==> length (repiteElementos1 k xs) == k * length xs 

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

import Test.QuickCheck

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

repiteElementos1 :: Int -> [a] -> [a]

repiteElementos1 k xs = concat [replicate k x | x <- xs]

-- 2ª definición (con map)

repiteElementos2 :: Int -> [a] -> [a]

repiteElementos2 k xs = concat (map (replicate k) xs)

-- 3ª definición (con concatMap):

repiteElementos3 :: Int -> [a] -> [a]

repiteElementos3 k = concatMap (replicate k)

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

repiteElementos4 :: Int -> [a] -> [a]

repiteElementos4 k [] = []

repiteElementos4 k (x:xs) = replicate k x ++ repiteElementos4 k xs

-- 5ª definición (por plegado):

repiteElementos5 :: Int -> [a] -> [a]

repiteElementos5 k = foldr ((++) . replicate k) []

-- Propiedad de equivalencia

prop_equivalencia :: Int -> [Int] -> Bool

prop_equivalencia k xs =

repiteElementos2 k xs == ys &&

repiteElementos3 k xs == ys &&

repiteElementos4 k xs == ys &&

repiteElementos5 k xs == ys

where ys = repiteElementos1 k xs

-- Su comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=10}) prop_equivalencia

-- +++ OK, passed 100 tests.

-- La propiedad es

prop_repiteElementos :: Int -> [Int] -> Property

prop_repiteElementos k xs =

k >= 0 ==> length (repiteElementos1 k xs) == k * length xs

-- La comprobación es

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

-- +++ OK, passed 100 tests.

Distancia de Hamming

PorJosé A. Alonso 7-noviembre-201425-abril-2021

Enunciado

-- La distancia de Hamming entre dos listas es el número de posiciones
-- en que los correspondientes elementos son distintos. Por ejemplo, la
-- distancia de Hamming entre "roma" y "loba" es 2 (porque hay 2
-- posiciones en las que los elementos correspondientes son distintos:
-- la 1ª y la 3ª). 
-- 
-- Definir la función
--    distancia :: Eq a => [a] -> [a] -> Int
-- tal que (distancia xs ys) es la distancia de Hamming entre xs e
-- ys. Por ejemplo,
--    distancia "romano" "comino"  ==  2
--    distancia "romano" "camino"  ==  3
--    distancia "roma"   "comino"  ==  2
--    distancia "roma"   "camino"  ==  3
--    distancia "romano" "ron"     ==  1
--    distancia "romano" "cama"    ==  2
--    distancia "romano" "rama"    ==  1
--
-- Comprobar con QuickCheck si la distancia de Hamming tiene la
-- siguiente propiedad
--    distancia(xs,ys) = 0 si, y sólo si, xs = ys
-- y, en el caso de que no se verifique, modificar ligeramente la
-- propiedad para obtener una condición necesaria y suficiente de 
-- distancia(xs,ys) = 0.

-- La distancia de Hamming entre dos listas es el número de posiciones

-- en que los correspondientes elementos son distintos. Por ejemplo, la

-- distancia de Hamming entre "roma" y "loba" es 2 (porque hay 2

-- posiciones en las que los elementos correspondientes son distintos:

-- la 1ª y la 3ª).

-- Definir la función

-- distancia :: Eq a => [a] -> [a] -> Int

-- tal que (distancia xs ys) es la distancia de Hamming entre xs e

-- ys. Por ejemplo,

-- distancia "romano" "comino" == 2

-- distancia "romano" "camino" == 3

-- distancia "roma" "comino" == 2

-- distancia "roma" "camino" == 3

-- distancia "romano" "ron" == 1

-- distancia "romano" "cama" == 2

-- distancia "romano" "rama" == 1

-- Comprobar con QuickCheck si la distancia de Hamming tiene la

-- siguiente propiedad

-- distancia(xs,ys) = 0 si, y sólo si, xs = ys

-- y, en el caso de que no se verifique, modificar ligeramente la

-- propiedad para obtener una condición necesaria y suficiente de

-- distancia(xs,ys) = 0.

Soluciones

import Test.QuickCheck

-- 1ª definición (por comprensión):
distancia :: Eq a => [a] -> [a] -> Int
distancia xs ys = sum [1 | (x,y) <- zip xs ys, x /= y] 

-- 2ª definición (por recursión):
distancia2 :: Eq a => [a] -> [a] -> Int
distancia2 [] ys = 0
distancia2 xs [] = 0
distancia2 (x:xs) (y:ys) | x /= y    = 1 + distancia2 xs ys
                         | otherwise = distancia2 xs ys

-- La propiedad es
prop_distancia1 :: [Int] -> [Int] -> Bool
prop_distancia1 xs ys =
    (distancia xs ys == 0) == (xs == ys)

-- La comprobación es
--    ghci> quickCheck prop_distancia1
--    *** Failed! Falsifiable (after 2 tests and 1 shrink): 
--    []
--    [1]
-- En efecto,
--    ghci> distancia [] [1] == 0
--    True
--    ghci> [] == [1]
--    False

-- La primera modificación es restringir la propiedad a lista de igual
-- longitud: 
prop_distancia2 :: [Int] -> [Int] -> Property
prop_distancia2 xs ys =
    length xs == length ys ==> 
    (distancia xs ys == 0) == (xs == ys)

-- La comprobación es
--    ghci> quickCheck prop_distancia2
--    *** Gave up! Passed only 33 tests.

-- Nota. La propiedad se verifica, pero al ser la condición demasiado
-- restringida sólo 33 de los casos la cumple.

-- La segunda restricción es limitar las listas a la longitud de la más
-- corta: 
prop_distancia3 :: [Int] -> [Int] -> Bool
prop_distancia3 xs ys =
    (distancia xs ys == 0) == (take n xs == take n ys)
    where n = min (length xs) (length ys)

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

import Test.QuickCheck

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

distancia :: Eq a => [a] -> [a] -> Int

distancia xs ys = sum [1 | (x,y) <- zip xs ys, x /= y]

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

distancia2 :: Eq a => [a] -> [a] -> Int

distancia2 [] ys = 0

distancia2 xs [] = 0

distancia2 (x:xs) (y:ys) | x /= y = 1 + distancia2 xs ys

| otherwise = distancia2 xs ys

-- La propiedad es

prop_distancia1 :: [Int] -> [Int] -> Bool

prop_distancia1 xs ys =

(distancia xs ys == 0) == (xs == ys)

-- La comprobación es

-- ghci> quickCheck prop_distancia1

-- *** Failed! Falsifiable (after 2 tests and 1 shrink):

-- []

-- [1]

-- En efecto,

-- ghci> distancia [] [1] == 0

-- True

-- ghci> [] == [1]

-- False

-- La primera modificación es restringir la propiedad a lista de igual

-- longitud:

prop_distancia2 :: [Int] -> [Int] -> Property

prop_distancia2 xs ys =

length xs == length ys ==>

(distancia xs ys == 0) == (xs == ys)

-- La comprobación es

-- ghci> quickCheck prop_distancia2

-- *** Gave up! Passed only 33 tests.

-- Nota. La propiedad se verifica, pero al ser la condición demasiado

-- restringida sólo 33 de los casos la cumple.

-- La segunda restricción es limitar las listas a la longitud de la más

-- corta:

prop_distancia3 :: [Int] -> [Int] -> Bool

prop_distancia3 xs ys =

(distancia xs ys == 0) == (take n xs == take n ys)

where n = min (length xs) (length ys)

-- La comprobación es

-- ghci> quickCheck prop_distancia3

-- +++ OK, passed 100 tests.

Rompecabeza matemático

PorJosé A. Alonso 6-noviembre-201427-diciembre-2014

Enunciado

-- Definir una función
--    f :: Int -> Int
-- tal que para todo n, f(f(n)) = -n y comprobar con QuickCheck que se
-- cumple la propiedad
--    prop_f :: Int -> Bool
--    prop_f n = f (f n) == -n
-- es decir,
--    ghci> quickCheck prop_f
--    +++ OK, passed 100 tests.

-- Definir una función

-- f :: Int -> Int

-- tal que para todo n, f(f(n)) = -n y comprobar con QuickCheck que se

-- cumple la propiedad

-- prop_f :: Int -> Bool

-- prop_f n = f (f n) == -n

-- es decir,

-- ghci> quickCheck prop_f

-- +++ OK, passed 100 tests.

Soluciones

import Test.QuickCheck

-- 1ª definición (por casos)
f :: Int -> Int
f n | even n && n > 0 = n-1
    | even n && n < 0 = n+1
    | odd  n && n > 0 = -n-1
    | odd  n && n < 0 = -n+1
    | otherwise       = 0

-- La propiedad es
prop_f :: Int -> Bool
prop_f n = f (f n) == -n

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

-- 2ª definición (por casos y signo):
f2 :: Int -> Int
f2 n | even n    =  n - signum n
     | odd  n    = -n - signum n
     | otherwise = 0

-- La propiedad es
prop_f2 :: Int -> Bool
prop_f2 n = f2 (f2 n) == -n

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

-- 3ª solución (sin casos):
f3 :: Int -> Int
f3 n = n * (2 * mod n 2 - 1) + signum n

-- La propiedad es
prop_f3 :: Int -> Bool
prop_f3 n = f3 (f3 n) == -n

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

-- 4ª solución (sin casos):
f4 :: Int -> Int
f4 n = (-1)^(abs n)*n - signum n

-- La propiedad es
prop_f4 :: Int -> Bool
prop_f4 n = f4 (f4 n) == -n

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

import Test.QuickCheck

-- 1ª definición (por casos)

f :: Int -> Int

f n | even n && n > 0 = n-1

| even n && n < 0 = n+1

| odd n && n > 0 = -n-1

| odd n && n < 0 = -n+1

| otherwise = 0

-- La propiedad es

prop_f :: Int -> Bool

prop_f n = f (f n) == -n

-- La comprobación es

-- ghci> quickCheck prop_f

-- +++ OK, passed 100 tests.

-- 2ª definición (por casos y signo):

f2 :: Int -> Int

f2 n | even n = n - signum n

| odd n = -n - signum n

| otherwise = 0

-- La propiedad es

prop_f2 :: Int -> Bool

prop_f2 n = f2 (f2 n) == -n

-- La comprobación es

-- ghci> quickCheck prop_f2

-- +++ OK, passed 100 tests.

-- 3ª solución (sin casos):

f3 :: Int -> Int

f3 n = n * (2 * mod n 2 - 1) + signum n

-- La propiedad es

prop_f3 :: Int -> Bool

prop_f3 n = f3 (f3 n) == -n

-- La comprobación es

-- ghci> quickCheck prop_f3

-- +++ OK, passed 100 tests.

-- 4ª solución (sin casos):

f4 :: Int -> Int

f4 n = (-1)^(abs n)*n - signum n

-- La propiedad es

prop_f4 :: Int -> Bool

prop_f4 n = f4 (f4 n) == -n

-- La comprobación es

-- ghci> quickCheck prop_f4

-- +++ OK, passed 100 tests.

Máximo de una función

PorJosé A. Alonso 4-noviembre-201427-diciembre-2014

Enunciado

-- Se considera la siguiente función
--    g :: Integer -> Integer
--    g n = if n < 10 then n*n else n
-- 
-- Definir la función 
--    max_g :: Integer -> Integer
-- tal que (max_g n) es el punto i del intervalo [0,n] donde g alcanza
-- el máximo de sus valores, si n es positivo y 0 en caso contrario. Por
-- ejemplo,
--    max_g (-7)  ==  0
--    max_g 7     ==  7
--    max_g 14    ==  9
--    max_g 84    ==  84
-- 
-- Comprobar con QuickCheck que la función max_g es equivalente a la
-- función f definida por  
--    f :: Integer -> Integer
--    f n | n < 0             = 0
--        | n >= 10 && n < 81 = 9
--        | otherwise         = n
--
-- Nota: Se piden dos definiciones de max_g, una por comprensión y otra
-- por recursión.

-- Se considera la siguiente función

-- g :: Integer -> Integer

-- g n = if n < 10 then n*n else n

-- Definir la función

-- max_g :: Integer -> Integer

-- tal que (max_g n) es el punto i del intervalo [0,n] donde g alcanza

-- el máximo de sus valores, si n es positivo y 0 en caso contrario. Por

-- ejemplo,

-- max_g (-7) == 0

-- max_g 7 == 7

-- max_g 14 == 9

-- max_g 84 == 84

-- Comprobar con QuickCheck que la función max_g es equivalente a la

-- función f definida por

-- f :: Integer -> Integer

-- f n | n < 0 = 0

-- | n >= 10 && n < 81 = 9

-- | otherwise = n

-- Nota: Se piden dos definiciones de max_g, una por comprensión y otra

-- por recursión.

Soluciones

import Test.QuickCheck

g :: Integer -> Integer
g n = if n < 10 then n*n else n

-- 1ª definición (por comprensión):
max_gC :: Integer -> Integer
max_gC n | n < 0     = 0 
         | otherwise = snd (maximum [(g i,i) | i <- [0..n]])

-- 2ª definición (por recursión):
max_gR :: Integer -> Integer
max_gR n | n < 0      = 0
         | g m > g n  = m 
         | otherwise  = n
         where m = max_gR (n - 1)

f :: Integer -> Integer
f n | n < 0             = 0
    | n >= 10 && n < 81 = 9
    | otherwise         = n

-- La propiedad con max_gR es
prop_max_gR n = max_gR n == f n

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

-- La propiedad con max_gC es
prop_max_gC n = max_gC n == f n

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

import Test.QuickCheck

g :: Integer -> Integer

g n = if n < 10 then n*n else n

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

max_gC :: Integer -> Integer

max_gC n | n < 0 = 0

| otherwise = snd (maximum [(g i,i) | i <- [0..n]])

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

max_gR :: Integer -> Integer

max_gR n | n < 0 = 0

| g m > g n = m

| otherwise = n

where m = max_gR (n - 1)

f :: Integer -> Integer

f n | n < 0 = 0

| n >= 10 && n < 81 = 9

| otherwise = n

-- La propiedad con max_gR es

prop_max_gR n = max_gR n == f n

-- La comprobación es

-- ghci> quickCheck prop_max_gR

-- +++ OK, passed 100 tests.

-- La propiedad con max_gC es

prop_max_gC n = max_gC n == f n

-- La comprobación es

-- ghci> quickCheck prop_max_gC

-- +++ OK, passed 100 tests.

Elementos no repetidos

PorJosé A. Alonso 1-noviembre-201425-abril-2021

Enunciado

-- Definir la función 
--    noRepetidos :: Eq a => [a] -> [a]
-- tal que (noRepetidos xs) es la lista de los elementos no repetidos de
-- la lista xs. Por ejemplo,
--    noRepetidos [3,2,5,2,4,7,3]  ==  [5,4,7]
--    noRepetidos "noRepetidos"    ==  "nRptids"
--    noRepetidos "Roma"           ==  "Roma"

-- Definir la función

-- noRepetidos :: Eq a => [a] -> [a]

-- tal que (noRepetidos xs) es la lista de los elementos no repetidos de

-- la lista xs. Por ejemplo,

-- noRepetidos [3,2,5,2,4,7,3] == [5,4,7]

-- noRepetidos "noRepetidos" == "nRptids"

-- noRepetidos "Roma" == "Roma"

Soluciones

import Test.QuickCheck

-- 1ª solución (por comprensión):
noRepetidos :: Eq a => [a] -> [a]
noRepetidos xs = 
    [x | x <- xs, ocurrencias x xs == 1]

-- (ocurrencias x ys) es el número de ocurrencias de x en ys. Por
-- ejemplo,
--    ocurrencias 3 [3,2,5,2,4,7,3]  ==  2
--    ocurrencias 5 [3,2,5,2,4,7,3]  ==  1
ocurrencias :: Eq a => a -> [a] -> Int
ocurrencias x ys = 
    length [y | y <- ys, y == x]

-- 2ª definición (por recursión):
noRepetidos2 :: Eq a => [a] -> [a]
noRepetidos2 [] = []
noRepetidos2 (x:xs) | elem x xs = noRepetidos2 [y | y <- xs, y /= x]
                    | otherwise = x : noRepetidos2 xs

-- La propiedad de equivalencia es
prop_equivalencia :: [Int] -> Bool
prop_equivalencia xs =
    noRepetidos xs == noRepetidos2 xs

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

import Test.QuickCheck

-- 1ª solución (por comprensión):

noRepetidos :: Eq a => [a] -> [a]

noRepetidos xs =

[x | x <- xs, ocurrencias x xs == 1]

-- (ocurrencias x ys) es el número de ocurrencias de x en ys. Por

-- ejemplo,

-- ocurrencias 3 [3,2,5,2,4,7,3] == 2

-- ocurrencias 5 [3,2,5,2,4,7,3] == 1

ocurrencias :: Eq a => a -> [a] -> Int

ocurrencias x ys =

length [y | y <- ys, y == x]

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

noRepetidos2 :: Eq a => [a] -> [a]

noRepetidos2 [] = []

noRepetidos2 (x:xs) | elem x xs = noRepetidos2 [y | y <- xs, y /= x]

| otherwise = x : noRepetidos2 xs

-- La propiedad de equivalencia es

prop_equivalencia :: [Int] -> Bool

prop_equivalencia xs =

noRepetidos xs == noRepetidos2 xs

-- La comprobación es

-- ghci> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Exercitium

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Entradas recientes

Buscar

Correo electrónico