Menu Close

Etiqueta: Test.QuickCheck

Mínimo producto escalar

José A. Alonso, ,

El producto escalar de los vectores [a1,a2,…,an] y [b1,b2,…, bn] es

   a1 * b1 + a2 * b2 + ··· + an * bn.

Definir la función

   menorProductoEscalar :: (Ord a, Num a) => [a] -> [a] -> a

tal que (menorProductoEscalar xs ys) es el mínimo de los productos escalares de las permutaciones de xs y de las permutaciones de ys. Por ejemplo,

   menorProductoEscalar [3,2,5]  [1,4,6]    == 29
   menorProductoEscalar [3,2,5]  [1,4,-6]   == -19
   menorProductoEscalar [1..10^2] [1..10^2] == 171700
   menorProductoEscalar [1..10^3] [1..10^3] == 167167000
   menorProductoEscalar [1..10^4] [1..10^4] == 166716670000
   menorProductoEscalar [1..10^5] [1..10^5] == 166671666700000
   menorProductoEscalar [1..10^6] [1..10^6] == 166667166667000000

Soluciones

module Minimo_producto_escalar where
 
import Data.List (sort, permutations)
import Test.QuickCheck (quickCheck)
 
-- 1ª solución
-- ===========
 
menorProductoEscalar1 :: (Ord a, Num a) => [a] -> [a] -> a
menorProductoEscalar1 xs ys =
  minimum [sum (zipWith (*) pxs pys) | pxs <- permutations xs,
                                       pys <- permutations ys]
 
-- 2ª solución
-- ===========
 
menorProductoEscalar2 :: (Ord a, Num a) => [a] -> [a] -> a
menorProductoEscalar2 xs ys =
  minimum [sum (zipWith (*) pxs ys) | pxs <- permutations xs]
 
-- 3ª solución
-- ===========
 
menorProductoEscalar3 :: (Ord a, Num a) => [a] -> [a] -> a
menorProductoEscalar3 xs ys =
  sum (zipWith (*) (sort xs) (reverse (sort ys)))
 
-- Equivalencia
-- ============
 
-- La propiedad es
prop_menorProductoEscalar :: [Integer] -> [Integer] -> Bool
prop_menorProductoEscalar xs ys =
  all (== menorProductoEscalar1 xs' ys')
      [menorProductoEscalar2 xs' ys',
       menorProductoEscalar3 xs' ys']
  where n   = min (length xs) (length ys)
        xs' = take n xs
        ys' = take n ys
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=7}) prop_menorProductoEscalar
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> menorProductoEscalar1 [0..5] [0..5]
--    20
--    (3.24 secs, 977385528 bytes)
--    λ> menorProductoEscalar2 [0..5] [0..5]
--    20
--    (0.01 secs, 4185776 bytes)
--
--    λ> menorProductoEscalar2 [0..9] [0..9]
--    120
--    (23.86 secs, 9342872784 bytes)
--    λ> menorProductoEscalar3 [0..9] [0..9]
--    120
--    (0.01 secs, 2580824 bytes)
--
--    λ> menorProductoEscalar3 [0..10^6] [0..10^6]
--    166666666666500000
--    (2.46 secs, 473,338,912 bytes)

El código se encuentra en GitHub.

Leer más →

Puntos en regiones rectangulares

José A. Alonso, ,

Los puntos se puede representar mediante pares de números

   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)

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

   enRegion :: Punto -> Region -> Bool

tal que (enRegion p r) se verifica si el punto p pertenece a 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)

se tiene

   enRegion (1,0) r0021                                   ==  True
   enRegion (3,0) r0021                                   ==  False
   enRegion (1,1) (Union r0021 r3051)                     ==  True
   enRegion (4,0) (Union r0021 r3051)                     ==  True
   enRegion (4,2) (Union r0021 r3051)                     ==  False
   enRegion (3,1) (Diferencia r3051 r4162)                ==  True
   enRegion (4,1) (Diferencia r3051 r4162)                ==  False
   enRegion (4,2) (Diferencia r3051 r4162)                ==  False
   enRegion (4,2) (Union (Diferencia r3051 r4162) r4162)  ==  True

Comprobar con QuickCheck que si el punto p está en la región r1, entonces, para cualquier región r2, p está en (Union  r1 r2) y en (Union  r2 r1), pero no está en (Diferencia r2 r1).

Soluciones

module Puntos_en_regiones_rectangulares where
 
import Test.QuickCheck (Arbitrary, Gen, Property, (==>), arbitrary, oneof,
                        sized, generate, quickCheck, quickCheckWith, stdArgs,
                        Args(maxDiscardRatio))
 
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)
 
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)
 
-- (regionArbitraria n) es un generador de regiones arbitrarias de orden
-- n. Por ejemplo,
--    λ> generate (regionArbitraria 2)
--    Rectangulo (30,-26) (-2,-8)
--    λ> generate (regionArbitraria 2)
--    Union (Union (Rectangulo (-2,-5) (6,1)) (Rectangulo(3,7) (11,15)))
--          (Diferencia (Rectangulo (9,8) (-2,6)) (Rectangulo (-2,2) (7,8)))
regionArbitraria :: Int -> Gen Region
regionArbitraria 0 =
  Rectangulo <$> arbitrary <*> arbitrary
regionArbitraria n =
  oneof [Rectangulo <$> arbitrary <*> arbitrary,
         Union <$> subregion <*> subregion,
         Diferencia <$> subregion <*> subregion]
  where subregion = regionArbitraria (n `div` 2)
 
-- Region está contenida en Arbitrary
instance Arbitrary Region where
  arbitrary = sized regionArbitraria
 
-- La propiedad es
prop_enRegion :: Punto -> Region -> Region -> Property
prop_enRegion p r1 r2 =
  enRegion p r1 ==>
  (enRegion p (Union  r1 r2) &&
   enRegion p (Union  r2 r1) &&
   not (enRegion p (Diferencia r2 r1)))
 
-- La comprobación es
--    λ> quickCheck prop_enRegion
--    *** Gave up! Passed only 78 tests; 1000 discarded tests.
--
--    λ> quickCheckWith (stdArgs {maxDiscardRatio=20}) prop_enRegion
--    +++ OK, passed 100 tests.

El código se encuentra en GitHub.

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

Leer más →

Clausura de un conjunto respecto de una función

José A. Alonso, ,

Un conjunto A está cerrado respecto de una función f si para elemento x de A se tiene que f(x) pertenece a A. La clausura de un conjunto B respecto de una función f es el menor conjunto A que contiene a B y es cerrado respecto de f. Por ejemplo, la clausura de {0,1,2] respecto del opuesto es {-2,-1,0,1,2}.

Definir la función

   clausura :: Ord a => (a -> a) -> [a] -> [a]

tal que (clausura f xs) es la clausura de xs respecto de f. Por ejemplo,

   clausura (\x -> -x) [0,1,2]         ==  [-2,-1,0,1,2]
   clausura (\x -> (x+1) `mod` 5) [0]  ==  [0,1,2,3,4]
   length (clausura (\x -> (x+1) `mod` (10^6)) [0]) == 1000000

Soluciones

module Clausura where
 
import Data.List ((\\), nub, sort, union)
import Test.QuickCheck.HigherOrder (quickCheck')
import qualified Data.Set as S (Set, difference, fromList, map, null, toList, union)
 
-- 1ª solución
-- ===========
 
clausura1 :: Ord a => (a -> a) -> [a] -> [a]
clausura1 f xs
  | esCerrado f xs = sort xs
  | otherwise      = clausura1 f (expansion f xs)
 
-- (esCerrado f xs) se verifica si al aplicar f a cualquier elemento de
-- xs se obtiene un elemento de xs. Por ejemplo,
--    λ> esCerrado (\x -> -x) [0,1,2]
--    False
--    λ> esCerrado (\x -> -x) [0,1,2,-2,-1]
--    True
esCerrado :: Ord a => (a -> a) -> [a] -> Bool
esCerrado f xs = all (`elem` xs) (map f xs)
 
-- (expansion f xs) es la lista (sin repeticiones) obtenidas añadiéndole
-- a xs el resulta de aplicar f a sus elementos. Por ejemplo,
--    expansion (\x -> -x) [0,1,2]  ==  [0,1,2,-1,-2]
expansion :: Ord a => (a -> a) -> [a] -> [a]
expansion f xs = xs `union` map f xs
 
-- 2ª solución
-- ===========
 
clausura2 :: Ord a => (a -> a) -> [a] -> [a]
clausura2 f xs = sort (until (esCerrado f) (expansion f) xs)
 
-- 3ª solución
-- ===========
 
clausura3 :: Ord a => (a -> a) -> [a] -> [a]
clausura3 f xs = aux xs xs
  where aux ys vs | null ns   = sort vs
                  | otherwise = aux ns (vs ++ ns)
          where ns = nub (map f ys) \\ vs
 
-- 4ª solución
-- ===========
 
clausura4 :: Ord a => (a -> a) -> [a] -> [a]
clausura4 f xs = S.toList (clausura4' f (S.fromList xs))
 
clausura4' :: Ord a => (a -> a) -> S.Set a -> S.Set a
clausura4' f xs = aux xs xs
  where aux ys vs | S.null ns = vs
                  | otherwise = aux ns (vs `S.union` ns)
          where ns = S.map f ys `S.difference` vs
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_clausura :: (Int -> Int) -> [Int] -> Bool
prop_clausura f xs =
  all (== clausura1 f xs')
      [ clausura2 f xs'
      , clausura3 f xs'
      , clausura4 f xs'
      ]
  where xs' = sort (nub xs)
 
-- La comprobación es
--    λ> quickCheck' prop_clausura
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> length (clausura1 (\x -> (x+1) `mod` 800) [0])
--    800
--    (1.95 secs, 213,481,560 bytes)
--    λ> length (clausura2 (\x -> (x+1) `mod` 800) [0])
--    800
--    (1.96 secs, 213,372,824 bytes)
--    λ> length (clausura3 (\x -> (x+1) `mod` 800) [0])
--    800
--    (0.03 secs, 42,055,128 bytes)
--    λ> length (clausura4 (\x -> (x+1) `mod` 800) [0])
--    800
--    (0.01 secs, 1,779,768 bytes)
--
--    λ> length (clausura3 (\x -> (x+1) `mod` (10^4)) [0])
--    10000
--    (2.50 secs, 8,080,105,816 bytes)
--    λ> length (clausura4 (\x -> (x+1) `mod` (10^4)) [0])
--    10000
--    (0.05 secs, 27,186,920 bytes)

El código se encuentra en GitHub.

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

Leer más →

Números con todos sus dígitos primos

José A. Alonso, ,

Definir la lista

   numerosConDigitosPrimos :: [Integer]

cuyos elementos son los números con todos sus dígitos primos. Por ejemplo,

   λ> take 22 numerosConDigitosPrimos
   [2,3,5,7,22,23,25,27,32,33,35,37,52,53,55,57,72,73,75,77,222,223]
   λ> numerosConDigitosPrimos !! (10^7)
   322732232572

Soluciones

module Numeros_con_digitos_primos where
 
import Test.QuickCheck (NonNegative (NonNegative), quickCheck)
import Data.Char (intToDigit)
 
-- 1ª solución
-- ===========
 
numerosConDigitosPrimos1 :: [Integer]
numerosConDigitosPrimos1 = [n | n <- [2..], digitosPrimos n]
 
-- (digitosPrimos n) se verifica si todos los dígitos de n son
-- primos. Por ejemplo,
--    digitosPrimos 352  ==  True
--    digitosPrimos 362  ==  False
digitosPrimos :: Integer -> Bool
digitosPrimos n = subconjunto (digitos n) [2,3,5,7]
 
-- (digitos n) es la lista de las digitos de n. Por ejemplo,
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Integer]
digitos n = [read [x] | x <- show n]
 
-- (subconjunto xs ys) se verifica si xs es un subconjunto de ys. Por
-- ejemplo,
--    subconjunto [3,2,5,2] [2,7,3,5]  ==  True
--    subconjunto [3,2,5,2] [2,7,2,5]  ==  False
subconjunto :: Eq a => [a] -> [a] -> Bool
subconjunto xs ys = and [x `elem` ys | x <- xs]
 
-- 2ª solución
-- ===========
 
numerosConDigitosPrimos2 :: [Integer]
numerosConDigitosPrimos2 =
  filter (all (`elem` "2357") . show) [2..]
 
-- 3ª solución
-- ===========
 
--    λ> take 60 numerosConDigitosPrimos2
--    [  2,  3,  5,  7,
--      22, 23, 25, 27,
--      32, 33, 35, 37,
--      52, 53, 55, 57,
--      72, 73, 75, 77,
--     222,223,225,227,
--     232,233,235,237,
--     252,253,255,257,
--     272,273,275,277,
--     322,323,325,327,
--     332,333,335,337,
--     352,353,355,357,
--     372,373,375,377,
--     522,523,525,527,
--     532,533,535,537]
 
numerosConDigitosPrimos3 :: [Integer]
numerosConDigitosPrimos3 =
  [2,3,5,7] ++ [10*n+d | n <- numerosConDigitosPrimos3, d <- [2,3,5,7]]
 
-- 4ª solución
-- ===========
 
--    λ> take 60 numerosConDigitosPrimos2
--    [ 2, 3, 5, 7,
--     22,23,25,27,
--     32,33,35,37,
--     52,53,55,57,
--     72,73,75,77,
--     222,223,225,227, 232,233,235,237, 252,253,255,257, 272,273,275,277,
--     322,323,325,327, 332,333,335,337, 352,353,355,357, 372,373,375,377,
--     522,523,525,527, 532,533,535,537]
 
numerosConDigitosPrimos4 :: [Integer]
numerosConDigitosPrimos4 = concat (iterate siguiente [2,3,5,7])
 
-- (siguiente xs) es la lista obtenida añadiendo delante de cada
-- elemento de xs los dígitos 2, 3, 5 y 7. Por ejemplo,
--    λ> siguiente [5,6,8]
--    [25,26,28,
--     35,36,38,
--     55,56,58,
--     75,76,78]
siguiente :: [Integer] -> [Integer]
siguiente xs = concat [map (pega d) xs | d <- [2,3,5,7]]
 
-- (pega d n) es el número obtenido añadiendo el dígito d delante del
-- número n. Por ejemplo,
--    pega 3 35  ==  335
pega :: Int -> Integer -> Integer
pega d n = read (intToDigit d : show n)
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_numerosConDigitosPrimos :: NonNegative Int -> Bool
prop_numerosConDigitosPrimos (NonNegative n) =
  all (== numerosConDigitosPrimos1 !! n)
      [ numerosConDigitosPrimos2 !! n
      , numerosConDigitosPrimos3 !! n
      , numerosConDigitosPrimos4 !! n
      ]
 
-- La comprobación es
--    λ> quickCheck prop_numerosConDigitosPrimos
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> numerosConDigitosPrimos1 !! 5000
--    752732
--    (2.45 secs, 6,066,926,272 bytes)
--    λ> numerosConDigitosPrimos2 !! 5000
--    752732
--    (0.34 secs, 387,603,456 bytes)
--    λ> numerosConDigitosPrimos3 !! 5000
--    752732
--    (0.01 secs, 1,437,624 bytes)
--    λ> numerosConDigitosPrimos4 !! 5000
--    752732
--    (0.00 secs, 1,556,104 bytes)
--
--    λ> numerosConDigitosPrimos3 !! (10^7)
--    322732232572
--    (3.94 secs, 1,820,533,328 bytes)
--    λ> numerosConDigitosPrimos4 !! (10^7)
--    322732232572
--    (1.84 secs, 2,000,606,640 bytes)

El código se encuentra en GitHub.

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

Leer más →

Producto cartesiano de una familia de conjuntos

José A. Alonso, ,

Definir la función

   producto :: [[a]] -> [[a]]

tal que (producto xss) es el producto cartesiano de los conjuntos xss. Por ejemplo,

   λ> producto [[1,3],[2,5]]
   [[1,2],[1,5],[3,2],[3,5]]
   λ> producto [[1,3],[2,5],[6,4]]
   [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]
   λ> producto [[1,3,5],[2,4]]
   [[1,2],[1,4],[3,2],[3,4],[5,2],[5,4]]
   λ> producto []
   [[]]

Comprobar con QuickCheck que para toda lista de listas de números enteros, xss, se verifica que el número de elementos de (producto xss) es igual al producto de los números de elementos de cada una de las listas de xss.

Soluciones

module Producto_cartesiano where
 
import Test.QuickCheck (quickCheck)
import Control.Monad (liftM2)
import Control.Applicative (liftA2)
 
-- 1ª solución
-- ===========
 
producto1 :: [[a]] -> [[a]]
producto1 []       = [[]]
producto1 (xs:xss) = [x:ys | x <- xs, ys <- producto1 xss]
 
-- 2ª solución
-- ===========
 
producto2 :: [[a]] -> [[a]]
producto2 []       = [[]]
producto2 (xs:xss) = [x:ys | x <- xs, ys <- ps]
  where ps = producto2 xss
 
-- 3ª solución
-- ===========
 
producto3 :: [[a]] -> [[a]]
producto3 []       = [[]]
producto3 (xs:xss) = inserta3 xs (producto3 xss)
 
-- (inserta xs xss) inserta cada elemento de xs en los elementos de
-- xss. Por ejemplo,
--    λ> inserta [1,2] [[3,4],[5,6]]
--    [[1,3,4],[1,5,6],[2,3,4],[2,5,6]]
inserta3 :: [a] -> [[a]] -> [[a]]
inserta3 [] _       = []
inserta3 (x:xs) yss = [x:ys | ys <- yss] ++ inserta3 xs yss
 
-- 4ª solución
-- ===========
 
producto4 :: [[a]] -> [[a]]
producto4 = foldr inserta4 [[]]
 
inserta4 :: [a] -> [[a]] -> [[a]]
inserta4 []     _   = []
inserta4 (x:xs) yss = map (x:) yss ++ inserta4 xs yss
 
-- 5ª solución
-- ===========
 
producto5 :: [[a]] -> [[a]]
producto5 = foldr inserta5 [[]]
 
inserta5 :: [a] -> [[a]] -> [[a]]
inserta5 xs yss = [x:ys | x <- xs, ys <- yss]
 
-- 6ª solución
-- ===========
 
producto6 :: [[a]] -> [[a]]
producto6 = foldr inserta6 [[]]
 
inserta6 :: [a] -> [[a]] -> [[a]]
inserta6 xs yss = concatMap (\x -> map (x:) yss) xs
 
-- 7ª solución
-- ===========
 
producto7 :: [[a]] -> [[a]]
producto7 = foldr inserta7 [[]]
 
inserta7 :: [a] -> [[a]] -> [[a]]
inserta7 xs yss = xs >>= (\x -> map (x:) yss)
 
-- 8ª solución
-- ===========
 
producto8 :: [[a]] -> [[a]]
producto8 = foldr inserta8 [[]]
 
inserta8 :: [a] -> [[a]] -> [[a]]
inserta8 xs yss = (:) <$> xs <*> yss
 
-- 9ª solución
-- ===========
 
producto9 :: [[a]] -> [[a]]
producto9 = foldr inserta9 [[]]
 
inserta9 :: [a] -> [[a]] -> [[a]]
inserta9 = liftA2 (:)
 
-- 10ª solución
-- ============
 
producto10 :: [[a]] -> [[a]]
producto10 = foldr (liftM2 (:)) [[]]
 
-- 11ª solución
-- ============
 
producto11 :: [[a]] -> [[a]]
producto11 = sequence
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_producto :: [[Int]] -> Bool
prop_producto xss =
  all (== producto1 xss)
      [ producto2 xss
      , producto3 xss
      , producto4 xss
      , producto5 xss
      , producto6 xss
      , producto7 xss
      , producto8 xss
      , producto9 xss
      , producto10 xss
      , producto11 xss
      ]
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize = 9}) prop_producto
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> length (producto1 (replicate 7 [0..9]))
--    10000000
--    (10.51 secs, 10,169,418,496 bytes)
--    λ> length (producto2 (replicate 7 [0..9]))
--    10000000
--    (2.14 secs, 1,333,870,712 bytes)
--    λ> length (producto3 (replicate 7 [0..9]))
--    10000000
--    (3.33 secs, 1,956,102,056 bytes)
--    λ> length (producto4 (replicate 7 [0..9]))
--    10000000
--    (0.98 secs, 1,600,542,752 bytes)
--    λ> length (producto5 (replicate 7 [0..9]))
--    10000000
--    (2.10 secs, 1,333,870,288 bytes)
--    λ> length (producto6 (replicate 7 [0..9]))
--    10000000
--    (1.17 secs, 1,600,534,632 bytes)
--    λ> length (producto7 (replicate 7 [0..9]))
--    10000000
--    (0.35 secs, 1,600,534,352 bytes)
--    λ> length (producto8 (replicate 7 [0..9]))
--    10000000
--    (0.87 secs, 978,317,848 bytes)
--    λ> length (producto9 (replicate 7 [0..9]))
--    10000000
--    (1.38 secs, 1,067,201,016 bytes)
--    λ> length (producto10 (replicate 7 [0..9]))
--    10000000
--    (0.54 secs, 2,311,645,392 bytes)
--    λ> length (producto11 (replicate 7 [0..9]))
--    10000000
--    (1.32 secs, 1,067,200,992 bytes)
--
--    λ> length (producto7 (replicate 7 [1..14]))
--    105413504
--    (3.77 secs, 16,347,739,040 bytes)
--    λ> length (producto10 (replicate 7 [1..14]))
--    105413504
--    (5.11 secs, 23,613,162,016 bytes)
 
-- Comprobación de la propiedad
-- ============================
 
-- La propiedad es
prop_longitud :: [[Int]] -> Bool
prop_longitud xss =
  length (producto7 xss) == product (map length xss)
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize = 7}) prop_longitud
--    +++ OK, passed 100 tests.

El código se encuentra en GitHub.

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

Leer más →