Ejercicio

Ampliación de matrices por columnas

PorJosé A. Alonso 22-marzo-202215-abril-2022

Las matrices enteras se pueden representar mediante tablas con índices enteros:

   type Matriz = Array (Int,Int) Int

1	type Matriz = Array (Int,Int) Int

Definir la función

   ampliaColumnas :: Matriz -> Matriz -> Matriz

1	ampliaColumnas :: Matriz -> Matriz -> Matriz

tal que (ampliaColumnas p q) es la matriz construida añadiendo las columnas de la matriz q a continuación de las de p (se supone que tienen el mismo número de filas). Por ejemplo, si p y q representa las dos primeras matrices, entonces (ampliaColumnas p q) es la tercera

   |0 1|    |4 5 6|    |0 1 4 5 6|
   |2 3|    |7 8 9|    |2 3 7 8 9|

1 2	\|0 1\| \|4 5 6\| \|0 1 4 5 6\| \|2 3\| \|7 8 9\| \|2 3 7 8 9\|

En Haskell, se definen las dos primeras matrices se definen por

   ej1 = listArray ((1,1),(2,2)) [0..3]
   ej2 = listArray ((1,1),(2,3)) [4..9]

1 2	ej1 = listArray ((1,1),(2,2)) [0..3] ej2 = listArray ((1,1),(2,3)) [4..9]

y el cálculo de la tercera es

   λ> ampliaColumnas ej1 ej2
   array ((1,1),(2,5)) [((1,1),0),((1,2),1),((1,3),4),((1,4),5),((1,5),6),
                        ((2,1),2),((2,2),3),((2,3),7),((2,4),8),((2,5),9)]
   λ> elems (ampliaColumnas ej1 ej2)
   [0,1,4,5,6,2,3,7,8,9]

λ> ampliaColumnas ej1 ej2

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

((2,1),2),((2,2),3),((2,3),7),((2,4),8),((2,5),9)]

λ> elems (ampliaColumnas ej1 ej2)

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

Soluciones

import Data.Array (Array, (!), array, bounds, elems, listArray)
import Data.Matrix (Matrix, (<|>), fromList, ncols, nrows, toList)
import Test.QuickCheck

type Matriz = Array (Int,Int) Int

ej1, ej2 :: Matriz
ej1 = listArray ((1,1),(2,2)) [0..3]
ej2 = listArray ((1,1),(2,3)) [4..9]

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

ampliaColumnas1 :: Matriz -> Matriz -> Matriz
ampliaColumnas1 p1 p2 =
  array ((1,1),(m,n1+n2)) [((i,j), f i j) | i <- [1..m], j <- [1..n1+n2]]
    where ((_,_),(m,n1)) = bounds p1
          ((_,_),(_,n2)) = bounds p2
          f i j | j <= n1   = p1!(i,j)
                | otherwise = p2!(i,j-n1)

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

ampliaColumnas2 :: Matriz -> Matriz -> Matriz
ampliaColumnas2 p1 p2 =
  matriz (matrix p1 <|> matrix p2)

-- (matrix p) es la matriz p en el formatao de Data.Matrix. Por ejemplo,
--    λ> ej1
--    array ((1,1),(2,2)) [((1,1),0),((1,2),1),((2,1),2),((2,2),3)]
--    λ> matrix ej1
--    ┌     ┐
--    │ 0 1 │
--    │ 2 3 │
--    └     ┘
--    λ> matrix (ampliaColumnas1 ej1 ej2)
--    ┌           ┐
--    │ 0 1 4 5 6 │
--    │ 2 3 7 8 9 │
--    └           ┘
matrix :: Matriz -> Matrix Int
matrix p = fromList m n (elems p)
  where (_,(m,n)) = bounds p

-- (matriz p) es la matriz p en el formato de Data.Array. Por ejemplo,
--    λ> matriz (fromList 2 3 [1..])
--    array ((1,1),(2,3)) [((1,1),1),((1,2),2),((1,3),3),((2,1),4),((2,2),5),((2,3),6)]
matriz :: Matrix Int -> Matriz
matriz p = listArray ((1,1),(nrows p,ncols p)) (toList p)

-- Comprobación de equivalencia
-- ============================

data ParMatrices = P Matriz Matriz
  deriving Show

-- parMatricesArbitrario es un generador de pares de matrices con el
-- mismo número de filas.
parMatricesArbitrario :: Gen ParMatrices
parMatricesArbitrario = do
  m  <- arbitrary `suchThat` (> 0)
  n1 <- arbitrary `suchThat` (> 0)
  n2 <- arbitrary `suchThat` (> 0)
  xs <- vector (m * n1)
  ys <- vector (m * n2)
  return (P (listArray ((1,1),(m,n1)) xs)
            (listArray ((1,1),(m,n2)) ys))

-- ParMatrices es una subclase de Arbitrary
instance Arbitrary ParMatrices where
  arbitrary = parMatricesArbitrario

-- La propiedad es
prop_ampliaColumna :: ParMatrices -> Bool
prop_ampliaColumna (P p q) =
  ampliaColumnas1 p q == ampliaColumnas2 p q

-- La comprobación es
--    λ> quickCheck prop_ampliaColumna
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> let p = listArray ((1,1),(10^3,10^3)) [1..] in maximum (ampliaColumnas1 p p)
--    1000000
--    (2.04 secs, 1,562,652,704 bytes)
--    λ> let p = listArray ((1,1),(10^3,10^3)) [1..] in maximum (ampliaColumnas2 p p)
--    1000000
--    (0.69 secs, 738,508,624 bytes)

import Data.Array (Array, (!), array, bounds, elems, listArray)

import Data.Matrix (Matrix, (<|>), fromList, ncols, nrows, toList)

import Test.QuickCheck

type Matriz = Array (Int,Int) Int

ej1, ej2 :: Matriz

ej1 = listArray ((1,1),(2,2)) [0..3]

ej2 = listArray ((1,1),(2,3)) [4..9]

-- 1ª solución

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

ampliaColumnas1 :: Matriz -> Matriz -> Matriz

ampliaColumnas1 p1 p2 =

array ((1,1),(m,n1+n2)) [((i,j), f i j) | i <- [1..m], j <- [1..n1+n2]]

where ((_,_),(m,n1)) = bounds p1

((_,_),(_,n2)) = bounds p2

f i j | j <= n1 = p1!(i,j)

| otherwise = p2!(i,j-n1)

-- 2ª solución

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

ampliaColumnas2 :: Matriz -> Matriz -> Matriz

ampliaColumnas2 p1 p2 =

matriz (matrix p1 <|> matrix p2)

-- (matrix p) es la matriz p en el formatao de Data.Matrix. Por ejemplo,

-- λ> ej1

-- array ((1,1),(2,2)) [((1,1),0),((1,2),1),((2,1),2),((2,2),3)]

-- λ> matrix ej1

-- ┌ ┐

-- │ 0 1 │

-- │ 2 3 │

-- └ ┘

-- λ> matrix (ampliaColumnas1 ej1 ej2)

-- ┌ ┐

-- │ 0 1 4 5 6 │

-- │ 2 3 7 8 9 │

-- └ ┘

matrix :: Matriz -> Matrix Int

matrix p = fromList m n (elems p)

where (_,(m,n)) = bounds p

-- (matriz p) es la matriz p en el formato de Data.Array. Por ejemplo,

-- λ> matriz (fromList 2 3 [1..])

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

matriz :: Matrix Int -> Matriz

matriz p = listArray ((1,1),(nrows p,ncols p)) (toList p)

-- Comprobación de equivalencia

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

data ParMatrices = P Matriz Matriz

deriving Show

-- parMatricesArbitrario es un generador de pares de matrices con el

-- mismo número de filas.

parMatricesArbitrario :: Gen ParMatrices

parMatricesArbitrario = do

m <- arbitrary `suchThat` (> 0)

n1 <- arbitrary `suchThat` (> 0)

n2 <- arbitrary `suchThat` (> 0)

xs <- vector (m * n1)

ys <- vector (m * n2)

return (P (listArray ((1,1),(m,n1)) xs)

(listArray ((1,1),(m,n2)) ys))

-- ParMatrices es una subclase de Arbitrary

instance Arbitrary ParMatrices where

arbitrary = parMatricesArbitrario

-- La propiedad es

prop_ampliaColumna :: ParMatrices -> Bool

prop_ampliaColumna (P p q) =

ampliaColumnas1 p q == ampliaColumnas2 p q

-- La comprobación es

-- λ> quickCheck prop_ampliaColumna

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> let p = listArray ((1,1),(10^3,10^3)) [1..] in maximum (ampliaColumnas1 p p)

-- 1000000

-- (2.04 secs, 1,562,652,704 bytes)

-- λ> let p = listArray ((1,1),(10^3,10^3)) [1..] in maximum (ampliaColumnas2 p p)

-- 1000000

-- (0.69 secs, 738,508,624 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Nuevas soluciones

En los comentarios se pueden escribir nuevas soluciones.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Emparejamiento binario

PorJosé A. Alonso 21-marzo-202228-marzo-2022

Definir la función

   zipBinario :: [a -> b -> c] -> [a] -> [b] -> [c]

1	zipBinario :: [a -> b -> c] -> [a] -> [b] -> [c]

tal que (zipBinario fs xs ys) es la lista obtenida aplicando cada una de las operaciones binarias de fs a los correspondientes elementos de xs e ys. Por ejemplo,

   zipBinario [(+), (*), (*)] [2,2,2] [4,4,4]    == [6,8,8]
   zipBinario [(+)] [2,2,2] [4,4,4]              == [6]
   zipBinario [(<), (==), (==)] "coloca" "lobo"  == [True,True,False]

zipBinario [(+), (*), (*)] [2,2,2] [4,4,4] == [6,8,8]

zipBinario [(+)] [2,2,2] [4,4,4] == [6]

zipBinario [(<), (==), (==)] "coloca" "lobo" == [True,True,False]

Soluciones

import Test.QuickCheck
import Test.QuickCheck.HigherOrder
import Test.Hspec

-- 1ª solución
zipBinario1 :: [a -> b -> c] -> [a] -> [b] -> [c]
zipBinario1 (f:fs) (x:xs) (y:ys) = f x y : zipBinario1 fs xs ys
zipBinario1 _ _ _                = []

-- 2ª solución
zipBinario2 :: [a -> b -> c] -> [a] -> [b] -> [c]
zipBinario2 fs xs ys = [f x y | (f,(x,y)) <- zip fs (zip xs ys)]

-- 3ª solución
zipBinario3 :: [a -> b -> c] -> [a] -> [b] -> [c]
zipBinario3 fs xs ys = [f x y | (f,x,y) <- zip3 fs xs ys]

-- 4ª solución
zipBinario4 :: [a -> b -> c] -> [a] -> [b] -> [c]
zipBinario4 = zipWith3 id

-- Verificación
-- ============

especificacion :: ([Int -> Int -> Int] -> [Int] -> [Int] -> [Int]) -> Spec
especificacion zipBinario = do
  it "e1" $ zipBinario [(+), (*), (*)] [2,2,2] [4,4,4]    `shouldBe` [6,8,8]
  it "e2" $ zipBinario [(+)] [2,2,2] [4,4,4]              `shouldBe` [6]

verifica :: IO ()
verifica = hspec $ do
  describe "zipBinario1" $ especificacion zipBinario1
  describe "zipBinario2" $ especificacion zipBinario2
  describe "zipBinario3" $ especificacion zipBinario3
  describe "zipBinario4" $ especificacion zipBinario4

-- La verificación es
--    λ> verifica
--
--    zipBinario1
--      e1
--      e2
--    zipBinario2
--      e1
--      e2
--    zipBinario3
--      e1
--      e2
--    zipBinario4
--      e1
--      e2
--
--    Finished in 0.0016 seconds
--    8 examples, 0 failures

-- Comprobación de equivalencia
-- ============================


-- La propiedad es
prop_zipBinario :: [Bool -> Bool -> Bool] -> [Bool] -> [Bool] -> Bool
prop_zipBinario fs xs ys =
  all (== zipBinario1 fs xs ys)
      [g fs xs ys | g <- [zipBinario2,
                          zipBinario3,
                          zipBinario4]]

-- La comprobación es
--    λ> quickCheck' prop_zipBinario
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> maximum (zipBinario1 (cycle [(+), (*)]) [1..] [1..2*10^6])
--    4000000000000
--    (2.13 secs, 965,392,072 bytes)
--    λ> maximum (zipBinario2 (cycle [(+), (*)]) [1..] [1..2*10^6])
--    4000000000000
--    (1.86 secs, 1,109,392,176 bytes)
--    λ> maximum (zipBinario3 (cycle [(+), (*)]) [1..] [1..2*10^6])
--    4000000000000
--    (1.93 secs, 981,392,128 bytes)
--    λ> maximum (zipBinario4 (cycle [(+), (*)]) [1..] [1..2*10^6])
--    4000000000000
--    (1.07 secs, 773,392,040 bytes)

import Test.QuickCheck

import Test.QuickCheck.HigherOrder

import Test.Hspec

-- 1ª solución

zipBinario1 :: [a -> b -> c] -> [a] -> [b] -> [c]

zipBinario1 (f:fs) (x:xs) (y:ys) = f x y : zipBinario1 fs xs ys

zipBinario1 _ _ _ = []

-- 2ª solución

zipBinario2 :: [a -> b -> c] -> [a] -> [b] -> [c]

zipBinario2 fs xs ys = [f x y | (f,(x,y)) <- zip fs (zip xs ys)]

-- 3ª solución

zipBinario3 :: [a -> b -> c] -> [a] -> [b] -> [c]

zipBinario3 fs xs ys = [f x y | (f,x,y) <- zip3 fs xs ys]

-- 4ª solución

zipBinario4 :: [a -> b -> c] -> [a] -> [b] -> [c]

zipBinario4 = zipWith3 id

-- Verificación

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

especificacion :: ([Int -> Int -> Int] -> [Int] -> [Int] -> [Int]) -> Spec

especificacion zipBinario = do

it "e1" $ zipBinario [(+), (*), (*)] [2,2,2] [4,4,4] `shouldBe` [6,8,8]

it "e2" $ zipBinario [(+)] [2,2,2] [4,4,4] `shouldBe` [6]

verifica :: IO ()

verifica = hspec $ do

describe "zipBinario1" $ especificacion zipBinario1

describe "zipBinario2" $ especificacion zipBinario2

describe "zipBinario3" $ especificacion zipBinario3

describe "zipBinario4" $ especificacion zipBinario4

-- La verificación es

-- λ> verifica

-- zipBinario1

-- e1

-- e2

-- zipBinario2

-- e1

-- e2

-- zipBinario3

-- e1

-- e2

-- zipBinario4

-- e1

-- e2

-- Finished in 0.0016 seconds

-- 8 examples, 0 failures

-- Comprobación de equivalencia

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

-- La propiedad es

prop_zipBinario :: [Bool -> Bool -> Bool] -> [Bool] -> [Bool] -> Bool

prop_zipBinario fs xs ys =

all (== zipBinario1 fs xs ys)

[g fs xs ys | g <- [zipBinario2,

zipBinario3,

zipBinario4]]

-- La comprobación es

-- λ> quickCheck' prop_zipBinario

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximum (zipBinario1 (cycle [(+), (*)]) [1..] [1..2*10^6])

-- 4000000000000

-- (2.13 secs, 965,392,072 bytes)

-- λ> maximum (zipBinario2 (cycle [(+), (*)]) [1..] [1..2*10^6])

-- 4000000000000

-- (1.86 secs, 1,109,392,176 bytes)

-- λ> maximum (zipBinario3 (cycle [(+), (*)]) [1..] [1..2*10^6])

-- 4000000000000

-- (1.93 secs, 981,392,128 bytes)

-- λ> maximum (zipBinario4 (cycle [(+), (*)]) [1..] [1..2*10^6])

-- 4000000000000

-- (1.07 secs, 773,392,040 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Nuevas soluciones

En los comentarios se pueden escribir nuevas soluciones.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Ordenación de estructuras

PorJosé A. Alonso 18-marzo-202225-marzo-2022

Las notas de los dos primeros exámenes se pueden representar mediante el siguiente tipo de dato

   data Notas = Notas String Int Int
     deriving (Read, Show, Eq)

1 2	data Notas = Notas String Int Int deriving (Read, Show, Eq)

Por ejemplo, (Notas «Juan» 6 5) representa las notas de un alumno cuyo nombre es Juan, la nota del primer examen es 6 y la del segundo es 5.

Definir la función

   ordenadas :: [Notas] -> [Notas]

1	ordenadas :: [Notas] -> [Notas]

tal que (ordenadas ns) es la lista de las notas ns ordenadas considerando primero la nota del examen 2, a continuación la del examen 1 y finalmente el nombre. Por ejemplo,

   λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 3 7]
   [Notas "Juan" 6 5,Notas "Luis" 3 7]
   λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 3 4]
   [Notas "Luis" 3 4,Notas "Juan" 6 5]
   λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 7 4]
   [Notas "Luis" 7 4,Notas "Juan" 6 5]
   λ> ordenadas [Notas "Juan" 6 4, Notas "Luis" 7 4]
   [Notas "Juan" 6 4,Notas "Luis" 7 4]
   λ> ordenadas [Notas "Juan" 6 4, Notas "Luis" 5 4]
   [Notas "Luis" 5 4,Notas "Juan" 6 4]
   λ> ordenadas [Notas "Juan" 5 4, Notas "Luis" 5 4]
   [Notas "Juan" 5 4,Notas "Luis" 5 4]
   λ> ordenadas [Notas "Juan" 5 4, Notas "Eva" 5 4]
   [Notas "Eva" 5 4,Notas "Juan" 5 4]

λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 3 7]

[Notas "Juan" 6 5,Notas "Luis" 3 7]

λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 3 4]

[Notas "Luis" 3 4,Notas "Juan" 6 5]

λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 7 4]

[Notas "Luis" 7 4,Notas "Juan" 6 5]

λ> ordenadas [Notas "Juan" 6 4, Notas "Luis" 7 4]

[Notas "Juan" 6 4,Notas "Luis" 7 4]

λ> ordenadas [Notas "Juan" 6 4, Notas "Luis" 5 4]

[Notas "Luis" 5 4,Notas "Juan" 6 4]

λ> ordenadas [Notas "Juan" 5 4, Notas "Luis" 5 4]

[Notas "Juan" 5 4,Notas "Luis" 5 4]

λ> ordenadas [Notas "Juan" 5 4, Notas "Eva" 5 4]

[Notas "Eva" 5 4,Notas "Juan" 5 4]

Soluciones

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

data Notas = Notas String Int Int
  deriving (Read, Show, Eq)

-- 1ª solución
ordenadas1 :: [Notas] -> [Notas]
ordenadas1 ns =
  [Notas n x y | (y,x,n) <- sort [(y1,x1,n1) | (Notas n1 x1 y1) <- ns]]

-- 2ª solución
ordenadas2 :: [Notas] -> [Notas]
ordenadas2 ns =
  map (\(y,x,n) -> Notas n x y) (sort [(y1,x1,n1) | (Notas n1 x1 y1) <- ns])

-- 3ª solución
ordenadas3 :: [Notas] -> [Notas]
ordenadas3 ns = sortBy (\(Notas n1 x1 y1) (Notas n2 x2 y2) ->
                          compare (y1,x1,n1) (y2,x2,n2))
                       ns

-- 4ª solución
-- ===========

instance Ord Notas where
  Notas n1 x1 y1 <= Notas n2 x2 y2 = (y1,x1,n1) <= (y2,x2,n2)

ordenadas4 :: [Notas] -> [Notas]
ordenadas4 = sort

-- Comprobación de equivalencia
-- ============================

-- notasArbitraria es un generador aleatorio de notas. Por ejemplo,
--    λ> sample notasArbitraria
--    Notas "achjkqruvxy" 3 3
--    Notas "abfgikmptuvy" 10 10
--    Notas "degjmptvwx" 7 9
--    Notas "cdefghjmnoqrsuw" 0 9
--    Notas "bcdfikmstuxz" 1 8
--    Notas "abcdhkopqsvwx" 10 7
--    Notas "abghiklnoqstvwx" 0 0
--    Notas "abfghklmnoptuvx" 4 9
--    Notas "bdehjkmpqsxyz" 0 4
--    Notas "afghijmopsvwz" 3 7
--    Notas "bdefghjklnoqx" 2 3
notasArbitraria :: Gen Notas
notasArbitraria = do
  n <- sublistOf ['a'..'z']
  x <- chooseInt (0, 10)
  y <- chooseInt (0, 10)
  return (Notas n x y)

-- Notas es una subclase de Arbitrary
instance Arbitrary Notas where
  arbitrary = notasArbitraria

-- La propiedad es
prop_ordenadas :: [Notas] -> Bool
prop_ordenadas ns =
  all (== ordenadas1 ns)
      [f ns | f <- [ordenadas2,
                    ordenadas3,
                    ordenadas4]]

-- La comprobación es
--    λ> quickCheck prop_ordenadas
--    +++ OK, passed 100 tests.

import Data.List (sort, sortBy)

import Test.QuickCheck

data Notas = Notas String Int Int

deriving (Read, Show, Eq)

-- 1ª solución

ordenadas1 :: [Notas] -> [Notas]

ordenadas1 ns =

[Notas n x y | (y,x,n) <- sort [(y1,x1,n1) | (Notas n1 x1 y1) <- ns]]

-- 2ª solución

ordenadas2 :: [Notas] -> [Notas]

ordenadas2 ns =

map (\(y,x,n) -> Notas n x y) (sort [(y1,x1,n1) | (Notas n1 x1 y1) <- ns])

-- 3ª solución

ordenadas3 :: [Notas] -> [Notas]

ordenadas3 ns = sortBy (\(Notas n1 x1 y1) (Notas n2 x2 y2) ->

compare (y1,x1,n1) (y2,x2,n2))

-- 4ª solución

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

instance Ord Notas where

Notas n1 x1 y1 <= Notas n2 x2 y2 = (y1,x1,n1) <= (y2,x2,n2)

ordenadas4 :: [Notas] -> [Notas]

ordenadas4 = sort

-- Comprobación de equivalencia

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

-- notasArbitraria es un generador aleatorio de notas. Por ejemplo,

-- λ> sample notasArbitraria

-- Notas "achjkqruvxy" 3 3

-- Notas "abfgikmptuvy" 10 10

-- Notas "degjmptvwx" 7 9

-- Notas "cdefghjmnoqrsuw" 0 9

-- Notas "bcdfikmstuxz" 1 8

-- Notas "abcdhkopqsvwx" 10 7

-- Notas "abghiklnoqstvwx" 0 0

-- Notas "abfghklmnoptuvx" 4 9

-- Notas "bdehjkmpqsxyz" 0 4

-- Notas "afghijmopsvwz" 3 7

-- Notas "bdefghjklnoqx" 2 3

notasArbitraria :: Gen Notas

notasArbitraria = do

n <- sublistOf ['a'..'z']

x <- chooseInt (0, 10)

y <- chooseInt (0, 10)

return (Notas n x y)

-- Notas es una subclase de Arbitrary

instance Arbitrary Notas where

arbitrary = notasArbitraria

-- La propiedad es

prop_ordenadas :: [Notas] -> Bool

prop_ordenadas ns =

all (== ordenadas1 ns)

[f ns | f <- [ordenadas2,

ordenadas3,

ordenadas4]]

-- La comprobación es

-- λ> quickCheck prop_ordenadas

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

La elaboración de las soluciones se muestra en el siguiente vídeo

Numeración de las ternas de números naturales

PorJosé A. Alonso 17-marzo-202215-abril-2022

Las ternas de números naturales se pueden ordenar como sigue

   (0,0,0),
   (0,0,1),(0,1,0),(1,0,0),
   (0,0,2),(0,1,1),(0,2,0),(1,0,1),(1,1,0),(2,0,0),
   (0,0,3),(0,1,2),(0,2,1),(0,3,0),(1,0,2),(1,1,1),(1,2,0),(2,0,1),...
   ...

(0,0,0),

(0,0,1),(0,1,0),(1,0,0),

(0,0,2),(0,1,1),(0,2,0),(1,0,1),(1,1,0),(2,0,0),

(0,0,3),(0,1,2),(0,2,1),(0,3,0),(1,0,2),(1,1,1),(1,2,0),(2,0,1),...

...

Definir la función

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

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

tal que (posicion (x,y,z)) es la posición de la terna de números naturales (x,y,z) en la ordenación anterior. Por ejemplo,

   posicion (0,1,0)  ==  2
   posicion (0,0,2)  ==  4
   posicion (0,1,1)  ==  5

posicion (0,1,0) == 2

posicion (0,0,2) == 4

posicion (0,1,1) == 5

Comprobar con QuickCheck que

la posición de (x,0,0) es x(x²+6x+11)/6
la posición de (0,y,0) es y(y²+3y+ 8)/6
la posición de (0,0,z) es z(z²+3z+ 2)/6
la posición de (x,x,x) es x(9x²+14x+7)/2

Soluciones

import Data.List (elemIndex)
import Data.Maybe (fromJust)
import Test.QuickCheck

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

posicion1 :: (Int,Int,Int) -> Int
posicion1 t = aux 0 ternas
  where aux n (t':ts) | t' == t   = n
                      | otherwise = aux (n+1) ts

-- ternas es la lista ordenada de las ternas de números naturales. Por ejemplo,
--    λ> take 9 ternas
--    [(0,0,0),(0,0,1),(0,1,0),(1,0,0),(0,0,2),(0,1,1),(0,2,0),(1,0,1),(1,1,0)]
ternas :: [(Int,Int,Int)]
ternas = [(x,y,n-x-y) | n <- [0..], x <- [0..n], y <- [0..n-x]]

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

posicion2 :: (Int,Int,Int) -> Int
posicion2 t =
  head [n | (n,t') <- zip [0..] ternas, t' == t]

-- 3ª solución
-- ===========

posicion3 :: (Int,Int,Int) -> Int
posicion3 t = indice t ternas

-- (indice x ys) es el índice de x en ys. Por ejemplo,
--    indice 5 [0..]  ==  5
indice :: Eq a => a -> [a] -> Int
indice x ys = length (takeWhile (/= x) ys)

-- 4ª solución
-- ===========

posicion4 :: (Int,Int,Int) -> Int
posicion4 t = fromJust (elemIndex t ternas)

-- 5ª solución
-- ===========

posicion5 :: (Int,Int,Int) -> Int
posicion5 = fromJust . (`elemIndex` ternas)

-- Equivalencia
-- ============

-- La propiedad es
prop_posicion_equiv :: NonNegative Int
                    -> NonNegative Int
                    -> NonNegative Int
                    -> Bool
prop_posicion_equiv (NonNegative x) (NonNegative y) (NonNegative z) =
  all (== posicion1 (x,y,z))
      [f (x,y,z) | f <- [ posicion2
                        , posicion3
                        , posicion4
                        , posicion5 ]]

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion_equiv
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> posicion1 (147,46,116)
--    5000000
--    (5.84 secs, 2,621,428,184 bytes)
--    λ> posicion2 (147,46,116)
--    5000000
--    (3.63 secs, 2,173,230,200 bytes)
--    λ> posicion3 (147,46,116)
--    5000000
--    (2.48 secs, 1,453,229,880 bytes)
--    λ> posicion4 (147,46,116)
--    5000000
--    (1.91 secs, 1,173,229,840 bytes)
--    λ> posicion5 (147,46,116)
--    5000000
--    (1.94 secs, 1,173,229,960 bytes)

-- En lo que sigue, usaremos la 5ª definición
posicion :: (Int,Int,Int) -> Int
posicion = posicion5

-- Propiedades
-- ===========

-- La 1ª propiedad es
prop_posicion1 :: NonNegative Int -> Bool
prop_posicion1 (NonNegative x) =
  posicion (x,0,0) == x * (x^2 + 6*x + 11) `div` 6

-- Su comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion1
--    +++ OK, passed 100 tests.

-- La 2ª propiedad es
prop_posicion2 :: NonNegative Int -> Bool
prop_posicion2 (NonNegative y) =
  posicion (0,y,0) == y * (y^2 + 3*y + 8) `div` 6

-- Su comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion2
--    +++ OK, passed 100 tests.

-- La 3ª propiedad es
prop_posicion3 :: NonNegative Int -> Bool
prop_posicion3 (NonNegative z) =
  posicion (0,0,z) == z * (z^2 + 3*z + 2) `div` 6

-- Su comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion3
--    +++ OK, passed 100 tests.

-- La 4ª propiedad es
prop_posicion4 :: NonNegative Int -> Bool
prop_posicion4 (NonNegative x) =
  posicion (x,x,x) == x * (9 * x^2 + 14 * x + 7) `div` 2

-- Su comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion4
--    +++ OK, passed 100 tests.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

import Data.List (elemIndex)

import Data.Maybe (fromJust)

import Test.QuickCheck

-- 1ª solución

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

posicion1 :: (Int,Int,Int) -> Int

posicion1 t = aux 0 ternas

where aux n (t':ts) | t' == t = n

| otherwise = aux (n+1) ts

-- ternas es la lista ordenada de las ternas de números naturales. Por ejemplo,

-- λ> take 9 ternas

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

ternas :: [(Int,Int,Int)]

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

-- 2ª solución

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

posicion2 :: (Int,Int,Int) -> Int

posicion2 t =

head [n | (n,t') <- zip [0..] ternas, t' == t]

-- 3ª solución

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

posicion3 :: (Int,Int,Int) -> Int

posicion3 t = indice t ternas

-- (indice x ys) es el índice de x en ys. Por ejemplo,

-- indice 5 [0..] == 5

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

indice x ys = length (takeWhile (/= x) ys)

-- 4ª solución

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

posicion4 :: (Int,Int,Int) -> Int

posicion4 t = fromJust (elemIndex t ternas)

-- 5ª solución

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

posicion5 :: (Int,Int,Int) -> Int

posicion5 = fromJust . (`elemIndex` ternas)

-- Equivalencia

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

-- La propiedad es

prop_posicion_equiv :: NonNegative Int

-> NonNegative Int

-> Bool

prop_posicion_equiv (NonNegative x) (NonNegative y) (NonNegative z) =

all (== posicion1 (x,y,z))

[f (x,y,z) | f <- [ posicion2

, posicion3

, posicion4

, posicion5 ]]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> posicion1 (147,46,116)

-- 5000000

-- (5.84 secs, 2,621,428,184 bytes)

-- λ> posicion2 (147,46,116)

-- 5000000

-- (3.63 secs, 2,173,230,200 bytes)

-- λ> posicion3 (147,46,116)

-- 5000000

-- (2.48 secs, 1,453,229,880 bytes)

-- λ> posicion4 (147,46,116)

-- 5000000

-- (1.91 secs, 1,173,229,840 bytes)

-- λ> posicion5 (147,46,116)

-- 5000000

-- (1.94 secs, 1,173,229,960 bytes)

-- En lo que sigue, usaremos la 5ª definición

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

posicion = posicion5

-- Propiedades

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

-- La 1ª propiedad es

prop_posicion1 :: NonNegative Int -> Bool

prop_posicion1 (NonNegative x) =

posicion (x,0,0) == x * (x^2 + 6*x + 11) `div` 6

-- Su comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion1

-- +++ OK, passed 100 tests.

-- La 2ª propiedad es

prop_posicion2 :: NonNegative Int -> Bool

prop_posicion2 (NonNegative y) =

posicion (0,y,0) == y * (y^2 + 3*y + 8) `div` 6

-- Su comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion2

-- +++ OK, passed 100 tests.

-- La 3ª propiedad es

prop_posicion3 :: NonNegative Int -> Bool

prop_posicion3 (NonNegative z) =

posicion (0,0,z) == z * (z^2 + 3*z + 2) `div` 6

-- Su comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion3

-- +++ OK, passed 100 tests.

-- La 4ª propiedad es

prop_posicion4 :: NonNegative Int -> Bool

prop_posicion4 (NonNegative x) =

posicion (x,x,x) == x * (9 * x^2 + 14 * x + 7) `div` 2

-- Su comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion4

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

La elaboración de las soluciones se muestra en el siguiente vídeo:

Alfabeto comenzando en un carácter

PorJosé A. Alonso 16-marzo-202223-marzo-2022

Definir la función

   alfabetoDesde :: Char -> String

1	alfabetoDesde :: Char -> String

tal que (alfabetoDesde c) es el alfabeto, en minúscula, comenzando en el carácter c, si c es una letra minúscula y comenzando en ‘a’, en caso contrario. Por ejemplo,

   alfabetoDesde 'e'  ==  "efghijklmnopqrstuvwxyzabcd"
   alfabetoDesde 'a'  ==  "abcdefghijklmnopqrstuvwxyz"
   alfabetoDesde '7'  ==  "abcdefghijklmnopqrstuvwxyz"
   alfabetoDesde '{'  ==  "abcdefghijklmnopqrstuvwxyz"
   alfabetoDesde 'B'  ==  "abcdefghijklmnopqrstuvwxyz"

alfabetoDesde 'e' == "efghijklmnopqrstuvwxyzabcd"

alfabetoDesde 'a' == "abcdefghijklmnopqrstuvwxyz"

alfabetoDesde '7' == "abcdefghijklmnopqrstuvwxyz"

alfabetoDesde '{' == "abcdefghijklmnopqrstuvwxyz"

alfabetoDesde 'B' == "abcdefghijklmnopqrstuvwxyz"

Soluciones

import Data.Char (isLower, isAscii)
import Test.QuickCheck

-- 1ª solución
alfabetoDesde1 :: Char -> String
alfabetoDesde1 c =
  dropWhile (<c) ['a'..'z'] ++ takeWhile (<c) ['a'..'z']

-- 2ª solución
alfabetoDesde2 :: Char -> String
alfabetoDesde2 c = ys ++ xs
  where (xs,ys) = span (<c) ['a'..'z']

-- 3ª solución
alfabetoDesde3 :: Char -> String
alfabetoDesde3 c = ys ++ xs
  where (xs,ys) = break (==c) ['a'..'z']

-- 4ª solución
alfabetoDesde4 :: Char -> String
alfabetoDesde4 c
  | 'a' <= c && c <= 'z' = [c..'z'] ++ ['a'..pred c]
  | otherwise            = ['a'..'z']

-- 5ª solución
alfabetoDesde5 :: Char -> String
alfabetoDesde5 c
  | isLower c = [c..'z'] ++ ['a'..pred c]
  | otherwise = ['a'..'z']

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_alfabetoDesde :: Property
prop_alfabetoDesde =
  forAll (arbitrary `suchThat` isAscii) $ \c ->
  all (== alfabetoDesde1 c)
      [f c | f <- [alfabetoDesde2,
                   alfabetoDesde3,
                   alfabetoDesde4,
                   alfabetoDesde5]]


-- La comprobación es
--    λ> quickCheck prop_alfabetoDesde
--    +++ OK, passed 100 tests.

import Data.Char (isLower, isAscii)

import Test.QuickCheck

-- 1ª solución

alfabetoDesde1 :: Char -> String

alfabetoDesde1 c =

dropWhile (<c) ['a'..'z'] ++ takeWhile (<c) ['a'..'z']

-- 2ª solución

alfabetoDesde2 :: Char -> String

alfabetoDesde2 c = ys ++ xs

where (xs,ys) = span (<c) ['a'..'z']

-- 3ª solución

alfabetoDesde3 :: Char -> String

alfabetoDesde3 c = ys ++ xs

where (xs,ys) = break (==c) ['a'..'z']

-- 4ª solución

alfabetoDesde4 :: Char -> String

alfabetoDesde4 c

| 'a' <= c && c <= 'z' = [c..'z'] ++ ['a'..pred c]

| otherwise = ['a'..'z']

-- 5ª solución

alfabetoDesde5 :: Char -> String

alfabetoDesde5 c

| isLower c = [c..'z'] ++ ['a'..pred c]

| otherwise = ['a'..'z']

-- Comprobación de equivalencia

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

-- La propiedad es

prop_alfabetoDesde :: Property

prop_alfabetoDesde =

forAll (arbitrary `suchThat` isAscii) $ \c ->

all (== alfabetoDesde1 c)

[f c | f <- [alfabetoDesde2,

alfabetoDesde3,

alfabetoDesde4,

alfabetoDesde5]]

-- La comprobación es

-- λ> quickCheck prop_alfabetoDesde

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

La elaboración de las soluciones se muestra en el siguiente vídeo

Ramas de un árbol

PorJosé A. Alonso 15-marzo-202226-marzo-2022

Los árboles se pueden representar mediante el siguiente tipo de datos

   data Arbol a = N a [Arbol a]
     deriving Show

1 2	data Arbol a = N a [Arbol a] deriving Show

Por ejemplo, los árboles

     1               3
    / \             /|\
   2   3           / | \
       |          5  4  7
       4          |     /\
                  6    2  1

1 3

/ \ /|\

2 3 / | \

| 5 4 7

4 | /\

6 2 1

se representan por

   ej1, ej2 :: Arbol Int
   ej1 = N 1 [N 2 [],N 3 [N 4 []]]
   ej2 = N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]

ej1, ej2 :: Arbol Int

ej1 = N 1 [N 2 [],N 3 [N 4 []]]

ej2 = N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]

Definir la función

   ramas :: Arbol b -> [[b]]

1	ramas :: Arbol b -> [[b]]

tal que (ramas a) es la lista de las ramas del árbol a. Por ejemplo,

   ramas ej1  ==  [[1,2],[1,3,4]]
   ramas ej2  ==  [[3,5,6],[3,4],[3,7,2],[3,7,1]]

1 2	ramas ej1 == [[1,2],[1,3,4]] ramas ej2 == [[3,5,6],[3,4],[3,7,2],[3,7,1]]

Soluciones

import Test.QuickCheck

data Arbol a = N a [Arbol a]
  deriving Show

ej1, ej2 :: Arbol Int
ej1 = N 1 [N 2 [],N 3 [N 4 []]]
ej2 = N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]]

-- 1ª solución
ramas1 :: Arbol b -> [[b]]
ramas1 (N x []) = [[x]]
ramas1 (N x as) = [x : xs | a <- as, xs <- ramas1 a]

-- 2ª solución
ramas2 :: Arbol b -> [[b]]
ramas2 (N x []) = [[x]]
ramas2 (N x as) = concat (map (map (x:)) (map ramas2 as))

-- 3ª solución
ramas3 :: Arbol b -> [[b]]
ramas3 (N x []) = [[x]]
ramas3 (N x as) = concat (map (map (x:) . ramas3) as)

-- 4ª solución
ramas4 :: Arbol b -> [[b]]
ramas4 (N x []) = [[x]]
ramas4 (N x as) = concatMap (map (x:) . ramas4) as

-- 5ª solución
ramas5 :: Arbol a -> [[a]]
ramas5 (N x []) = [[x]]
ramas5 (N x xs) = map ramas5 xs >>= map (x:)

-- Comprobación de la equivalencia de las definiciones
-- ===================================================

-- (arbolArbitrario n) es un árbol aleatorio de orden n. Por ejemplo,
--    λ> sample (arbolArbitrario 4 :: Gen (Arbol Int))
--    N 0 [N 0 []]
--    N 1 [N 1 [N (-2) [N (-1) [N (-1) [N (-1) [N 1 []]]]]],N (-1) [N 2 []]]
--    N 1 [N (-2) [],N 0 [N (-4) [N (-2) []]]]
--    N (-4) [N 1 [],N 0 [N 6 [N (-4) []],N 2 [N 3 []]]]
--    N (-7) [N (-7) [N (-3) []]]
--    N (-2) [N (-8) []]
--    N (-3) [N 3 [N 2 []]]
--    N (-12) [N 5 [],N 0 []]
--    N 14 [N 13 [N (-12) []],N 11 [],N 8 [N (-13) []]]
--    N (-12) [N (-6) [N 16 [N (-14) [N (-1) []]]]]
--    N (-5) []
arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)
arbolArbitrario n = do
  x  <- arbitrary
  ms <- sublistOf [0 .. n `div` 2]
  as <- mapM arbolArbitrario ms
  return (N x as)

-- Arbol es una subclase de Arbitraria
instance Arbitrary a => Arbitrary (Arbol a) where
  arbitrary = sized arbolArbitrario

-- La propiedad es
prop_arbol :: Arbol Int -> Bool
prop_arbol a =
  all (== ramas1 a)
      [ramas2 a,
       ramas3 a,
       ramas4 a,
       ramas5 a]

-- La comprobación es
--    λ> quickCheck prop_arbol
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> ej600 <- generate (arbolArbitrario 600 :: Gen (Arbol Int))
--    λ> length (ramas1 ej600)
--    1262732
--    (1.92 secs, 1,700,238,488 bytes)
--    λ> length (ramas2 ej600)
--    1262732
--    (1.94 secs, 2,549,877,280 bytes)
--    λ> length (ramas3 ej600)
--    1262732
--    (1.99 secs, 2,446,508,472 bytes)
--    λ> length (ramas4 ej600)
--    1262732
--    (1.67 secs, 2,090,469,104 bytes)
--    λ> length (ramas5 ej600)
--    1262732
--    (1.66 secs, 2,112,198,232 bytes)

import Test.QuickCheck

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2 :: Arbol Int

ej1 = N 1 [N 2 [],N 3 [N 4 []]]

ej2 = N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]]

-- 1ª solución

ramas1 :: Arbol b -> [[b]]

ramas1 (N x []) = [[x]]

ramas1 (N x as) = [x : xs | a <- as, xs <- ramas1 a]

-- 2ª solución

ramas2 :: Arbol b -> [[b]]

ramas2 (N x []) = [[x]]

ramas2 (N x as) = concat (map (map (x:)) (map ramas2 as))

-- 3ª solución

ramas3 :: Arbol b -> [[b]]

ramas3 (N x []) = [[x]]

ramas3 (N x as) = concat (map (map (x:) . ramas3) as)

-- 4ª solución

ramas4 :: Arbol b -> [[b]]

ramas4 (N x []) = [[x]]

ramas4 (N x as) = concatMap (map (x:) . ramas4) as

-- 5ª solución

ramas5 :: Arbol a -> [[a]]

ramas5 (N x []) = [[x]]

ramas5 (N x xs) = map ramas5 xs >>= map (x:)

-- Comprobación de la equivalencia de las definiciones

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

-- (arbolArbitrario n) es un árbol aleatorio de orden n. Por ejemplo,

-- λ> sample (arbolArbitrario 4 :: Gen (Arbol Int))

-- N 0 [N 0 []]

-- N 1 [N 1 [N (-2) [N (-1) [N (-1) [N (-1) [N 1 []]]]]],N (-1) [N 2 []]]

-- N 1 [N (-2) [],N 0 [N (-4) [N (-2) []]]]

-- N (-4) [N 1 [],N 0 [N 6 [N (-4) []],N 2 [N 3 []]]]

-- N (-7) [N (-7) [N (-3) []]]

-- N (-2) [N (-8) []]

-- N (-3) [N 3 [N 2 []]]

-- N (-12) [N 5 [],N 0 []]

-- N 14 [N 13 [N (-12) []],N 11 [],N 8 [N (-13) []]]

-- N (-12) [N (-6) [N 16 [N (-14) [N (-1) []]]]]

-- N (-5) []

arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)

arbolArbitrario n = do

x <- arbitrary

ms <- sublistOf [0 .. n `div` 2]

as <- mapM arbolArbitrario ms

return (N x as)

-- Arbol es una subclase de Arbitraria

instance Arbitrary a => Arbitrary (Arbol a) where

arbitrary = sized arbolArbitrario

-- La propiedad es

prop_arbol :: Arbol Int -> Bool

prop_arbol a =

all (== ramas1 a)

[ramas2 a,

ramas3 a,

ramas4 a,

ramas5 a]

-- La comprobación es

-- λ> quickCheck prop_arbol

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> ej600 <- generate (arbolArbitrario 600 :: Gen (Arbol Int))

-- λ> length (ramas1 ej600)

-- 1262732

-- (1.92 secs, 1,700,238,488 bytes)

-- λ> length (ramas2 ej600)

-- 1262732

-- (1.94 secs, 2,549,877,280 bytes)

-- λ> length (ramas3 ej600)

-- 1262732

-- (1.99 secs, 2,446,508,472 bytes)

-- λ> length (ramas4 ej600)

-- 1262732

-- (1.67 secs, 2,090,469,104 bytes)

-- λ> length (ramas5 ej600)

-- 1262732

-- (1.66 secs, 2,112,198,232 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Valores de polinomios representados con vectores

PorJosé A. Alonso 14-marzo-202215-abril-2022

Los polinomios se pueden representar mediante vectores usando la librería Data.Array. En primer lugar, se define el tipo de los polinomios (con coeficientes de tipo a) mediante

   type Polinomio a = Array Int a

1	type Polinomio a = Array Int a

Como ejemplos, definimos el polinomio

   ej_pol1 :: Array Int Int
   ej_pol1 = array (0,4) [(0,6),(1,2),(2,-5),(3,0),(4,7)]

1 2	ej_pol1 :: Array Int Int ej_pol1 = array (0,4) [(0,6),(1,2),(2,-5),(3,0),(4,7)]

que representa a 6 + 2x – 5x^2 + 7x^4 y el polinomio

   ej_pol2 :: Array Int Double
   ej_pol2 = array (0,4) [(0,6.5),(1,2),(2,-5.2),(3,0),(4,7)]

1 2	ej_pol2 :: Array Int Double ej_pol2 = array (0,4) [(0,6.5),(1,2),(2,-5.2),(3,0),(4,7)]

que representa a 6.5 + 2x – 5.2x^2 + 7x^4

Definir la función

   valor :: Num a => Polinomio a -> a -> a

1	valor :: Num a => Polinomio a -> a -> a

tal que (valor p b) es el valor del polinomio p en el punto b. Por ejemplo,

   valor ej_pol1 0  ==  6
   valor ej_pol1 1  ==  10
   valor ej_pol1 2  ==  102
   valor ej_pol2 0  ==  6.5
   valor ej_pol2 1  ==  10.3
   valor ej_pol2 3  ==  532.7
   length (show (valor (listArray (0,5*10^5) (repeat 1)) 2)) == 150516

valor ej_pol1 0 == 6

valor ej_pol1 1 == 10

valor ej_pol1 2 == 102

valor ej_pol2 0 == 6.5

valor ej_pol2 1 == 10.3

valor ej_pol2 3 == 532.7

length (show (valor (listArray (0,5*10^5) (repeat 1)) 2)) == 150516

Soluciones

import Data.List (foldl')
import Data.Array (Array, (!), array, assocs, bounds, elems, listArray)
import Test.QuickCheck

type Polinomio a = Array Int a

ej_pol1 :: Array Int Int
ej_pol1 = array (0,4) [(1,2),(2,-5),(4,7),(0,6),(3,0)]

ej_pol2 :: Array Int Double
ej_pol2 = array (0,4) [(1,2),(2,-5.2),(4,7),(0,6.5),(3,0)]

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

valor1 :: Num a => Polinomio a -> a -> a
valor1 p b = sum [(p!i)*b^i | i <- [0..n]]
  where (_,n) = bounds p

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

valor2 :: Num a => Polinomio a -> a -> a
valor2 p b = sum [(p!i)*b^i | i <- [0..length p - 1]]

-- 3ª solución
-- ===========

valor3 :: Num a => Polinomio a -> a -> a
valor3 p b = sum [v*b^i | (i,v) <- assocs p]

-- 4ª solución
-- ===========

valor4 :: Num a => Polinomio a -> a -> a
valor4 = valorLista4 . elems

valorLista4 :: Num a => [a] -> a -> a
valorLista4 xs b =
  sum [(xs !! i) * b^i | i <- [0..length xs - 1]]

-- 5ª solución
-- ===========

valor5 :: Num a => Polinomio a -> a -> a
valor5 = valorLista5 . elems

valorLista5 :: Num a => [a] -> a -> a
valorLista5 []     _ = 0
valorLista5 (x:xs) b = x + b * valorLista5 xs b

-- 6ª solución
-- ===========

valor6 :: Num a => Polinomio a -> a -> a
valor6 = valorLista6 . elems

valorLista6 :: Num a => [a] -> a -> a
valorLista6 xs b = aux xs
  where aux []     = 0
        aux (y:ys) = y + b * aux ys

-- 7ª solución
-- ===========

valor7 :: Num a => Polinomio a -> a -> a
valor7 = valorLista7 . elems

valorLista7 :: Num a => [a] -> a -> a
valorLista7 xs b = foldr (\y r -> y + b * r) 0 xs

-- 8ª solución
-- ===========

valor8 :: Num a => Polinomio a -> a -> a
valor8 = valorLista8 . elems

valorLista8 :: Num a => [a] -> a -> a
valorLista8 xs b = aux 0 (reverse xs)
  where aux r []     = r
        aux r (y:ys) = aux (y + r * b) ys

-- 9ª solución
-- ===========

valor9 :: Num a => Polinomio a -> a -> a
valor9 = valorLista9 . elems

valorLista9 :: Num a => [a] -> a -> a
valorLista9 xs b = aux 0 (reverse xs)
  where aux = foldl (\ r y -> y + r * b)

-- 10ª solución
-- ============

valor10 :: Num a => Polinomio a -> a -> a
valor10 p b =
  foldl (\ r y -> y + r * b) 0 (reverse (elems p))

-- 11ª solución
-- ============

valor11 :: Num a => Polinomio a -> a -> a
valor11 p b =
  foldl' (\ r y -> y + r * b) 0 (reverse (elems p))

-- 12ª solución
-- ============

valor12 :: Num a => Polinomio a -> a -> a
valor12 p b =
  sum (zipWith (*) (elems p) (iterate (* b) 1))

-- 13ª solución
-- ============

valor13 :: Num a => Polinomio a -> a -> a
valor13 p b =
  foldl' (+) 0 (zipWith (*) (elems p) (iterate (* b) 1))

-- Equivalencia de las definiciones
-- ================================

-- La propiedad es
prop_valor :: [Integer] -> Integer -> Bool
prop_valor xs b =
  all (== valor1 p b)
      [f p b | f <- [valor2,
                     valor3,
                     valor4,
                     valor5,
                     valor6,
                     valor7,
                     valor8,
                     valor9,
                     valor10,
                     valor11,
                     valor12,
                     valor13]]
  where p = listArray (0, length xs - 1) xs

-- La comprobación es
--    λ> quickCheck prop_valor
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> length (show (valor1 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (7.62 secs, 2,953,933,864 bytes)
--    λ> length (show (valor2 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (8.26 secs, 2,953,933,264 bytes)
--    λ> length (show (valor3 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (7.49 secs, 2,954,733,184 bytes)
--    λ> length (show (valor4 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (84.80 secs, 2,956,333,712 bytes)
--    λ> length (show (valor5 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (1.34 secs, 1,307,347,416 bytes)
--    λ> length (show (valor6 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (1.26 secs, 1,308,114,752 bytes)
--    λ> length (show (valor7 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (1.21 secs, 1,296,843,456 bytes)
--    λ> length (show (valor8 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (1.28 secs, 1,309,591,744 bytes)
--    λ> length (show (valor9 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (1.27 secs, 1,299,191,672 bytes)
--    λ> length (show (valor10 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (1.30 secs, 1,299,191,432 bytes)
--    λ> length (show (valor11 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (0.23 secs, 1,287,654,752 bytes)
--    λ> length (show (valor12 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (0.75 secs, 1,309,506,968 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

import Data.List (foldl')

import Data.Array (Array, (!), array, assocs, bounds, elems, listArray)

import Test.QuickCheck

type Polinomio a = Array Int a

ej_pol1 :: Array Int Int

ej_pol1 = array (0,4) [(1,2),(2,-5),(4,7),(0,6),(3,0)]

ej_pol2 :: Array Int Double

ej_pol2 = array (0,4) [(1,2),(2,-5.2),(4,7),(0,6.5),(3,0)]

-- 1ª solución

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

valor1 :: Num a => Polinomio a -> a -> a

valor1 p b = sum [(p!i)*b^i | i <- [0..n]]

where (_,n) = bounds p

-- 2ª solución

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

valor2 :: Num a => Polinomio a -> a -> a

valor2 p b = sum [(p!i)*b^i | i <- [0..length p - 1]]

-- 3ª solución

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

valor3 :: Num a => Polinomio a -> a -> a

valor3 p b = sum [v*b^i | (i,v) <- assocs p]

-- 4ª solución

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

valor4 :: Num a => Polinomio a -> a -> a

valor4 = valorLista4 . elems

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

valorLista4 xs b =

sum [(xs !! i) * b^i | i <- [0..length xs - 1]]

-- 5ª solución

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

valor5 :: Num a => Polinomio a -> a -> a

valor5 = valorLista5 . elems

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

valorLista5 [] _ = 0

valorLista5 (x:xs) b = x + b * valorLista5 xs b

-- 6ª solución

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

valor6 :: Num a => Polinomio a -> a -> a

valor6 = valorLista6 . elems

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

valorLista6 xs b = aux xs

where aux [] = 0

aux (y:ys) = y + b * aux ys

-- 7ª solución

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

valor7 :: Num a => Polinomio a -> a -> a

valor7 = valorLista7 . elems

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

valorLista7 xs b = foldr (\y r -> y + b * r) 0 xs

-- 8ª solución

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

valor8 :: Num a => Polinomio a -> a -> a

valor8 = valorLista8 . elems

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

valorLista8 xs b = aux 0 (reverse xs)

where aux r [] = r

aux r (y:ys) = aux (y + r * b) ys

-- 9ª solución

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

valor9 :: Num a => Polinomio a -> a -> a

valor9 = valorLista9 . elems

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

valorLista9 xs b = aux 0 (reverse xs)

where aux = foldl (\ r y -> y + r * b)

-- 10ª solución

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

valor10 :: Num a => Polinomio a -> a -> a

valor10 p b =

foldl (\ r y -> y + r * b) 0 (reverse (elems p))

-- 11ª solución

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

valor11 :: Num a => Polinomio a -> a -> a

valor11 p b =

foldl' (\ r y -> y + r * b) 0 (reverse (elems p))

-- 12ª solución

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

valor12 :: Num a => Polinomio a -> a -> a

valor12 p b =

sum (zipWith (*) (elems p) (iterate (* b) 1))

-- 13ª solución

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

valor13 :: Num a => Polinomio a -> a -> a

valor13 p b =

foldl' (+) 0 (zipWith (*) (elems p) (iterate (* b) 1))

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_valor :: [Integer] -> Integer -> Bool

prop_valor xs b =

all (== valor1 p b)

[f p b | f <- [valor2,

valor3,

valor4,

valor5,

valor6,

valor7,

valor8,

valor9,

valor10,

valor11,

valor12,

valor13]]

where p = listArray (0, length xs - 1) xs

-- La comprobación es

-- λ> quickCheck prop_valor

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (show (valor1 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (7.62 secs, 2,953,933,864 bytes)

-- λ> length (show (valor2 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (8.26 secs, 2,953,933,264 bytes)

-- λ> length (show (valor3 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (7.49 secs, 2,954,733,184 bytes)

-- λ> length (show (valor4 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (84.80 secs, 2,956,333,712 bytes)

-- λ> length (show (valor5 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (1.34 secs, 1,307,347,416 bytes)

-- λ> length (show (valor6 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (1.26 secs, 1,308,114,752 bytes)

-- λ> length (show (valor7 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (1.21 secs, 1,296,843,456 bytes)

-- λ> length (show (valor8 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (1.28 secs, 1,309,591,744 bytes)

-- λ> length (show (valor9 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (1.27 secs, 1,299,191,672 bytes)

-- λ> length (show (valor10 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (1.30 secs, 1,299,191,432 bytes)

-- λ> length (show (valor11 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (0.23 secs, 1,287,654,752 bytes)

-- λ> length (show (valor12 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (0.75 secs, 1,309,506,968 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se encuentran en el siguiente vídeo

Segmentos maximales de elementos consecutivos

PorJosé A. Alonso 11-marzo-202217-marzo-2022

Definir la función

   segmentos :: (Enum a, Eq a) => [a] -> [[a]]

1	segmentos :: (Enum a, Eq a) => [a] -> [[a]]

tal que (segmentos xss) es la lista de los segmentos maximales de xss formados por elementos consecutivos. Por ejemplo,

   segmentos [1,2,5,6,4]     ==  [[1,2],[5,6],[4]]
   segmentos [1,2,3,4,7,8,9] ==  [[1,2,3,4],[7,8,9]]
   segmentos "abbccddeeebc"  ==  ["ab","bc","cd","de","e","e","bc"]

segmentos [1,2,5,6,4] == [[1,2],[5,6],[4]]

segmentos [1,2,3,4,7,8,9] == [[1,2,3,4],[7,8,9]]

segmentos "abbccddeeebc" == ["ab","bc","cd","de","e","e","bc"]

Soluciones

[schedule expon=’2022-03-18′ expat=»06:00″]

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

[/schedule]

[schedule on=’2022-03-18′ at=»06:00″]

import Test.QuickCheck

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

segmentos1 :: (Enum a, Eq a) => [a] -> [[a]]
segmentos1 []  = []
segmentos1 xs = ys : segmentos1 zs
  where ys = inicial xs
        n  = length ys
        zs = drop n xs

-- (inicial xs) es el segmento inicial de xs formado por elementos
-- consecutivos. Por ejemplo,
--    inicial [1,2,5,6,4]    ==  [1,2]
--    inicial "abccddeeebc"  ==  "abc"
inicial :: (Enum a, Eq a) => [a] -> [a]
inicial []      = []
inicial [x]     = [x]
inicial (x:y:xs)
  | succ x == y = x : inicial (y:xs)
  | otherwise   = [x]

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

segmentos2 :: (Enum a, Eq a) => [a] -> [[a]]
segmentos2 []  = []
segmentos2 xs = ys : segmentos2 zs
  where (ys,zs) = inicialYresto xs

-- (inicialYresto xs) es par formado por el segmento inicial de xs
-- con elementos consecutivos junto con los restantes elementos. Por
-- ejemplo,
--    inicialYresto [1,2,5,6,4]    ==  ([1,2],[5,6,4])
--    inicialYresto "abccddeeebc"  ==  ("abc","cddeeebc")
inicialYresto :: (Enum a, Eq a) => [a] -> ([a],[a])
inicialYresto []      = ([],[])
inicialYresto [x]     = ([x],[])
inicialYresto (x:y:xs)
  | succ x == y = (x:us,vs)
  | otherwise   = ([x],y:xs)
  where (us,vs) = inicialYresto (y:xs)

-- 3ª solución
-- ===========

segmentos3 :: (Enum a, Eq a) => [a] -> [[a]]
segmentos3 []  = []
segmentos3 [x] = [[x]]
segmentos3 (x:xs) | y == succ x = (x:y:ys):zs
                  | otherwise   = [x] : (y:ys):zs
  where ((y:ys):zs) = segmentos3 xs

-- 4ª solución
-- ===========

segmentos4 :: (Enum a, Eq a) => [a] -> [[a]]
segmentos4 []  = []
segmentos4 xs = ys : segmentos4 zs
  where ys = inicial4 xs
        n  = length ys
        zs = drop n xs

inicial4 :: (Enum a, Eq a) => [a] -> [a]
inicial4 [] = []
inicial4 (x:xs) =
  map fst (takeWhile (\(u,v) -> u == v) (zip (x:xs) [x..]))

-- 5ª solución
-- ===========

segmentos5 :: (Enum a, Eq a) => [a] -> [[a]]
segmentos5 []  = []
segmentos5 xs = ys : segmentos5 zs
  where ys = inicial5 xs
        n  = length ys
        zs = drop n xs

inicial5 :: (Enum a, Eq a) => [a] -> [a]
inicial5 [] = []
inicial5 (x:xs) =
  map fst (takeWhile (uncurry (==)) (zip (x:xs) [x..]))

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_segmentos :: [Int] -> Bool
prop_segmentos xs =
  all (== segmentos1 xs)
      [segmentos2 xs,
       segmentos3 xs,
       segmentos4 xs,
       segmentos5 xs]

-- La comprobación es
--    λ> quickCheck prop_segmentos
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> length (segmentos1 (take (10^6) (cycle [1..10^3])))
--    1000
--    (0.69 secs, 416,742,208 bytes)
--    λ> length (segmentos2 (take (10^6) (cycle [1..10^3])))
--    1000
--    (0.66 secs, 528,861,976 bytes)
--    λ> length (segmentos3 (take (10^6) (cycle [1..10^3])))
--    1000
--    (2.35 secs, 1,016,276,896 bytes)
--    λ> length (segmentos4 (take (10^6) (cycle [1..10^3])))
--    1000
--    (0.27 secs, 409,438,368 bytes)
--    λ> length (segmentos5 (take (10^6) (cycle [1..10^3])))
--    1000
--    (0.13 secs, 401,510,360 bytes)
--
--    λ> length (segmentos4 (take (10^7) (cycle [1..10^3])))
--    10000
--    (2.35 secs, 4,088,926,920 bytes)
--    λ> length (segmentos5 (take (10^7) (cycle [1..10^3])))
--    10000
--    (1.02 secs, 4,009,646,928 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

import Test.QuickCheck

-- 1ª solución

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

segmentos1 :: (Enum a, Eq a) => [a] -> [[a]]

segmentos1 [] = []

segmentos1 xs = ys : segmentos1 zs

where ys = inicial xs

n = length ys

zs = drop n xs

-- (inicial xs) es el segmento inicial de xs formado por elementos

-- consecutivos. Por ejemplo,

-- inicial [1,2,5,6,4] == [1,2]

-- inicial "abccddeeebc" == "abc"

inicial :: (Enum a, Eq a) => [a] -> [a]

inicial [] = []

inicial [x] = [x]

inicial (x:y:xs)

| succ x == y = x : inicial (y:xs)

| otherwise = [x]

-- 2ª solución

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

segmentos2 :: (Enum a, Eq a) => [a] -> [[a]]

segmentos2 [] = []

segmentos2 xs = ys : segmentos2 zs

where (ys,zs) = inicialYresto xs

-- (inicialYresto xs) es par formado por el segmento inicial de xs

-- con elementos consecutivos junto con los restantes elementos. Por

-- ejemplo,

-- inicialYresto [1,2,5,6,4] == ([1,2],[5,6,4])

-- inicialYresto "abccddeeebc" == ("abc","cddeeebc")

inicialYresto :: (Enum a, Eq a) => [a] -> ([a],[a])

inicialYresto [] = ([],[])

inicialYresto [x] = ([x],[])

inicialYresto (x:y:xs)

| succ x == y = (x:us,vs)

| otherwise = ([x],y:xs)

where (us,vs) = inicialYresto (y:xs)

-- 3ª solución

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

segmentos3 :: (Enum a, Eq a) => [a] -> [[a]]

segmentos3 [] = []

segmentos3 [x] = [[x]]

segmentos3 (x:xs) | y == succ x = (x:y:ys):zs

| otherwise = [x] : (y:ys):zs

where ((y:ys):zs) = segmentos3 xs

-- 4ª solución

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

segmentos4 :: (Enum a, Eq a) => [a] -> [[a]]

segmentos4 [] = []

segmentos4 xs = ys : segmentos4 zs

where ys = inicial4 xs

n = length ys

zs = drop n xs

inicial4 :: (Enum a, Eq a) => [a] -> [a]

inicial4 [] = []

inicial4 (x:xs) =

map fst (takeWhile (\(u,v) -> u == v) (zip (x:xs) [x..]))

-- 5ª solución

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

segmentos5 :: (Enum a, Eq a) => [a] -> [[a]]

segmentos5 [] = []

segmentos5 xs = ys : segmentos5 zs

where ys = inicial5 xs

n = length ys

zs = drop n xs

inicial5 :: (Enum a, Eq a) => [a] -> [a]

inicial5 [] = []

inicial5 (x:xs) =

map fst (takeWhile (uncurry (==)) (zip (x:xs) [x..]))

-- Comprobación de equivalencia

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

-- La propiedad es

prop_segmentos :: [Int] -> Bool

prop_segmentos xs =

all (== segmentos1 xs)

[segmentos2 xs,

segmentos3 xs,

segmentos4 xs,

segmentos5 xs]

-- La comprobación es

-- λ> quickCheck prop_segmentos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (segmentos1 (take (10^6) (cycle [1..10^3])))

-- 1000

-- (0.69 secs, 416,742,208 bytes)

-- λ> length (segmentos2 (take (10^6) (cycle [1..10^3])))

-- 1000

-- (0.66 secs, 528,861,976 bytes)

-- λ> length (segmentos3 (take (10^6) (cycle [1..10^3])))

-- 1000

-- (2.35 secs, 1,016,276,896 bytes)

-- λ> length (segmentos4 (take (10^6) (cycle [1..10^3])))

-- 1000

-- (0.27 secs, 409,438,368 bytes)

-- λ> length (segmentos5 (take (10^6) (cycle [1..10^3])))

-- 1000

-- (0.13 secs, 401,510,360 bytes)

-- λ> length (segmentos4 (take (10^7) (cycle [1..10^3])))

-- 10000

-- (2.35 secs, 4,088,926,920 bytes)

-- λ> length (segmentos5 (take (10^7) (cycle [1..10^3])))

-- 10000

-- (1.02 secs, 4,009,646,928 bytes)

El código se encuentra en [GitHub](https://github.com/jaalonso/Exercitium/blob/main/src/Segmentos_consecutivos.hs).

La elaboración de las soluciones explica en el siguiente vídeo:

[/schedule]

Lista cuadrada

PorJosé A. Alonso 10-marzo-202217-marzo-2022

Definir la función

   listaCuadrada :: Int -> a -> [a] -> [[a]]

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

tal que (listaCuadrada n x xs) es una lista de n listas de longitud n formadas con los elementos de xs completada con x, si no xs no tiene suficientes elementos. Por ejemplo,

   listaCuadrada 3 7 [0,3,5,2,4]  ==  [[0,3,5],[2,4,7],[7,7,7]]
   listaCuadrada 3 7 [0..]        ==  [[0,1,2],[3,4,5],[6,7,8]]
   listaCuadrada 2 'p' "eva"      ==  ["ev","ap"]
   listaCuadrada 2 'p' ['a'..]    ==  ["ab","cd"]

listaCuadrada 3 7 [0,3,5,2,4] == [[0,3,5],[2,4,7],[7,7,7]]

listaCuadrada 3 7 [0..] == [[0,1,2],[3,4,5],[6,7,8]]

listaCuadrada 2 'p' "eva" == ["ev","ap"]

listaCuadrada 2 'p' ['a'..] == ["ab","cd"]

Soluciones

import Data.List.Split (chunksOf)
import Test.QuickCheck

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

listaCuadrada1 :: Int -> a -> [a] -> [[a]]
listaCuadrada1 n x xs =
  take n (grupos n (xs ++ repeat x))

-- (grupos n xs) es la lista obtenida agrupando los elementos de xs en
-- grupos de n elementos, salvo el último que puede tener menos. Por
-- ejemplo,
--    grupos 2 [4,2,5,7,6]     ==  [[4,2],[5,7],[6]]
--    take 3 (grupos 3 [1..])  ==  [[1,2,3],[4,5,6],[7,8,9]]
grupos :: Int -> [a] -> [[a]]
grupos _ [] = []
grupos n xs = take n xs : grupos n (drop n xs)

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

listaCuadrada2 :: Int -> a -> [a] -> [[a]]
listaCuadrada2 n x xs =
  take n (grupos2 n (xs ++ repeat x))

grupos2 :: Int -> [a] -> [[a]]
grupos2 _ [] = []
grupos2 n xs = ys : grupos n zs
  where (ys,zs) = splitAt n xs

-- 3ª solución
-- ===========

listaCuadrada3 :: Int -> a -> [a] -> [[a]]
listaCuadrada3 n x xs =
  take n (chunksOf n (xs ++ repeat x))

-- Comprobación de la equivalencia
-- ===============================

-- La propiedad es
prop_listaCuadrada :: Int -> Int -> [Int] -> Bool
prop_listaCuadrada n x xs =
  all (== listaCuadrada1 n x xs)
      [listaCuadrada2 n x xs,
       listaCuadrada3 n x xs]

-- La comprobación es
--    λ> quickCheck prop_listaCuadrada
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> length (listaCuadrada1 (10^4) 5 [1..])
--    10000
--    (2.02 secs, 12,801,918,616 bytes)
--    λ> length (listaCuadrada2 (10^4) 5 [1..])
--    10000
--    (1.89 secs, 12,803,198,576 bytes)
--    λ> length (listaCuadrada3 (10^4) 5 [1..])
--    10000
--    (1.85 secs, 12,801,518,728 bytes)

import Data.List.Split (chunksOf)

import Test.QuickCheck

-- 1ª solución

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

listaCuadrada1 :: Int -> a -> [a] -> [[a]]

listaCuadrada1 n x xs =

take n (grupos n (xs ++ repeat x))

-- (grupos n xs) es la lista obtenida agrupando los elementos de xs en

-- grupos de n elementos, salvo el último que puede tener menos. Por

-- ejemplo,

-- grupos 2 [4,2,5,7,6] == [[4,2],[5,7],[6]]

-- take 3 (grupos 3 [1..]) == [[1,2,3],[4,5,6],[7,8,9]]

grupos :: Int -> [a] -> [[a]]

grupos _ [] = []

grupos n xs = take n xs : grupos n (drop n xs)

-- 2ª solución

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

listaCuadrada2 :: Int -> a -> [a] -> [[a]]

listaCuadrada2 n x xs =

take n (grupos2 n (xs ++ repeat x))

grupos2 :: Int -> [a] -> [[a]]

grupos2 _ [] = []

grupos2 n xs = ys : grupos n zs

where (ys,zs) = splitAt n xs

-- 3ª solución

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

listaCuadrada3 :: Int -> a -> [a] -> [[a]]

listaCuadrada3 n x xs =

take n (chunksOf n (xs ++ repeat x))

-- Comprobación de la equivalencia

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

-- La propiedad es

prop_listaCuadrada :: Int -> Int -> [Int] -> Bool

prop_listaCuadrada n x xs =

all (== listaCuadrada1 n x xs)

[listaCuadrada2 n x xs,

listaCuadrada3 n x xs]

-- La comprobación es

-- λ> quickCheck prop_listaCuadrada

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (listaCuadrada1 (10^4) 5 [1..])

-- 10000

-- (2.02 secs, 12,801,918,616 bytes)

-- λ> length (listaCuadrada2 (10^4) 5 [1..])

-- 10000

-- (1.89 secs, 12,803,198,576 bytes)

-- λ> length (listaCuadrada3 (10^4) 5 [1..])

-- 10000

-- (1.85 secs, 12,801,518,728 bytes)

El código se encuentra en GitHub.

La elaboración de la solución se muestra en el siguiente vídeo:

Máximos locales

PorJosé A. Alonso 9-marzo-202216-marzo-2022

Un máximo local de una lista es un elemento de la lista que es mayor que su predecesor y que su sucesor en la lista. Por ejemplo, 5 es un máximo local de [3,2,5,3,7,7,1,6,2] ya que es mayor que 2 (su predecesor) y que 3 (su sucesor).

Definir la función

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

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

tal que (maximosLocales xs) es la lista de los máximos locales de la lista xs. Por ejemplo,

   maximosLocales [3,2,5,3,7,7,1,6,2]  ==  [5,6]
   maximosLocales [1..100]             ==  []
   maximosLocales "adbpmqexyz"         ==  "dpq"

maximosLocales [3,2,5,3,7,7,1,6,2] == [5,6]

maximosLocales [1..100] == []

maximosLocales "adbpmqexyz" == "dpq"

Soluciones

import Test.QuickCheck

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

maximosLocales1 :: Ord a => [a] -> [a]
maximosLocales1 (x:y:z:xs)
  | y > x && y > z = y : maximosLocales1 (z:xs)
  | otherwise      = maximosLocales1 (y:z:xs)
maximosLocales1 _ = []

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

maximosLocales2 :: Ord a => [a] -> [a]
maximosLocales2 xs =
  [y | (x,y,z) <- zip3 xs (tail xs) (drop 2 xs), y > x, y > z]

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_maximosLocales :: [Int] -> Property
prop_maximosLocales xs =
  maximosLocales1 xs === maximosLocales2 xs

-- La comprobación es
--    λ> quickCheck prop_maximosLocales
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> last (maximosLocales1 (take (6*10^6) (cycle "abc")))
--    'c'
--    (3.26 secs, 1,904,464,984 bytes)
--    λ> last (maximosLocales2 (take (6*10^6) (cycle "abc")))
--    'c'
--    (2.79 secs, 1,616,465,088 bytes)

import Test.QuickCheck

-- 1ª solución

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

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

maximosLocales1 (x:y:z:xs)

| y > x && y > z = y : maximosLocales1 (z:xs)

| otherwise = maximosLocales1 (y:z:xs)

maximosLocales1 _ = []

-- 2ª solución

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

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

maximosLocales2 xs =

[y | (x,y,z) <- zip3 xs (tail xs) (drop 2 xs), y > x, y > z]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_maximosLocales :: [Int] -> Property

prop_maximosLocales xs =

maximosLocales1 xs === maximosLocales2 xs

-- La comprobación es

-- λ> quickCheck prop_maximosLocales

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (maximosLocales1 (take (6*10^6) (cycle "abc")))

-- 'c'

-- (3.26 secs, 1,904,464,984 bytes)

-- λ> last (maximosLocales2 (take (6*10^6) (cycle "abc")))

-- 'c'

-- (2.79 secs, 1,616,465,088 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se encuentran en el siguiente vídeo:

Ampliación de matrices por columnas

Soluciones

Nuevas soluciones

Emparejamiento binario

Soluciones

Nuevas soluciones

Ordenación de estructuras

Soluciones

Numeración de las ternas de números naturales

Soluciones

Alfabeto comenzando en un carácter

Soluciones

Ramas de un árbol

Soluciones

Valores de polinomios representados con vectores

Soluciones

Segmentos maximales de elementos consecutivos

Soluciones

Lista cuadrada

Soluciones

Máximos locales

Soluciones

Entradas recientes

Buscar

Correo electrónico