Tema 5: Definiciones de listas por comprensión

Nota: En este tema se usarán las siguientes librerías

import Data.Char  
import Test.QuickCheck

1 Generadores

Definiciones por comprensión

ghci> [x^2 | x <- [2..5]]
[4,9,16,25]
ghci> [(x,y) | x <- [1,2,3], y <- [4,5]]
[(1,4),(1,5),(2,4),(2,5),(3,4),(3,5)]
ghci> [(x,y) | y <- [4,5], x <- [1,2,3]]
[(1,4),(2,4),(3,4),(1,5),(2,5),(3,5)]

Generadores dependientes

ghci> [(x,y) | x <- [1..3], y <- [x..3]]
[(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]
concat [[1,3],[2,5,6],[4,7]]  ==  [1,3,2,5,6,4,7]`
concat :: [[a]] -> [a]
concat xss = [x | xs <- xss, x <- xs]

Generadores con variables anónimas

primeros [(1,3),(2,5),(6,3)]  ==  [1,2,6]`
primeros :: [(a, b)] -> [a]
primeros ps =  [x | (x,_) <- ps]
length :: [a] -> Int
length xs = sum [1 | _ <- xs]

2 Guardas

ghci> [x | x <- [1..10], even x]
[2,4,6,8,10] 
factores 30  ==  [1,2,3,5,6,10,15,30]`
factores :: Int -> [Int]
factores n = [x | x <- [1..n], n `mod` x == 0]
primo 30  == False
primo 31  == True
primo :: Int -> Bool
primo n = factores n == [1, n]
primos 31  == [2,3,5,7,11,13,17,19,23,29,31]
primos :: Int -> [Int]
primos n = [x | x <- [2..n], primo x]

Guarda con igualdad

[("Juan",7),("Ana",9),("Eva",3)]
busca 'b' [('a',1),('b',3),('c',5),('b',2)] ==  [3,2]
busca :: Eq a => a -> [(a, b)] -> [b]
busca c t = [v | (c', v) <- t, c' == c]

3 La función zip

La función zip y elementos adyacentes

ghci> zip ['a','b','c'] [2,5,4,7]
[('a',2),('b',5),('c',4)]  
adyacentes [2,5,3,7]  ==  [(2,5),(5,3),(3,7)]
adyacentes :: [a] -> [(a, a)]
adyacentes xs = zip xs (tail xs)

Las funciones zip, and y listas ordenadas

and [2 < 3, 2+3 == 5]         ==  True
and [2 < 3, 2+3 == 5, 7 < 7]  ==  False  
ordenada [1,3,5,6,7]  ==  True
ordenada [1,3,6,5,7]  ==  False
ordenada :: Ord a => [a] -> Bool
ordenada xs = and [x <= y | (x,y) <- adyacentes xs]

La función zip y lista de posiciones

posiciones 5 [1,5,3,5,5,7]  ==  [1,3,4]
posiciones :: Eq a => a -> [a] -> [Int]
posiciones x xs = 
    [i | (x',i) <- zip xs [0..n], x == x']
    where n = length xs - 1

4 Comprensión de cadenas

Cadenas y listas

ghci> "abc" == ['a','b','c']
True
length "abcde"              ==  5
reverse "abcde"             ==  "edcba"
"abcde" ++ "fg"             ==  "abcdefg"
posiciones 'a' "Salamanca"  ==  [1,3,5,8]  

Definiciones sobre cadenas con comprensión

minusculas "EstoEsUnaPrueba"  ==  "stosnarueba"
minusculas :: String -> String
minusculas xs = [x | x <- xs, elem x ['a'..'z']]
ocurrencias 'a' "Salamanca"  ==  4
ocurrencias :: Char -> String -> Int
ocurrencias x xs = length [x' | x' <- xs, x == x']  

5 Comprensión y dibujos

5.1 Círculos concéntricos

import CodeWorld

main :: IO ()
main = drawingOf circulosConcentricos

circulosConcentricos :: Picture
circulosConcentricos =
  pictures [circle x | x <- [1,2..9]]

5.2 Arcoiris

import CodeWorld

main :: IO()
main = drawingOf arcoiris

arcoiris :: Picture
arcoiris =
  translated 0 (-4) (pictures [ colored c (thickArc 1 0 pi r)
                              | (c,r) <- zip [ white
                                             , purple
                                             , light blue
                                             , blue
                                             , green
                                             , yellow
                                             , orange
                                             , red]
                                             [2..9]])

5.3 Círculos trasladados

import CodeWorld

main :: IO ()
main = drawingOf circulosTrasladados

circulosTrasladados :: Picture
circulosTrasladados =
  pictures [translated x 0 (circle 3) | x <- [-6..6]]

5.4 Circulos trasladados y ampliados

import CodeWorld

main :: IO ()
main = drawingOf circulosTrasladadosAmpliados

circulosTrasladadosAmpliados :: Picture
circulosTrasladadosAmpliados =
  translated (-8) 0 (pictures [translated x 0 (circle x) | x <- [1..8]])

5.5 Rectángulos girados

import CodeWorld

main :: IO ()
main = drawingOf cuadradosGirados

cuadradosGirados :: Picture
cuadradosGirados =
  pictures [rotated x (rectangle 12 12) | x <- [0,pi/18..pi/2]]

5.6 Círculos en cuadrado

import CodeWorld

main :: IO ()
main = drawingOf circulosEnCuadrado

circulosEnCuadrado :: Picture
circulosEnCuadrado =
  pictures [translated x y (circle 1)
           | x <- [-6,-3..6]
           , y <- [-6,-3..6]]

5.7 Círculos en estrella

import CodeWorld

main :: IO ()
main = drawingOf circulosEnEstrella

circulosEnEstrella :: Picture
circulosEnEstrella =
  pictures [rotated angulo (translated x 0 (circle 0.5))
           | x      <- [2,3.5..8]
           , angulo <- [0, pi/4..2*pi]]

5.8 Círculos expandiéndose

import CodeWorld

main :: IO ()
main = drawingOf circulosEnEstrella

circulosEnEstrella :: Picture
circulosEnEstrella =
  pictures [rotated angulo (translated x 0 (circle (x/5)))
           | x      <- [1..8]
           , angulo <- [0, pi/4..2*pi]]

5.9 Gráficas de funciones

import CodeWorld

main :: IO ()
main = drawingOf (graficaSeno <> coordinatePlane)

graficaSeno :: Picture
graficaSeno = curve [(x, x**2-8) | x <- [-4,-3.9..4]]

6 Cifrado César

6.1 Codificación y descodificación

Las funciones ord y char

ord 'a'  ==  97
ord 'b'  ==  98
ord 'A'  ==  65
chr 97  ==  'a'
chr 98  ==  'b'
chr 65  ==  'A'  

Codificación y descodificación: Código de letra

let2int 'a'  ==  0
let2int 'd'  ==  3
let2int 'z'  ==  25
let2int :: Char -> Int
let2int c = ord c - ord 'a'

Codificación y descodificación: Letra de código

int2let 0   ==  'a'
int2let 3   ==  'd'
int2let 25  ==  'z'
int2let :: Int -> Char
int2let n = chr (ord 'a' + n)

Codificación y descodificación: Desplazamiento

desplaza   3  'a'  ==  'd'
desplaza   3  'y'  ==  'b'
desplaza (-3) 'd'  ==  'a'
desplaza (-3) 'b'  ==  'y'
desplaza :: Int -> Char -> Char
desplaza n c 
    | elem c ['a'..'z'] = int2let ((let2int c+n) `mod` 26)
    | otherwise         = c

Codificación y descodificación

ghci> codifica   3  "En todo la medida" 
"Eq wrgr od phglgd"
ghci> codifica (-3) "Eq wrgr od phglgd"   
"En todo la medida"
codifica :: Int -> String -> String
codifica n xs = [desplaza n x | x <- xs]

Propiedades de la codificación con QuickCheck

prop_desplaza n xs = 
    desplaza (-n) (desplaza n xs) == xs
ghci> quickCheck prop_desplaza
+++ OK, passed 100 tests.
prop_codifica n xs = 
    codifica (-n) (codifica n xs) == xs
ghci> quickCheck prop_codifica
+++ OK, passed 100 tests.

6.2 Análisis de frecuencias

Tabla de frecuencias

tabla :: [Float]
tabla = [12.53, 1.42, 4.68, 5.86, 13.68, 0.69, 1.01, 
          0.70, 6.25, 0.44, 0.01,  4.97, 3.15, 6.71, 
          8.68, 2.51, 0.88, 6.87,  7.98, 4.63, 3.93, 
          0.90, 0.02, 0.22, 0.90,  0.52]

Frecuencias

porcentaje 2 5  ==  40.0  
porcentaje :: Int -> Int -> Float
porcentaje n m = (fromIntegral n / fromIntegral m) * 100
ghci> frecuencias "en todo la medida"
[14.3,0,0,21.4,14.3,0,0,0,7.1,0,0,7.1,
 7.1,7.1,14.3,0,0,0,0,7.1,0,0,0,0,0,0]
frecuencias :: String -> [Float]
frecuencias xs = 
    [porcentaje (ocurrencias x xs) n | x <- ['a'..'z']]
    where n = length (minusculas xs)

6.3 Descifrado

Descifrado: Ajuste chi cuadrado

chiCuad [3,5,6] [3,5,6]  ==  0.0
chiCuad [3,5,6] [5,6,3]  ==  3.9666667
chiCuad :: [Float] -> [Float] -> Float
chiCuad os es = 
    sum [((o-e)^2)/e | (o,e) <- zip os es]

Descifrado: Rotación

rota 2 "manolo"  ==  "noloma"  
rota :: Int -> [a] -> [a]
rota n xs = drop n xs ++ take n xs

Descifrado

ghci> codifica 5 "Todo para nada"
"Ttit ufwf sfif"
ghci> descifra "Ttit ufwf sfif"
"Todo para nada"
descifra :: String -> String
descifra xs =  codifica (-factor) xs
 where
  factor = head (posiciones (minimum tabChi) tabChi)
  tabChi = [chiCuad (rota n tabla') tabla | n <- [0..25]]
  tabla' = frecuencias xs

7 Bibliografía



Universidad de Sevilla

José A. Alonso Jiménez
Grupo de Lógica Computacional
Dpto. de Ciencias de la Computación e I.A.
Universidad de Sevilla