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

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

Entradas recientes

Buscar

Correo electrónico