Recursión – Página 15

Siguiente elemento en una lista

PorJosé A. Alonso 2-febrero-201526-marzo-2022

Definir la función

   siguiente :: Eq a => a -> [a] -> Maybe a

1	siguiente :: Eq a => a -> [a] -> Maybe a

tal que (siguiente x ys) es justo el elemento siguiente a la primera ocurrencia de x en ys o Nothing si x no pertenece a ys. Por ejemplo,

   siguiente 5 [3,5,2,5,7]                       ==  Just 2
   siguiente 9 [3,5,2,5,7]                       ==  Nothing
   siguiente 'd' "afdegdb"                       ==  Just 'e'
   siguiente "todo" ["En","todo","la","medida"]  ==  Just "la"
   siguiente "nada" ["En","todo","la","medida"]  ==  Nothing
   siguiente 999999 [1..1000000]                 ==  Just 1000000
   siguiente 1000000 [1..1000000]                ==  Nothing

siguiente 5 [3,5,2,5,7] == Just 2

siguiente 9 [3,5,2,5,7] == Nothing

siguiente 'd' "afdegdb" == Just 'e'

siguiente "todo" ["En","todo","la","medida"] == Just "la"

siguiente "nada" ["En","todo","la","medida"] == Nothing

siguiente 999999 [1..1000000] == Just 1000000

siguiente 1000000 [1..1000000] == Nothing

Soluciones

import Data.Maybe (listToMaybe) -- Para la 4ª solución

-- 1ª solución (por recursión):
siguiente1 :: Eq a => a -> [a] -> Maybe a
siguiente1 x (y1:y2:ys) | x == y1   = Just y2
                        | otherwise = siguiente1 x (y2:ys)
siguiente1 x _ = Nothing

-- 2ª solución (por comprensión):
siguiente2 :: Eq a => a -> [a] -> Maybe a
siguiente2 x ys 
    | null zs   = Nothing
    | otherwise = Just (snd (head zs))
    where zs = [(u,v) | (u,v) <- zip ys (tail ys), u == x]  

-- 3ª solución (con dropWhile)
siguiente3 :: Eq a => a -> [a] -> Maybe a
siguiente3 x = aux . drop 1 . dropWhile (/=x)
    where aux []    = Nothing
          aux (y:_) = Just y

-- 4ª solución (con dropWhile y listToMaybe):
siguiente4 :: Eq a => a -> [a] -> Maybe a
siguiente4 x = listToMaybe . drop 1 . dropWhile (/=x)

-- Nota: En la librería Data.Maybe está definida la función 
--    listToMaybe :: [a] -> Maybe a 
-- tal que (listToMaybe xs) es Nothing si la lista xs está vacía y es
-- justo el primer elemento, en caso contrario, Por ejemplo,
--    listToMaybe []       ==  Nothing
--    listToMaybe [3,2,5]  ==  Just 3

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

-- La comparación es
--    ghci> let n=10^6 in siguiente1 (n-1) [1..n]
--    Just 1000000
--    (1.34 secs, 277352616 bytes)
--    
--    ghci> let n=10^6 in siguiente2 (n-1) [1..n]
--    Just 1000000
--    (1.45 secs, 340836576 bytes)
--    
--    ghci> let n=10^6 in siguiente3 (n-1) [1..n]
--    Just 1000000
--    (0.26 secs, 84987544 bytes)
--    
--    ghci> let n=10^6 in siguiente4 (n-1) [1..n]
--    Just 1000000
--    (0.26 secs, 84987440 bytes)

import Data.Maybe (listToMaybe) -- Para la 4ª solución

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

siguiente1 :: Eq a => a -> [a] -> Maybe a

siguiente1 x (y1:y2:ys) | x == y1 = Just y2

| otherwise = siguiente1 x (y2:ys)

siguiente1 x _ = Nothing

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

siguiente2 :: Eq a => a -> [a] -> Maybe a

siguiente2 x ys

| null zs = Nothing

| otherwise = Just (snd (head zs))

where zs = [(u,v) | (u,v) <- zip ys (tail ys), u == x]

-- 3ª solución (con dropWhile)

siguiente3 :: Eq a => a -> [a] -> Maybe a

siguiente3 x = aux . drop 1 . dropWhile (/=x)

where aux [] = Nothing

aux (y:_) = Just y

-- 4ª solución (con dropWhile y listToMaybe):

siguiente4 :: Eq a => a -> [a] -> Maybe a

siguiente4 x = listToMaybe . drop 1 . dropWhile (/=x)

-- Nota: En la librería Data.Maybe está definida la función

-- listToMaybe :: [a] -> Maybe a

-- tal que (listToMaybe xs) es Nothing si la lista xs está vacía y es

-- justo el primer elemento, en caso contrario, Por ejemplo,

-- listToMaybe [] == Nothing

-- listToMaybe [3,2,5] == Just 3

-- Comparación de eficiencia

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

-- La comparación es

-- ghci> let n=10^6 in siguiente1 (n-1) [1..n]

-- Just 1000000

-- (1.34 secs, 277352616 bytes)

-- ghci> let n=10^6 in siguiente2 (n-1) [1..n]

-- Just 1000000

-- (1.45 secs, 340836576 bytes)

-- ghci> let n=10^6 in siguiente3 (n-1) [1..n]

-- Just 1000000

-- (0.26 secs, 84987544 bytes)

-- ghci> let n=10^6 in siguiente4 (n-1) [1..n]

-- Just 1000000

-- (0.26 secs, 84987440 bytes)

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.

Particiones en listas de segmentos

PorJosé A. Alonso 27-enero-20153-febrero-2015

Exercitium

Definir la función

   particiones :: Int -> [a] -> [[[a]]]

1	particiones :: Int -> [a] -> [[[a]]]

tal que (particiones n xs) es la lista de listas de n elementos cuya concatenación es xs. Por ejemplo,

   ghci> particiones 2 "abc"
   [["","abc"],["a","bc"],["ab","c"],["abc",""]]
   ghci> particiones 3 "abc"
   [["","","abc"],["","a","bc"],["","ab","c"],["","abc",""],
    ["a","","bc"],["a","b","c"],["a","bc",""],["ab","","c"],
    ["ab","c",""],["abc","",""]]
   ghci> length (particiones 4 "abc")
   20

ghci> particiones 2 "abc"

[["","abc"],["a","bc"],["ab","c"],["abc",""]]

ghci> particiones 3 "abc"

[["","","abc"],["","a","bc"],["","ab","c"],["","abc",""],

["a","","bc"],["a","b","c"],["a","bc",""],["ab","","c"],

["ab","c",""],["abc","",""]]

ghci> length (particiones 4 "abc")

Soluciones

particiones :: Int -> [a] -> [[[a]]]
particiones 0 [] = [[]]
particiones 0 xs = []
particiones n xs = [ys:yss | (ys,zs) <- biparticiones xs,
                             yss <- particiones (n-1) zs]

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

particiones :: Int -> [a] -> [[[a]]]

particiones 0 [] = [[]]

particiones 0 xs = []

particiones n xs = [ys:yss | (ys,zs) <- biparticiones xs,

yss <- particiones (n-1) zs]

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

Sustitución de listas

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

Definir la función

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

1	sustituye :: Eq a => [a] -> [a] -> [a] -> [a]

tal que (sustituye xs ys zs) es la lista obtenida sustituyendo las ocurrencias de la lista no vacía xs en zs por ys. Por ejemplo,

   sustituye "as" "_" "las casaderas"   ==  "l_ c_ader_"
   sustituye "as" "es" "las casaderas"  ==  "les cesaderes"
   sustituye "asa" "a" "las casaderas"  ==  "las caderas"
   sustituye "asd" "a" "las casaderas"  ==  "las casaderas"

sustituye "as" "_" "las casaderas" == "l_ c_ader_"

sustituye "as" "es" "las casaderas" == "les cesaderes"

sustituye "asa" "a" "las casaderas" == "las caderas"

sustituye "asd" "a" "las casaderas" == "las casaderas"

Soluciones

import Data.List (isPrefixOf)

sustituye :: Eq a => [a] -> [a] -> [a] -> [a]
sustituye xs ys [] = []
sustituye xs ys (z:zs) 
    | isPrefixOf xs (z:zs) = ys ++ sustituye xs ys (drop n zs)
    | otherwise            = z : sustituye xs ys zs
    where n = length xs - 1

import Data.List (isPrefixOf)

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

sustituye xs ys [] = []

sustituye xs ys (z:zs)

| isPrefixOf xs (z:zs) = ys ++ sustituye xs ys (drop n zs)

| otherwise = z : sustituye xs ys zs

where n = length xs - 1

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.

Suma de una lista de vectores

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

Definir la función

   sumaVec :: Num a => [[a]] -> [a]

1	sumaVec :: Num a => [[a]] -> [a]

tal que (sumaVec xss) es la suma de los vectores de xss. Por ejemplo,

   sumaVec [[4,7,3],[3,1,4],[2,2,5]]  ==  [9,10,12]
   sumaVec [[4,7],[3,3],[1,4],[2,5]]  ==  [10,19]

1 2	sumaVec [[4,7,3],[3,1,4],[2,2,5]] == [9,10,12] sumaVec [[4,7],[3,3],[1,4],[2,5]] == [10,19]

Soluciones

import Data.List (transpose)
import Data.Array (listArray,(!))

-- 1ª definición (por recursión):
sumaVec1 :: Num a => [[a]] -> [a]
sumaVec1 []          = []
sumaVec1 [xs]        = xs
sumaVec1 (xs:ys:zss) = suma xs (sumaVec1 (ys:zss))

-- (suma xs ys) es la suma de los vectores xs e ys. Por ejemplo,
--    suma [4,7,3] [1,2,5]  == [5,9,8]
suma :: Num a => [a] -> [a] -> [a]
suma [] []         = []
suma (x:xs) (y:ys) = x+y : suma xs ys

-- 2ª definición (por recursión con zipWith): 
sumaVec2 :: Num a => [[a]] -> [a]
sumaVec2 []       = []
sumaVec2 [xs]     = xs
sumaVec2 (xs:xss) = zipWith (+) xs (sumaVec2 xss)

-- 3ª definición (por plegado)
sumaVec3 :: Num a => [[a]] -> [a]
sumaVec3 = foldr1 (zipWith (+))

-- 4ª definición (con map y transpose):
sumaVec4 :: Num a => [[a]] -> [a]
sumaVec4 = map sum . transpose 

-- 5ª definición (con array)
-- =========================

sumaVec5 :: Num a => [[a]] -> [a]
sumaVec5 xss = [sum [p!(i,j) | i <- [1..m]] | j <- [1..n]] 
    where m = length xss
          n = length (head xss)
          p = listArray ((1,1),(m,n)) (concat xss)

import Data.List (transpose)

import Data.Array (listArray,(!))

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

sumaVec1 :: Num a => [[a]] -> [a]

sumaVec1 [] = []

sumaVec1 [xs] = xs

sumaVec1 (xs:ys:zss) = suma xs (sumaVec1 (ys:zss))

-- (suma xs ys) es la suma de los vectores xs e ys. Por ejemplo,

-- suma [4,7,3] [1,2,5] == [5,9,8]

suma :: Num a => [a] -> [a] -> [a]

suma [] [] = []

suma (x:xs) (y:ys) = x+y : suma xs ys

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

sumaVec2 :: Num a => [[a]] -> [a]

sumaVec2 [] = []

sumaVec2 [xs] = xs

sumaVec2 (xs:xss) = zipWith (+) xs (sumaVec2 xss)

-- 3ª definición (por plegado)

sumaVec3 :: Num a => [[a]] -> [a]

sumaVec3 = foldr1 (zipWith (+))

-- 4ª definición (con map y transpose):

sumaVec4 :: Num a => [[a]] -> [a]

sumaVec4 = map sum . transpose

-- 5ª definición (con array)

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

sumaVec5 :: Num a => [[a]] -> [a]

sumaVec5 xss = [sum [p!(i,j) | i <- [1..m]] | j <- [1..n]]

where m = length xss

n = length (head xss)

p = listArray ((1,1),(m,n)) (concat xss)

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.

Mezcla de infinitas listas infinitas

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

Definir la función

   mezclaTodas :: Ord a => [[a]] -> [a]

1	mezclaTodas :: Ord a => [[a]] -> [a]

tal que (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como sus elementos son listas infinitas ordenadas. Por ejemplo,

   ghci> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])
   [2,3,4,5,6,7,8,9,10,11]
   ghci> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])
   [2,4,6,8,9,10,12,14,16,18]

ghci> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])

[2,3,4,5,6,7,8,9,10,11]

ghci> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])

[2,4,6,8,9,10,12,14,16,18]

Soluciones

mezclaTodas :: Ord a => [[a]] -> [a]
mezclaTodas = foldr1 xmezcla
    where xmezcla (x:xs) ys = x : mezcla xs ys

mezcla :: Ord a => [a] -> [a] -> [a]
mezcla (x:xs) (y:ys) | x < y  = x : mezcla xs (y:ys)
                     | x == y = x : mezcla xs ys
                     | x > y  = y : mezcla (x:xs) ys

mezclaTodas :: Ord a => [[a]] -> [a]

mezclaTodas = foldr1 xmezcla

where xmezcla (x:xs) ys = x : mezcla xs ys

mezcla :: Ord a => [a] -> [a] -> [a]

mezcla (x:xs) (y:ys) | x < y = x : mezcla xs (y:ys)

| x == y = x : mezcla xs ys

| x > y = y : mezcla (x:xs) ys

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)

Varios cuadrados encajados

PorJosé A. Alonso 6-enero-201513-enero-2015

Enunciado

Definir la función

   cuadrados :: Int -> Picture

1	cuadrados :: Int -> Picture

tal que (cuadrados n) dibuje n cuadrados encajados como se muestra en las siguientes figuras:

para n=2
para n=4
para n=10

Nota: Escribir las soluciones usando la siguiente plantilla

import Graphics.Gloss
import System.IO
    
main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  putStr "Introduce el numero de cuadrados [1..10]: "
  n <- readLn
  display (InWindow (show n ++ " cuadrados encajados" ) 
                    (600,600) (20,20)) white (cuadrados n)
    
cuadrados :: Int -> Picture
cuadrados n = undefined

import Graphics.Gloss

import System.IO

main :: IO ()

main = do

hSetBuffering stdout NoBuffering

putStr "Introduce el numero de cuadrados [1..10]: "

n <- readLn

display (InWindow (show n ++ " cuadrados encajados" )

(600,600) (20,20)) white (cuadrados n)

cuadrados :: Int -> Picture

cuadrados n = undefined

Soluciones

import Graphics.Gloss
import System.IO
    
main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  putStr "Introduce el numero de cuadrados [1..10]: "
  n <- readLn
  display (InWindow (show n ++ " cuadrados encajados" ) 
                    (600,600) (20,20)) white (cuadrados n)
    
-- 1ª solución (por comprensión):    
cuadrados :: Int -> Picture
cuadrados n = 
    pictures [scale (r^n) (r^n) $ rotate (g n) $ cuadrado | n <- [0..n-1]]
    where cuadrado        = rectangleWire 500 500
          g n | even n    = 0
              | otherwise = 45
          r               = 1 / sqrt 2

-- 2ª solución (por recursión):    
cuadrados2 :: Int -> Picture
cuadrados2 1 = rectangleWire 500 500
cuadrados2 n = 
    pictures [rectangleWire 500 500,
              rotate 45 $ scale (1/sqrt 2) (1/sqrt 2) (cuadrados2 (n-1))]

import Graphics.Gloss

import System.IO

main :: IO ()

main = do

hSetBuffering stdout NoBuffering

putStr "Introduce el numero de cuadrados [1..10]: "

n <- readLn

display (InWindow (show n ++ " cuadrados encajados" )

(600,600) (20,20)) white (cuadrados n)

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

cuadrados :: Int -> Picture

cuadrados n =

pictures [scale (r^n) (r^n) $ rotate (g n) $ cuadrado | n <- [0..n-1]]

where cuadrado = rectangleWire 500 500

g n | even n = 0

| otherwise = 45

r = 1 / sqrt 2

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

cuadrados2 :: Int -> Picture

cuadrados2 1 = rectangleWire 500 500

cuadrados2 n =

pictures [rectangleWire 500 500,

rotate 45 $ scale (1/sqrt 2) (1/sqrt 2) (cuadrados2 (n-1))]

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)

2015 y los números con factorización capicúa

PorJosé A. Alonso 1-enero-20151-mayo-2016

Un número tiene factorización capicúa si puede escribir como un producto de números primos tal que la concatenación de sus dígitos forma un número capicúa. Por ejemplo, el 2015 tiene factorización capicúa ya que 2015 = 13·5·31, los factores son primos y su concatenación es 13531 que es capicúa.

Definir la sucesión

   conFactorizacionesCapicuas :: [Int]

1	conFactorizacionesCapicuas :: [Int]

formada por los números que tienen factorización capicúa. Por ejemplo,

   ghci> take 20 conFactorizacionesCapicuas
   [1,2,3,4,5,7,8,9,11,12,16,18,20,25,27,28,32,36,39,44]

1 2	ghci> take 20 conFactorizacionesCapicuas [1,2,3,4,5,7,8,9,11,12,16,18,20,25,27,28,32,36,39,44]

Usando conFactorizacionesCapicuas escribir expresiones cuyos valores sean las respuestas a las siguientes preguntas y calcularlas

¿Qué lugar ocupa el 2015 en la sucesión?
¿Cuál fue el anterior año con factorización capicúa?
¿Cuál será el siguiente año con factorización capicúa?

Soluciones

import Data.List (permutations)

conFactorizacionesCapicuas :: [Int]
conFactorizacionesCapicuas =
    [n | n <- [1..], not (null (factorizacionesCapicua n))]

-- (factorizacionesCapicua n) es la lista de las factorizaciones
-- capicúas de n. Por ejemplo,
--    factorizacionesCapicua 2015  ==  [[13,5,31],[31,5,13]]
factorizacionesCapicua :: Int -> [[Int]]
factorizacionesCapicua n =
    [xs | xs <- permutations (factorizacion n),
          esCapicuaConcatenacion xs]

-- (factorizacion n) es la lista de todos los factores primos de n; es
-- decir, es una lista de números primos cuyo producto es n. Por ejemplo,
--    factorizacion 300  ==  [2,2,3,5,5]
factorizacion :: Int -> [Int]
factorizacion n | n == 1    = []
                | otherwise = x : factorizacion (div n x)
    where x = menorFactor n

-- (menorFactor n) es el menor factor primo de n. Por ejemplo,
--    menorFactor 15  ==  3
--    menorFactor 16  ==  2
--    menorFactor 17  == 17
menorFactor :: Int -> Int
menorFactor n = head [x | x <- [2..], rem n x == 0]

-- (esCapicuaConcatenacion xs) se verifica si la concatenación de los
-- números de xs es capicúa. Por ejemplo,
--    esCapicuaConcatenacion [13,5,31]   ==  True
--    esCapicuaConcatenacion [135,31]    ==  True
--    esCapicuaConcatenacion [135,21]    ==  False
esCapicuaConcatenacion :: [Int] -> Bool
esCapicuaConcatenacion xs = ys == reverse ys
    where ys = concat (map show xs)

-- El cálculo de la 1ª respuesta es
--    ghci> length (takeWhile (<= 2015) conFactorizacionesCapicuas)
--    265

-- El cálculo de la 2ª respuesta es
--    ghci> last (takeWhile (<2015) conFactorizacionesCapicuas)
--    2001

-- El cálculo de la 3ª respuesta es
--    ghci> head (dropWhile (<=2015) conFactorizacionesCapicuas)
--    2023

import Data.List (permutations)

conFactorizacionesCapicuas :: [Int]

conFactorizacionesCapicuas =

[n | n <- [1..], not (null (factorizacionesCapicua n))]

-- (factorizacionesCapicua n) es la lista de las factorizaciones

-- capicúas de n. Por ejemplo,

-- factorizacionesCapicua 2015 == [[13,5,31],[31,5,13]]

factorizacionesCapicua :: Int -> [[Int]]

factorizacionesCapicua n =

[xs | xs <- permutations (factorizacion n),

esCapicuaConcatenacion xs]

-- (factorizacion n) es la lista de todos los factores primos de n; es

-- decir, es una lista de números primos cuyo producto es n. Por ejemplo,

-- factorizacion 300 == [2,2,3,5,5]

factorizacion :: Int -> [Int]

factorizacion n | n == 1 = []

| otherwise = x : factorizacion (div n x)

where x = menorFactor n

-- (menorFactor n) es el menor factor primo de n. Por ejemplo,

-- menorFactor 15 == 3

-- menorFactor 16 == 2

-- menorFactor 17 == 17

menorFactor :: Int -> Int

menorFactor n = head [x | x <- [2..], rem n x == 0]

-- (esCapicuaConcatenacion xs) se verifica si la concatenación de los

-- números de xs es capicúa. Por ejemplo,

-- esCapicuaConcatenacion [13,5,31] == True

-- esCapicuaConcatenacion [135,31] == True

-- esCapicuaConcatenacion [135,21] == False

esCapicuaConcatenacion :: [Int] -> Bool

esCapicuaConcatenacion xs = ys == reverse ys

where ys = concat (map show xs)

-- El cálculo de la 1ª respuesta es

-- ghci> length (takeWhile (<= 2015) conFactorizacionesCapicuas)

-- 265

-- El cálculo de la 2ª respuesta es

-- ghci> last (takeWhile (<2015) conFactorizacionesCapicuas)

-- 2001

-- El cálculo de la 3ª respuesta es

-- ghci> head (dropWhile (<=2015) conFactorizacionesCapicuas)

-- 2023

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.

Fractal de la curva del dragón

PorJosé A. Alonso 18-diciembre-201427-diciembre-2014

La curva del dragón es un fractal que se construye siguiendo los siguientes pasos:

A partir de un segmento, se construye el triángulo rectángulo e isósceles, como lo muestra las dos primeras figuras. Luego se borra el segmento inicial.
Se repite varias veces el proceso de remplazar un segmento por otros dos para cada línea de la curva, alternando siempre la orientación de los triángulos.

La siguiente figura muestra los trece primeros pasos:

El ejercicio consiste en definir (en CodeWorld) la función

   dragon :: Number -> Picture

1	dragon :: Number -> Picture

tal que dragon(n) es el dibujo correspondiente al paso n de la construcción de la curva del dragón. Por ejemplo, el dibujo de dragon(20) es

Comentarios

La descripción de la curva dragón es la que se encuentra en el artículo de la Wikipedia.
Una definición análoga es la del fractal de la curva de Koch.

Soluciones

main = pictureOf(translate(dragon(20), 1, -2))

dragon :: Number -> Picture
dragon(0) = line[(-6, 0), (6, 0)]
dragon(n) = translate(rotate(sub, 45),  -3, 3) &
            translate(rotate(sub, 135), 3, 3)
  where sub = scale(dragon(n-1), 1 / sqrt(2), 1 / sqrt(2))

main = pictureOf(translate(dragon(20), 1, -2))

dragon :: Number -> Picture

dragon(0) = line[(-6, 0), (6, 0)]

dragon(n) = translate(rotate(sub, 45), -3, 3) &

translate(rotate(sub, 135), 3, 3)

where sub = scale(dragon(n-1), 1 / sqrt(2), 1 / sqrt(2))

Elementos adicionales

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

Enunciado

-- Definir la función
--    adicionales :: Ord a => Int -> [a] -> [a] -> [a]
-- tal que (adicionales n xs ys) es la lista de los n elementos de xs
-- que no pertenecen a ys (se supone que las listas xs e ys están
-- ordenadas y que pueden ser infinitas). Por ejemplo, 
--    adicionales 0 [1,3]   [1,3]                  ==  []
--    adicionales 1 [1,3]   [1]                    ==  [3]
--    adicionales 2 [1,3,5] [1]                    ==  [3,5]
--    adicionales 2 [1,3,5,7,9] [1,5,7]            ==  [3,9]
--    adicionales 2 ([1,3,5]++[7..]) ([1]++[7..])  ==  [3,5]

-- Definir la función

-- adicionales :: Ord a => Int -> [a] -> [a] -> [a]

-- tal que (adicionales n xs ys) es la lista de los n elementos de xs

-- que no pertenecen a ys (se supone que las listas xs e ys están

-- ordenadas y que pueden ser infinitas). Por ejemplo,

-- adicionales 0 [1,3] [1,3] == []

-- adicionales 1 [1,3] [1] == [3]

-- adicionales 2 [1,3,5] [1] == [3,5]

-- adicionales 2 [1,3,5,7,9] [1,5,7] == [3,9]

-- adicionales 2 ([1,3,5]++[7..]) ([1]++[7..]) == [3,5]

Soluciones

-- 1ª definición (por recursión)
adicionales1 :: Ord a => Int -> [a] -> [a] -> [a]
adicionales1 0 _  _  = []
adicionales1 _ xs [] = xs
adicionales1 n (x:xs) (y:ys) 
    | x <  y    = x : adicionales1 (n-1) xs (y:ys)
    | x == y    = adicionales1 n xs ys
    | otherwise = adicionales1 n (x:xs) ys

-- 2ª definición (por comprensión):
adicionales2 :: Ord a => Int -> [a] -> [a] -> [a]
adicionales2 n xs ys =
    take n [x | x <- xs, x `noPertenece` ys]

-- (noPertenece x ys) se verifica si x no pertenece a la lista ordenada 
-- (posiblemente infinita ys). Por ejemplo.
--    noPertenece 2 [3,5]    ==  True
--    noPertenece 4 [3,5]    ==  True
--    noPertenece 7 [3,5]    ==  True
--    noPertenece 4 [3,5..]  ==  True
noPertenece :: Ord a => a -> [a] -> Bool
noPertenece x ys = null zs || head zs /= x
    where zs = dropWhile (<x) ys

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

adicionales1 :: Ord a => Int -> [a] -> [a] -> [a]

adicionales1 0 _ _ = []

adicionales1 _ xs [] = xs

adicionales1 n (x:xs) (y:ys)

| x < y = x : adicionales1 (n-1) xs (y:ys)

| x == y = adicionales1 n xs ys

| otherwise = adicionales1 n (x:xs) ys

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

adicionales2 :: Ord a => Int -> [a] -> [a] -> [a]

adicionales2 n xs ys =

take n [x | x <- xs, x `noPertenece` ys]

-- (noPertenece x ys) se verifica si x no pertenece a la lista ordenada

-- (posiblemente infinita ys). Por ejemplo.

-- noPertenece 2 [3,5] == True

-- noPertenece 4 [3,5] == True

-- noPertenece 7 [3,5] == True

-- noPertenece 4 [3,5..] == True

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

noPertenece x ys = null zs || head zs /= x

where zs = dropWhile (<x) ys

Representaciones de matrices

PorJosé A. Alonso 16-diciembre-201427-diciembre-2014

Enunciado

-- Las matrices se pueden representar de distintas formas. Por ejemplo,
-- la matriz
--    |7 5 6|
--    |1 9 4|
-- se puede representar como la terna
--    ([7,5,6,1,9,4],2,3)
-- (donde la primera componente es la lista de los elementos de la
-- matriz, la segunda es su número de filas y la tercera es su número de
-- columnas) y también se puede representar como una lista de listas
--    [[[7,5,6],[1,9,4]]
-- (donde cada elemento es una de las filas de la matriz).
-- 
-- Definir las funciones
--    ternaAlistas :: ([a],Int,Int) -> [[a]]
--    listasAterna :: [[a]] -> ([a],Int,Int) 
-- tales que ternaAlistas pase de la primera representación a la
-- segunda y listasAterna pase de la segunda a la primera. Por ejemplo, 
--    ternaAlistas ([7,5,6,1,9,4],2,3)  ==  [[7,5,6],[1,9,4]]
--    listasAterna [[7,5,6],[1,9,4]]    ==  ([7,5,6,1,9,4],2,3)
--    ternaAlistas ([7,5,6,1,9,4],3,2)  ==  [[7,5],[6,1],[9,4]]
--    listasAterna [[7,5],[6,1],[9,4]]  ==  ([7,5,6,1,9,4],3,2)

-- Las matrices se pueden representar de distintas formas. Por ejemplo,

-- la matriz

-- |7 5 6|

-- |1 9 4|

-- se puede representar como la terna

-- ([7,5,6,1,9,4],2,3)

-- (donde la primera componente es la lista de los elementos de la

-- matriz, la segunda es su número de filas y la tercera es su número de

-- columnas) y también se puede representar como una lista de listas

-- [[[7,5,6],[1,9,4]]

-- (donde cada elemento es una de las filas de la matriz).

-- Definir las funciones

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

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

-- tales que ternaAlistas pase de la primera representación a la

-- segunda y listasAterna pase de la segunda a la primera. Por ejemplo,

-- ternaAlistas ([7,5,6,1,9,4],2,3) == [[7,5,6],[1,9,4]]

-- listasAterna [[7,5,6],[1,9,4]] == ([7,5,6,1,9,4],2,3)

-- ternaAlistas ([7,5,6,1,9,4],3,2) == [[7,5],[6,1],[9,4]]

-- listasAterna [[7,5],[6,1],[9,4]] == ([7,5,6,1,9,4],3,2)

Soluciones

ternaAlistas :: ([a],Int,Int) -> [[a]]
ternaAlistas (xs,n,m) = aux xs
    where aux [] = []
          aux xs = take m xs : aux (drop m xs)

listasAterna :: [[a]] -> ([a],Int,Int) 
listasAterna xss = (concat xss, length xss, length (head xss))

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

ternaAlistas (xs,n,m) = aux xs

where aux [] = []

aux xs = take m xs : aux (drop m xs)

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

listasAterna xss = (concat xss, length xss, length (head xss))

Permutación de elementos consecutivos

PorJosé A. Alonso 15-diciembre-201417-marzo-2019

-- Definir la función
--    permutaConsecutivos :: [a] -> [a]
-- tal que (permutaConsecutivos xs) es la lista obtenida permutando los
-- elementos consecutivos de xs. Por ejemplo,
--    permutaConsecutivos [1..8]         ==  [2,1,4,3,6,5,8,7]
--    permutaConsecutivos [1..9]         ==  [2,1,4,3,6,5,8,7,9]
--    permutaConsecutivos "simplemente"  ==  "ispmelemtne"

-- Definir la función

-- permutaConsecutivos :: [a] -> [a]

-- tal que (permutaConsecutivos xs) es la lista obtenida permutando los

-- elementos consecutivos de xs. Por ejemplo,

-- permutaConsecutivos [1..8] == [2,1,4,3,6,5,8,7]

-- permutaConsecutivos [1..9] == [2,1,4,3,6,5,8,7,9]

-- permutaConsecutivos "simplemente" == "ispmelemtne"

Soluciones

permutaConsecutivos :: [a] -> [a]
permutaConsecutivos (x:y:zs) = y : x : permutaConsecutivos zs
permutaConsecutivos xs       = xs

permutaConsecutivos :: [a] -> [a]

permutaConsecutivos (x:y:zs) = y : x : permutaConsecutivos zs

permutaConsecutivos xs = xs

Juego de bloques con letras

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

Introducción

Para el juego de los bloques se dispone de un conjunto de bloques con una letra en cada una de sus dos caras. El objetivo del juego consiste en formar palabras sin que se pueda usar un bloque más de una vez y sin diferenciar mayúsculas de minúsculas. Por ejemplo, si se tiene tres bloques de forma que el 1º tiene las letras A y B, el 2ª la N y la O y el 3º la O y la A entonces se puede obtener la palabra ANA de dos formas: una con los bloques 1, 2 y 3 y otra con los 3, 2 y 1.

Enunciado

-- Definir la función 
--    soluciones :: [String] -> String -> [[String]]
-- tal que (soluciones bs cs) es la lista de las soluciones del juego de
-- los bloque usando los bloques bs (cada bloque es una cadena de dos
-- letras mayúsculas) para formar la palabra cs. Por ejemplo,
--    ghci> soluciones ["AB","NO","OA"] "ANA"
--    [["AB","NO","OA"],["OA","NO","AB"]]
--    ghci> soluciones ["AB","NE","OA"] "Bea"
--    [["AB","NE","OA"]]
--    ghci> soluciones ["AB","NE","OA"] "EvA"
--    []
--    ghci> soluciones ["AB","NO","OA","NC"] "ANA"
--    [["AB","NO","OA"],["AB","NC","OA"],["OA","NO","AB"],["OA","NC","AB"]]
--    ghci> soluciones ["AB","NO","OA","NC"] "Anca"
--    [["AB","NO","NC","OA"],["OA","NO","NC","AB"]]

-- Definir la función

-- soluciones :: [String] -> String -> [[String]]

-- tal que (soluciones bs cs) es la lista de las soluciones del juego de

-- los bloque usando los bloques bs (cada bloque es una cadena de dos

-- letras mayúsculas) para formar la palabra cs. Por ejemplo,

-- ghci> soluciones ["AB","NO","OA"] "ANA"

-- [["AB","NO","OA"],["OA","NO","AB"]]

-- ghci> soluciones ["AB","NE","OA"] "Bea"

-- [["AB","NE","OA"]]

-- ghci> soluciones ["AB","NE","OA"] "EvA"

-- []

-- ghci> soluciones ["AB","NO","OA","NC"] "ANA"

-- [["AB","NO","OA"],["AB","NC","OA"],["OA","NO","AB"],["OA","NC","AB"]]

-- ghci> soluciones ["AB","NO","OA","NC"] "Anca"

-- [["AB","NO","NC","OA"],["OA","NO","NC","AB"]]

Soluciones

import Data.List (delete)
import Data.Char (toUpper)

soluciones :: [String] -> String -> [[String]]
soluciones _ []      = [[]]
soluciones bs (c:cs) = [b:rs | b <- bs, 
                               toUpper c `elem` b,
                               rs <- soluciones (delete b bs) cs]

import Data.List (delete)

import Data.Char (toUpper)

soluciones :: [String] -> String -> [[String]]

soluciones _ [] = [[]]

soluciones bs (c:cs) = [b:rs | b <- bs,

toUpper c `elem` b,

rs <- soluciones (delete b bs) cs]

Números que sumados a su siguiente primo dan primos

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

Introducción

La Enciclopedia electrónica de sucesiones de enteros (OEIS por sus siglas en inglés, de On-Line Encyclopedia of Integer Sequences) es una base de datos que registra sucesiones de números enteros. Está disponible libremente en Internet, en la dirección http://oeis.org.

La semana pasada Antonio Roldán añadió una nueva sucesión a la OEIS, la A249624 que sirve de base para el problema de hoy.

Enunciado

-- Definir la sucesión
--     a249624 :: [Integer]
-- tal que sus elementos son los números x tales que la suma de x y el
-- primo que le sigue es un número primo. Por ejemplo, 
--    ghci> take 20 a249624
--    [0,1,2,6,8,14,18,20,24,30,34,36,38,48,50,54,64,68,78,80]
-- 
-- El número 8 está en la sucesión porque su siguiente primo es 11 y
-- 8+11=19 es primo. El 12 no está en la sucesión porque su siguiente
-- primo es 13 y 12+13=25 no es primo.

-- Definir la sucesión

-- a249624 :: [Integer]

-- tal que sus elementos son los números x tales que la suma de x y el

-- primo que le sigue es un número primo. Por ejemplo,

-- ghci> take 20 a249624

-- [0,1,2,6,8,14,18,20,24,30,34,36,38,48,50,54,64,68,78,80]

-- El número 8 está en la sucesión porque su siguiente primo es 11 y

-- 8+11=19 es primo. El 12 no está en la sucesión porque su siguiente

-- primo es 13 y 12+13=25 no es primo.

Soluciones

import Data.Numbers.Primes (primes, isPrime)
import Data.List (genericReplicate)

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

a249624 :: [Integer]
a249624 = 0: 1: [x | x <- [2,4..], primo (x + siguientePrimo x)]

primo :: Integer -> Bool
primo x = [y | y <- [1..x], x `rem` y == 0] == [1,x]

siguientePrimo :: Integer -> Integer
siguientePrimo x = head [y | y <- [x+1..], primo y]

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

a249624b :: [Integer]
a249624b = 0 : 1 : 2: aux [2,4..] primos where
    aux (x:xs) (y:ys) 
        | y < x                = aux (x:xs) ys
        | (x+y) `pertenece` ys = x : aux xs (y:ys)
        | otherwise            = aux xs (y:ys)
    pertenece x ys = x == head (dropWhile (<x) ys)

primos :: [Integer]
primos = 2 : [x | x <- [3,5..], primo x]

-- 3ª definición (con la librería de primos)
-- =========================================

a249624c :: [Integer]
a249624c = 0: 1: [x | x <- [2,4..], isPrime (x + siguientePrimo3 x)]

siguientePrimo3 x = head [y | y <- [x+1..], isPrime y]

-- 4ª definición (por recursión con la librería de primos)
-- =======================================================

a249624d :: [Integer]
a249624d = 0 : 1 : 2: aux [2,4..] primes where
    aux (x:xs) (y:ys) 
        | y < x                = aux (x:xs) ys
        | (x+y) `pertenece` ys = x : aux xs (y:ys)
        | otherwise            = aux xs (y:ys)
    pertenece x ys = x == head (dropWhile (<x) ys)

-- 5ª definición
-- =============

a249624e :: [Integer]
a249624e = [a | q <- primes, 
                let p = siguientePrimo3 (q `div` 2),
                let a = q-p,
                siguientePrimo3 a == p]

-- 6ª definición
-- =============

a249624f :: [Integer]
a249624f = [x | (x,y) <- zip [0..] ps, isPrime (x+y)]
    where ps = 2:2:concat (zipWith f primes (tail primes))
          f p q = genericReplicate (q-p) q

-- 7ª definición
-- =============

a249624g :: [Integer]
a249624g = 0:1:(aux primes (tail primes) primes)
    where aux (x:xs) (y:ys) zs
              | null rs   = aux xs ys zs2
              | otherwise = [r-y | r <- rs] ++ (aux xs ys zs2)
              where a = x+y
                    b = 2*y-1
                    zs1 = takeWhile (<=b) zs
                    rs = [r | r <- [a..b], r `elem` zs1]
                    zs2 = dropWhile (<=b) zs

-- ---------------------------------------------------------------------
-- § Comparación de eficiencia                                        --
-- ---------------------------------------------------------------------

-- La comparación es
--    ghci> :set +s
--    
--    ghci> a249624 !! 700
--    5670
--    (12.72 secs, 1245938184 bytes)
--    
--    ghci> a249624b !! 700
--    5670
--    (8.01 secs, 764775268 bytes)
-- 
--    ghci> a249624c !! 700
--    5670
--    (0.22 secs, 108982640 bytes)
--    
--    ghci> a249624d !! 700
--    5670
--    (0.20 secs, 4707384 bytes)
--    
--    ghci> a249624e !! 700
--    5670
--    (0.17 secs, 77283064 bytes)
--    
--    ghci> a249624f !! 700
--    5670
--    (0.08 secs, 31684408 bytes)
--    
--    ghci> a249624g !! 700
--    5670
--    (0.03 secs, 4651576 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

import Data.Numbers.Primes (primes, isPrime)

import Data.List (genericReplicate)

-- 1ª definición

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

a249624 :: [Integer]

a249624 = 0: 1: [x | x <- [2,4..], primo (x + siguientePrimo x)]

primo :: Integer -> Bool

primo x = [y | y <- [1..x], x `rem` y == 0] == [1,x]

siguientePrimo :: Integer -> Integer

siguientePrimo x = head [y | y <- [x+1..], primo y]

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

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

a249624b :: [Integer]

a249624b = 0 : 1 : 2: aux [2,4..] primos where

aux (x:xs) (y:ys)

| y < x = aux (x:xs) ys

| (x+y) `pertenece` ys = x : aux xs (y:ys)

| otherwise = aux xs (y:ys)

pertenece x ys = x == head (dropWhile (<x) ys)

primos :: [Integer]

primos = 2 : [x | x <- [3,5..], primo x]

-- 3ª definición (con la librería de primos)

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

a249624c :: [Integer]

a249624c = 0: 1: [x | x <- [2,4..], isPrime (x + siguientePrimo3 x)]

siguientePrimo3 x = head [y | y <- [x+1..], isPrime y]

-- 4ª definición (por recursión con la librería de primos)

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

a249624d :: [Integer]

a249624d = 0 : 1 : 2: aux [2,4..] primes where

aux (x:xs) (y:ys)

| y < x = aux (x:xs) ys

| (x+y) `pertenece` ys = x : aux xs (y:ys)

| otherwise = aux xs (y:ys)

pertenece x ys = x == head (dropWhile (<x) ys)

-- 5ª definición

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

a249624e :: [Integer]

a249624e = [a | q <- primes,

let p = siguientePrimo3 (q `div` 2),

let a = q-p,

siguientePrimo3 a == p]

-- 6ª definición

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

a249624f :: [Integer]

a249624f = [x | (x,y) <- zip [0..] ps, isPrime (x+y)]

where ps = 2:2:concat (zipWith f primes (tail primes))

f p q = genericReplicate (q-p) q

-- 7ª definición

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

a249624g :: [Integer]

a249624g = 0:1:(aux primes (tail primes) primes)

where aux (x:xs) (y:ys) zs

| null rs = aux xs ys zs2

| otherwise = [r-y | r <- rs] ++ (aux xs ys zs2)

where a = x+y

b = 2*y-1

zs1 = takeWhile (<=b) zs

rs = [r | r <- [a..b], r `elem` zs1]

zs2 = dropWhile (<=b) zs

-- ---------------------------------------------------------------------

-- § Comparación de eficiencia --

-- ---------------------------------------------------------------------

-- La comparación es

-- ghci> :set +s

-- ghci> a249624 !! 700

-- 5670

-- (12.72 secs, 1245938184 bytes)

-- ghci> a249624b !! 700

-- 5670

-- (8.01 secs, 764775268 bytes)

-- ghci> a249624c !! 700

-- 5670

-- (0.22 secs, 108982640 bytes)

-- ghci> a249624d !! 700

-- 5670

-- (0.20 secs, 4707384 bytes)

-- ghci> a249624e !! 700

-- 5670

-- (0.17 secs, 77283064 bytes)

-- ghci> a249624f !! 700

-- 5670

-- (0.08 secs, 31684408 bytes)

-- ghci> a249624g !! 700

-- 5670

-- (0.03 secs, 4651576 bytes)

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)

Llanuras de longitud dada

PorJosé A. Alonso 4-diciembre-20141-mayo-2016

Enunciado

-- Una llanura de longitud n de una lista xs es una sublista de xs
-- formada por n elementos iguales.
--
-- Definir la función
--    llanuras :: Eq a => Int -> [a] -> [[a]]
-- tal que (llanuras n xs) es la lista de las llanuras de xs que tienen
-- n elementos como mínimo. Por ejemplo,
--    llanuras 3 "aabbbcddddffxffxx"  ==  ["bbb","dddd"]

-- Una llanura de longitud n de una lista xs es una sublista de xs

-- formada por n elementos iguales.

-- Definir la función

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

-- tal que (llanuras n xs) es la lista de las llanuras de xs que tienen

-- n elementos como mínimo. Por ejemplo,

-- llanuras 3 "aabbbcddddffxffxx" == ["bbb","dddd"]

Soluciones

import Data.List (group)
import Test.QuickCheck

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

-- 2ª definición (por recursión con takeWhile y dropWhile):
llanuras2 :: Eq a => Int -> [a] -> [[a]]
llanuras2 _ [] = []
llanuras2 n xs@(x:_) 
    | length ys >= n = ys : llanuras2 n (dropWhile (x==) xs) 
    | otherwise      = llanuras2 n (dropWhile (x==) xs) 
    where ys = takeWhile (x==) xs

-- 3ª definición (por recursión con span):
llanuras3 :: Eq a => Int -> [a] -> [[a]]
llanuras3 _ [] = []
llanuras3 n xs@(x:_) 
    | length ys >= n = ys : llanuras3 n zs
    | otherwise      = llanuras3 n zs
    where (ys,zs) = span (x==) xs

-- 4ª definición (por recursión con span):
llanuras4 :: Eq a => Int -> [a] -> [[a]]
llanuras4 n = aux where
    aux [] = []
    aux xs@(x:_) | length ys >= n = ys : llanuras4 n zs
                 | otherwise      = llanuras4 n zs
                 where (ys,zs) = span (x==) xs

-- ---------------------------------------------------------------------
-- § Verificación                                                     --
-- ---------------------------------------------------------------------

-- Las definiciones son equivalentes
prop_equivalencia :: Int -> [Int] -> Bool
prop_equivalencia n xs =
    llanuras2 n xs == ys &&
    llanuras3 n xs == ys
    where ys = llanuras n xs

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

import Data.List (group)

import Test.QuickCheck

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

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

llanuras n xs = [ys | ys <- group xs, length ys >= n]

-- 2ª definición (por recursión con takeWhile y dropWhile):

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

llanuras2 _ [] = []

llanuras2 n xs@(x:_)

| length ys >= n = ys : llanuras2 n (dropWhile (x==) xs)

| otherwise = llanuras2 n (dropWhile (x==) xs)

where ys = takeWhile (x==) xs

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

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

llanuras3 _ [] = []

llanuras3 n xs@(x:_)

| length ys >= n = ys : llanuras3 n zs

| otherwise = llanuras3 n zs

where (ys,zs) = span (x==) xs

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

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

llanuras4 n = aux where

aux [] = []

aux xs@(x:_) | length ys >= n = ys : llanuras4 n zs

| otherwise = llanuras4 n zs

where (ys,zs) = span (x==) xs

-- ---------------------------------------------------------------------

-- § Verificación --

-- ---------------------------------------------------------------------

-- Las definiciones son equivalentes

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

prop_equivalencia n xs =

llanuras2 n xs == ys &&

llanuras3 n xs == ys

where ys = llanuras n xs

-- La comprobación es

-- ghci> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

Referencias

Esté ejercicio está basado en el problema Llanura de números iguales con longitud igual a n propuesto Solveet!

Expresiones vectoriales

PorJosé A. Alonso 3-diciembre-201427-diciembre-2014

Enunciado

-- El siguiente tipo de dato define representa las expresiones
-- vectoriales formadas por un vector, la suma de dos expresiones
-- vectoriales o el producto de un entero por una expresión vectorial. 
--    data ExpV = Vec Int Int
--              | Sum ExpV ExpV
--              | Mul Int ExpV
--              deriving Show
-- 
-- Definir la función 
--    valor :: ExpV -> (Int,Int)
-- tal que (valor e) es el valor de la expresión vectorial c. Por
-- ejemplo, 
--    valor (Vec 1 2)                                  ==  (1,2)
--    valor (Sum (Vec 1 2 ) (Vec 3 4))                 ==  (4,6)
--    valor (Mul 2 (Vec 3 4))                          ==  (6,8)
--    valor (Mul 2 (Sum (Vec 1 2 ) (Vec 3 4)))         ==  (8,12)
--    valor (Sum (Mul 2 (Vec 1 2)) (Mul 2 (Vec 3 4)))  ==  (8,12)

-- El siguiente tipo de dato define representa las expresiones

-- vectoriales formadas por un vector, la suma de dos expresiones

-- vectoriales o el producto de un entero por una expresión vectorial.

-- data ExpV = Vec Int Int

-- | Sum ExpV ExpV

-- | Mul Int ExpV

-- deriving Show

-- Definir la función

-- valor :: ExpV -> (Int,Int)

-- tal que (valor e) es el valor de la expresión vectorial c. Por

-- ejemplo,

-- valor (Vec 1 2) == (1,2)

-- valor (Sum (Vec 1 2 ) (Vec 3 4)) == (4,6)

-- valor (Mul 2 (Vec 3 4)) == (6,8)

-- valor (Mul 2 (Sum (Vec 1 2 ) (Vec 3 4))) == (8,12)

-- valor (Sum (Mul 2 (Vec 1 2)) (Mul 2 (Vec 3 4))) == (8,12)

data ExpV = Vec Int Int
          | Sum ExpV ExpV
          | Mul Int ExpV
          deriving Show

-- 1ª solución
-- ===========
valor :: ExpV -> (Int,Int)
valor (Vec x y)   = (x,y)
valor (Sum e1 e2) = (x1+x2,y1+y2) where (x1,y1) = valor e1  
                                        (x2,y2) = valor e2  
valor (Mul n e)   = (n*x,n*y) where (x,y) = valor e  

-- 2ª solución
-- ===========
valor2 :: ExpV -> (Int,Int)
valor2 (Vec a b)   = (a, b)
valor2 (Sum e1 e2) = suma (valor2 e1) (valor2 e2)
valor2 (Mul n e1)  = multiplica n (valor2 e1)

suma :: (Int,Int) -> (Int,Int) -> (Int,Int)
suma (a,b) (c,d) = (a+c,b+d)

multiplica :: Int -> (Int, Int) -> (Int, Int)
multiplica n (a,b) = (n*a,n*b)

data ExpV = Vec Int Int

| Sum ExpV ExpV

| Mul Int ExpV

deriving Show

-- 1ª solución

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

valor :: ExpV -> (Int,Int)

valor (Vec x y) = (x,y)

valor (Sum e1 e2) = (x1+x2,y1+y2) where (x1,y1) = valor e1

(x2,y2) = valor e2

valor (Mul n e) = (n*x,n*y) where (x,y) = valor e

-- 2ª solución

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

valor2 :: ExpV -> (Int,Int)

valor2 (Vec a b) = (a, b)

valor2 (Sum e1 e2) = suma (valor2 e1) (valor2 e2)

valor2 (Mul n e1) = multiplica n (valor2 e1)

suma :: (Int,Int) -> (Int,Int) -> (Int,Int)

suma (a,b) (c,d) = (a+c,b+d)

multiplica :: Int -> (Int, Int) -> (Int, Int)

multiplica n (a,b) = (n*a,n*b)

Expresiones aritmética normalizadas

PorJosé A. Alonso 2-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
-- 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 las funciones 
--    esTermino, esNormal :: Expr -> Bool
-- tales que
-- + (esTermino a) se verifica si a es un término. Por ejemplo,
--      esTermino (V "x")                                    == True
--      esTermino (P (V "x") (P (V "y") (V "z")))            == True
--      esTermino (P (V "x") (S (V "y") (V "z")))            == False
--      esTermino (S (V "x") (P (V "y") (V "z")))            == False
-- + (esNormal a) se verifica si a está en forma normal. Por ejemplo,
--      esNormal (V "x")                                     == True
--      esNormal (P (V "x") (P (V "y") (V "z")))             == True
--      esNormal (S (V "x") (P (V "y") (V "z")))             == True
--      esNormal (P (V "x") (S (V "y") (V "z")))             == False
--      esNormal (P (S (V "x") (V "y")) (S (V "y") (V "z"))) == False

-- El siguiente tipo de dato representa expresiones construidas con

-- variables, sumas y productos

-- data Expr = V String

-- | S Expr Expr

-- | P Expr Expr

-- 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 las funciones

-- esTermino, esNormal :: Expr -> Bool

-- tales que

-- + (esTermino a) se verifica si a es un término. Por ejemplo,

-- esTermino (V "x") == True

-- esTermino (P (V "x") (P (V "y") (V "z"))) == True

-- esTermino (P (V "x") (S (V "y") (V "z"))) == False

-- esTermino (S (V "x") (P (V "y") (V "z"))) == False

-- + (esNormal a) se verifica si a está en forma normal. Por ejemplo,

-- esNormal (V "x") == True

-- esNormal (P (V "x") (P (V "y") (V "z"))) == True

-- esNormal (S (V "x") (P (V "y") (V "z"))) == True

-- esNormal (P (V "x") (S (V "y") (V "z"))) == False

-- esNormal (P (S (V "x") (V "y")) (S (V "y") (V "z"))) == False

Soluciones

data Expr = V String
          | S Expr Expr
          | P Expr Expr

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

data Expr = V String

| S Expr Expr

| P Expr Expr

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

Particiones de longitud fija

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

Enunciado

-- Definir la función 
--    particionesFijas :: Int -> Int -> [[Int]]
-- tal que (particionesFijas n k) es la lista de listas de k números
-- naturales no crecientes cuya suma es n. Por ejemplo,
--    ghci> particionesFijas 8 3
--    [[3,3,2],[4,2,2],[4,3,1],[5,2,1],[6,1,1]]

-- Definir la función

-- particionesFijas :: Int -> Int -> [[Int]]

-- tal que (particionesFijas n k) es la lista de listas de k números

-- naturales no crecientes cuya suma es n. Por ejemplo,

-- ghci> particionesFijas 8 3

-- [[3,3,2],[4,2,2],[4,3,1],[5,2,1],[6,1,1]]

Soluciones

-- 1ª definición
particionesFijas :: Int -> Int -> [[Int]]
particionesFijas n 1 = [[n]]
particionesFijas n k 
    | k < 1     = []
    | otherwise = [x:y:ys | x <- [1..n-1], 
                            (y:ys) <- particionesFijas (n-x) (k-1),
                            x >= y]

-- 2ª definición
particionesFijas2 :: Int -> Int -> [[Int]]
particionesFijas2 n k
    | k <= 0    = []
    | k == 1    = [[n]]
    | k == n    = [replicate k 1]
    | k > n     = []
    | otherwise = [xs ++ [1] | xs <- particionesFijas2 (n-1) (k-1)] ++
                  [[x+1 | x <- xs] | xs <- particionesFijas2 (n-k) k]

-- Comparación:
--    ghci> length (particionesFijas 800 3)
--    53333
--    (1.01 secs, 97696476 bytes)
--    
--    ghci> length (particionesFijas2 800 3)
--    53333
--    (4.52 secs, 693969028 bytes)

-- 1ª definición

particionesFijas :: Int -> Int -> [[Int]]

particionesFijas n 1 = [[n]]

particionesFijas n k

| k < 1 = []

| otherwise = [x:y:ys | x <- [1..n-1],

(y:ys) <- particionesFijas (n-x) (k-1),

x >= y]

-- 2ª definición

particionesFijas2 :: Int -> Int -> [[Int]]

particionesFijas2 n k

| k <= 0 = []

| k == 1 = [[n]]

| k == n = [replicate k 1]

| k > n = []

| otherwise = [xs ++ [1] | xs <- particionesFijas2 (n-1) (k-1)] ++

[[x+1 | x <- xs] | xs <- particionesFijas2 (n-k) k]

-- Comparación:

-- ghci> length (particionesFijas 800 3)

-- 53333

-- (1.01 secs, 97696476 bytes)

-- ghci> length (particionesFijas2 800 3)

-- 53333

-- (4.52 secs, 693969028 bytes)

Evaluación de árboles de expresiones aritméticas

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

Enunciado

-- Las expresiones aritméticas se pueden representar como árboles con
-- números en las hojas y operaciones en los nodos. Por ejemplo, la
-- expresión "9-2*4" se puede representar por el árbol
--      - 
--     / \
--    9   *
--       / \
--      2   4
-- 
-- Definiendo el tipo de dato Arbol por 
--    data Arbol = H Int | N (Int -> Int -> Int) Arbol Arbol
-- la representación del árbol anterior es
--    N (-) (H 9) (N (*) (H 2) (H 4))
--
-- Definir la función
--    valor :: Arbol -> Int
-- tal que (valor a) es el valor de la expresión aritmética
-- correspondiente al árbol a. Por ejemplo,
--    valor (N (-) (H 9) (N (*) (H 2) (H 4)))    ==  1
--    valor (N (+) (H 9) (N (*) (H 2) (H 4)))    ==  17
--    valor (N (+) (H 9) (N (div) (H 4) (H 2)))  ==  11
--    valor (N (+) (H 9) (N (max) (H 4) (H 2)))  ==  13

-- Las expresiones aritméticas se pueden representar como árboles con

-- números en las hojas y operaciones en los nodos. Por ejemplo, la

-- expresión "9-2*4" se puede representar por el árbol

-- -

-- / \

-- 9 *

-- / \

-- 2 4

-- Definiendo el tipo de dato Arbol por

-- data Arbol = H Int | N (Int -> Int -> Int) Arbol Arbol

-- la representación del árbol anterior es

-- N (-) (H 9) (N (*) (H 2) (H 4))

-- Definir la función

-- valor :: Arbol -> Int

-- tal que (valor a) es el valor de la expresión aritmética

-- correspondiente al árbol a. Por ejemplo,

-- valor (N (-) (H 9) (N (*) (H 2) (H 4))) == 1

-- valor (N (+) (H 9) (N (*) (H 2) (H 4))) == 17

-- valor (N (+) (H 9) (N (div) (H 4) (H 2))) == 11

-- valor (N (+) (H 9) (N (max) (H 4) (H 2))) == 13

Soluciones

data Arbol = H Int | N (Int -> Int -> Int) Arbol Arbol

valor :: Arbol -> Int
valor (H x)     = x
valor (N f i d) = f (valor i) (valor d)

data Arbol = H Int | N (Int -> Int -> Int) Arbol Arbol

valor :: Arbol -> Int

valor (H x) = x

valor (N f i d) = f (valor i) (valor d)

Aplicaciones alternativas

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

Enunciado

-- Definir la función
--    alternativa :: (a -> b) -> (a -> b) -> [a] -> [b]
-- tal que (alternativa f g xs) es la lista obtenida aplicando
-- alternativamente las funciones f y g a los elementos de xs. Por
-- ejemplo, 
--    alternativa (+1)  (+10) [1,2,3,4]    ==  [2,12,4,14]
--    alternativa (+10) (*10) [1,2,3,4,5]  ==  [11,20,13,40,15]

-- Definir la función

-- alternativa :: (a -> b) -> (a -> b) -> [a] -> [b]

-- tal que (alternativa f g xs) es la lista obtenida aplicando

-- alternativamente las funciones f y g a los elementos de xs. Por

-- ejemplo,

-- alternativa (+1) (+10) [1,2,3,4] == [2,12,4,14]

-- alternativa (+10) (*10) [1,2,3,4,5] == [11,20,13,40,15]

Soluciones

[schedule expon=’2014-12-03′ expat=»06:00″]

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

[/schedule]

[schedule on=’2014-12-03′ at=»06:00″]

-- 1ª definición (por recursión):
alternativa1 :: (a -> b) -> (a -> b) -> [a] -> [b]
alternativa1 f g []     = []
alternativa1 f g (x:xs) = f x : alternativa1 g f xs

-- 2ª definición (por comprensión):
alternativa2 :: (a -> b) -> (a -> b) -> [a] -> [b]
alternativa2 f g xs = 
    [h x | (h,x) <- zip (cycle [f,g]) xs]

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

alternativa1 :: (a -> b) -> (a -> b) -> [a] -> [b]

alternativa1 f g [] = []

alternativa1 f g (x:xs) = f x : alternativa1 g f xs

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

alternativa2 :: (a -> b) -> (a -> b) -> [a] -> [b]

alternativa2 f g xs =

[h x | (h,x) <- zip (cycle [f,g]) xs]

[/schedule]

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.

Elemento común en la menor posición

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

Enunciado

-- Definir la función
--    elemento :: Eq a => [a] -> [a] -> [a]
-- tal que (elemento xs ys) es la lista formada por el elemento común a
-- xs e ys con la menor posición. Por ejemplo.
--    elemento [3,7,6,9,8,0] [5,4,2,7,8,6,9]  ==  [7]
--    elemento [3,7,6,9] [9,5,6]              ==  [9]
--    elemento [5,3,6] [7,6,3]                ==  [3]
--    elemento [3,7,6,3,8,0] [5,4,9,1,4,2,1]  ==  []
--    elemento [2,3,5] [7,4]                  ==  []
--
-- Nota: Como se observa en el 3ª ejemplo, en el caso de que un elemento
-- x de xs pertenezca a ys y el elemento de ys en la misma posición que
-- x pertenezca a xs, se elige como el de menor posición el de xs.

-- Definir la función

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

-- tal que (elemento xs ys) es la lista formada por el elemento común a

-- xs e ys con la menor posición. Por ejemplo.

-- elemento [3,7,6,9,8,0] [5,4,2,7,8,6,9] == [7]

-- elemento [3,7,6,9] [9,5,6] == [9]

-- elemento [5,3,6] [7,6,3] == [3]

-- elemento [3,7,6,3,8,0] [5,4,9,1,4,2,1] == []

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

-- Nota: Como se observa en el 3ª ejemplo, en el caso de que un elemento

-- x de xs pertenezca a ys y el elemento de ys en la misma posición que

-- x pertenezca a xs, se elige como el de menor posición el de xs.

Soluciones

[schedule expon=’2014-12-01′ expat=»06:00″]

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

[/schedule]

[schedule on=’2014-12-01′ at=»06:00″]

import Test.QuickCheck

-- 1ª definición:
elemento1 :: Eq a => [a] -> [a] -> [a]
elemento1 p@(x:xs) q@(y:ys)
    | x `elem` q  = [x]
    | y `elem` xs = [y]
    | otherwise   = elemento1 xs ys
elemento1 _ _ = []

-- 2ª definición:
elemento2 :: Eq a => [a] -> [a] -> [a]
elemento2 [] _ = []
elemento2 (x:xs) ys
    | x `elem` ys = [x]
    | otherwise   = elemento2 ys xs

-- Propiedad de equivalencia de las definiciones
prop_elemento :: [Int] -> [Int] -> Bool
prop_elemento xs ys =
    elemento1 xs ys == elemento2 xs ys

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

import Test.QuickCheck

-- 1ª definición:

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

elemento1 p@(x:xs) q@(y:ys)

| x `elem` q = [x]

| y `elem` xs = [y]

| otherwise = elemento1 xs ys

elemento1 _ _ = []

-- 2ª definición:

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

elemento2 [] _ = []

elemento2 (x:xs) ys

| x `elem` ys = [x]

| otherwise = elemento2 ys xs

-- Propiedad de equivalencia de las definiciones

prop_elemento :: [Int] -> [Int] -> Bool

prop_elemento xs ys =

elemento1 xs ys == elemento2 xs ys

-- La comprobación es

-- ghci> quickCheck prop_elemento

-- +++ OK, passed 100 tests.

...

[/schedule]

Cuantificadores sobre listas

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

Enunciado

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

-- Definir la función

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

-- tal que (verificaP p xs) se verifica si cada elemento de la lista xss

-- contiene algún elemento que cumple el predicado p. Por ejemplo,

-- verificaP odd [[1,3,4,2], [4,5], [9]] == True

-- verificaP odd [[1,3,4,2], [4,8], [9]] == False

Soluciones

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

Las soluciones se pueden escribir en los comentarios hasta el 28 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-28′ at=»06:00″]

-- 1ª definición (por comprensión):
verificaP :: (a -> Bool) -> [[a]] -> Bool
verificaP p xss = and [any p xs | xs <- xss]

-- 2ª definición (por recursión):
verificaP2 :: (a -> Bool) -> [[a]] -> Bool
verificaP2 p []       = True
verificaP2 p (xs:xss) = any p xs && verificaP2 p xss

-- 3ª definición (por plegado):
verificaP3 :: (a -> Bool) -> [[a]] -> Bool
verificaP3 p = foldr ((&&) . any p) True

-- 4ª definición (con cuantificadores)
verificaP4 :: (a -> Bool) -> [[a]] -> Bool
verificaP4 p = all (any p)

-- 5ª definición (con cuantificadores y composición)
verificaP5 :: (a -> Bool) -> [[a]] -> Bool
verificaP5 = all . any

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

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

verificaP p xss = and [any p xs | xs <- xss]

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

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

verificaP2 p [] = True

verificaP2 p (xs:xss) = any p xs && verificaP2 p xss

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

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

verificaP3 p = foldr ((&&) . any p) True

-- 4ª definición (con cuantificadores)

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

verificaP4 p = all (any p)

-- 5ª definición (con cuantificadores y composición)

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

verificaP5 = all . any

[/schedule]

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]

Soluciones

Enunciado

Soluciones

Exercitium

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Enunciado

Soluciones

Soluciones

Soluciones

Soluciones

Comentarios

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Soluciones

Introducción

Enunciado

Soluciones

Introducción

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Referencias

Enunciado

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Entradas recientes

Buscar

Correo electrónico