Menu Close

Etiqueta: until

Clausura de un conjunto respecto de una función

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

Cálculo de pi usando la fórmula de Vieta

La fórmula de Vieta para el cálculo de pi es la siguiente
Calculo_de_pi_usando_la_formula_de_Vieta

Definir las funciones

   aproximacionPi :: Int -> Double
   errorPi :: Double -> Int

tales que

  • (aproximacionPi n) es la aproximación de pi usando n factores de la fórmula de Vieta. Por ejemplo,
     aproximacionPi  5  ==  3.140331156954753
     aproximacionPi 10  ==  3.1415914215112
     aproximacionPi 15  ==  3.141592652386592
     aproximacionPi 20  ==  3.1415926535886207
     aproximacionPi 25  ==  3.141592653589795
  • (errorPi x) es el menor número de factores de la fórmula de Vieta necesarios para obtener pi con un error menor que x. Por ejemplo,
     errorPi 0.1        ==  2
     errorPi 0.01       ==  4
     errorPi 0.001      ==  6
     errorPi 0.0001     ==  7
     errorPi 1e-4       ==  7
     errorPi 1e-14      ==  24
     pi                 ==  3.141592653589793
     aproximacionPi 24  ==  3.1415926535897913

Soluciones

-- 1ª definición de aproximacionPi
aproximacionPi :: Int -> Double
aproximacionPi n = product [2 / aux x | x <- [0..n]]
  where
    aux 0 = 1
    aux 1 = sqrt 2
    aux n = sqrt (2 + aux (n-1))
 
-- 2ª definición de aproximacionPi
aproximacionPi2 :: Int -> Double
aproximacionPi2 n = product [2/x | x <- 1 : xs] 
  where xs = take n $ iterate (\x -> sqrt (2+x)) (sqrt 2)
 
-- 3ª definición de aproximaxionPi
aproximacionPi3 :: Int -> Double
aproximacionPi3 n =  product (2 : take n (map (2/) xs))
  where xs = sqrt 2 : [sqrt (2 + x) | x <- xs]
 
-- 1ª definición de errorPi
errorPi :: Double -> Int
errorPi x = head [n | n <- [1..]
                    , abs (pi - aproximacionPi n) < x]
 
-- 2ª definición de errorPi
errorPi2 :: Double -> Int
errorPi2 x = until aceptable (+1) 1
  where aceptable n = abs (pi - aproximacionPi n) < x

Pensamiento

El tiempo que la barba me platea,
cavó mis ojos y agrandó mi frente,
va siendo en mi recuerdo transparente,
y mientras más al fondo, más clarea.

Antonio Machado

Sustitución de pares de elementos consecutivos iguales

Dada una lista xs se reemplaza el primer par de elementos consecutivos iguales x por x+1 y se repite el proceso con las listas obtenidas hasta que no haya ningún par de elementos consecutivos iguales. Por ejemplo, para [5,2,1,1,2,2] se tiene el siguiente proceso

       [5,2,1,1,2,2] 
   ==> [5,2,2,  2,2]
   ==> [5,3,    2,2]
   ==> [5,3,    3]
   ==> [5,4]

Definir la función

   sustitucion :: [Int] -> [Int]

tal que (sustitucion xs) es la lista obtenida aplicándole a xs el proceso anterior. Por ejemplo,

   sustitucion [5,2,1,1,2,2]         ==  [5,4]
   sustitucion [4,2,1,1,2,2]         ==  [5]
   sustitucion [4,5,11,2,5,7,2]      ==  [4,5,11,2,5,7,2]
   sustitucion (1:[1..2*10^6])       ==  [2000001]
   length (sustitucion [1..2*10^6])  ==  2000000

Soluciones

-- 1ª solución
-- ===========
 
sustitucion :: [Int] -> [Int]
sustitucion xs
  | xs == ys  = xs
  | otherwise = sustitucion ys
  where ys = sustitucionElemental xs
 
sustitucionElemental :: [Int] -> [Int]
sustitucionElemental []  = []
sustitucionElemental [x] = [x]
sustitucionElemental (x:y:zs)
  | x == y = x+1:zs
  | otherwise = x : sustitucionElemental (y:zs)
 
-- 2ª solución
-- ===========
 
sustitucion2 :: [Int] -> [Int]
sustitucion2 xs = until esPuntoFijo sustitucionElemental xs
  where esPuntoFijo ys = sustitucionElemental ys == ys
 
-- Comparación de eficiencia
-- =========================
 
--    λ> sustitucion (1:[1..2*10^6])
--    [2000001]
--    (1.54 secs, 800,143,448 bytes)
--    λ> sustitucion2 (1:[1..2*10^6])
--    [2000001]
--    (2.21 secs, 1,072,143,584 bytes)

Clausura respecto de una operación binaria

Se dice que una operador @ es interno en un conjunto A si al @ sobre elementos de A se obtiene como resultado otro elemento de A. Por ejemplo, la suma es un operador interno en el conjunto de los números naturales pares.

La clausura de un conjunto A con respecto a un operador @ es el menor conjunto B tal que A está contenido en B y el operador @ es interno en el conjunto B. Por ejemplo, la clausura del conjunto {2} con respecto a la suma es el conjunto de los números pares positivos:

   {2, 4, 6, 8, ...} = {2*k | k <- [1..]}

Definir la función

   clausuraOperador :: (Int -> Int -> Int) -> Set Int -> Set Int

tal que (clausuraOperador op xs) es la clausura del conjunto xs con respecto a la operación op. Por ejemplo,

   clausuraOperador gcd (fromList [6,9,10])     ==
      fromList [1,2,3,6,9,10]
   clausuraOperador gcd (fromList [42,70,105])  ==
      fromList [7,14,21,35,42,70,105]
   clausuraOperador lcm (fromList [6,9,10])     ==
      fromList [6,9,10,18,30,90]
   clausuraOperador lcm (fromList [2,3,5,7])    ==
      fromList [2,3,5,6,7,10,14,15,21,30,35,42,70,105,210]

Soluciones

import Prelude hiding (map)
import Data.Set ( Set
                , elems
                , fromList
                , map
                , notMember
                , union
                , unions
                ) 
 
-- 1ª definición 
clausuraOperador :: (Int -> Int -> Int) -> Set Int -> Set Int
clausuraOperador op =
  until (\ xs -> null [(x,y) | x <- elems xs,
                               y <- elems xs,
                               notMember (op x y) xs])
        (\ xs -> union xs (fromList [op x y | x <- elems xs,
                                              y <- elems xs]))
 
-- 2ª definición 
clausuraOperador2 :: (Int -> Int -> Int) -> Set Int -> Set Int
clausuraOperador2 op = until ((==) <*> g) g
  where g ys = unions [map (`op` y) ys | y <- elems ys]

Dígitos iniciales

Definir las funciones

   digitosIniciales        :: [Int]
   graficaDigitosIniciales :: Int -> IO ()

tales que

  • digitosIniciales es la lista de los dígitos iniciales de los números naturales. Por ejemplo,
     λ> take 100 digitosIniciales
     [0,1,2,3,4,5,6,7,8,9,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,
      3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,
      6,6,6,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7,7,7,8,8,8,8,8,8,8,8,8,8,
      9,9,9,9,9,9,9,9,9,9]
  • (graficaDigitosIniciales n) dibuja la gráfica de los primeros n términos de la sucesión digitosIniciales. Por ejemplo, (graficaDigitosIniciales 100) dibuja
    Digitos_iniciales_100
    y (graficaDigitosIniciales 1000) dibuja
    Digitos_iniciales_1000

Soluciones

import Graphics.Gnuplot.Simple
 
-- 1ª definición
-- =============
 
digitosIniciales :: [Int]
digitosIniciales = map digitoInicial [0..]
 
digitoInicial :: Integer -> Int
digitoInicial n = read [head (show n)]
 
-- 2ª definición
-- =============
 
digitosIniciales2 :: [Int]
digitosIniciales2 = map (read . return . head . show) [0..]
 
-- 3ª definición
-- =============
 
digitosIniciales3 :: [Int]
digitosIniciales3 = map digitoInicial3 [0..]
 
digitoInicial3 :: Integer -> Int
digitoInicial3 = fromInteger . until (< 10) (`div` 10)
 
-- 4ª definición
-- =============
 
digitosIniciales4 :: [Int]
digitosIniciales4 = map (fromInteger . until (< 10) (`div` 10)) [0..]
 
-- 5ª definición
-- =============
 
digitosIniciales5 :: [Int]
digitosIniciales5 =
  0 : concat [replicate k x | k <- [10^n | n <- [0..]]
                            , x <- [1..9]]
 
-- Comparación de eficiencia
-- =========================
 
--    λ> digitosIniciales !! (2*10^6)
--    2
--    (0.46 secs, 320,145,984 bytes)
--    λ> digitosIniciales2 !! (2*10^6)
--    2
--    (0.46 secs, 320,143,288 bytes)
--    λ> digitosIniciales3 !! (2*10^6)
--    2
--    (0.17 secs, 320,139,216 bytes)
--    λ> digitosIniciales4 !! (2*10^6)
--    2
--    (0.55 secs, 320,139,248 bytes)
--    λ> digitosIniciales5 !! (2*10^6)
--    2
--    (0.12 secs, 224,158,992 bytes)
 
graficaDigitosIniciales :: Int -> IO ()
graficaDigitosIniciales n =
  plotList [ Key Nothing
           , Title ("graficaDigitosIniciales " ++ show n)
           , PNG ("Digitos_iniciales_" ++ show n ++ ".png" )
           ]
           (take n digitosIniciales)