Menu Close

Etiqueta: Tipos definidos

Código de las alergias

Para la determinación de las alergia se utiliza los siguientes códigos para los alérgenos:

   Huevos ........   1
   Cacahuetes ....   2
   Mariscos ......   4
   Fresas ........   8
   Tomates .......  16
   Chocolate .....  32
   Polen .........  64
   Gatos ......... 128

Así, si Juan es alérgico a los cacahuetes y al chocolate, su puntuación es 34 (es decir, 2+32).

Los alérgenos se representan mediante el siguiente tipo de dato

  data Alergeno = Huevos
                | Cacahuetes
                | Mariscos
                | Fresas
                | Tomates
                | Chocolate
                | Polen
                | Gatos
    deriving (Enum, Eq, Show, Bounded)

Definir la función

   alergias :: Int -> [Alergeno]

tal que (alergias n) es la lista de alergias correspondiente a una puntuación n. Por ejemplo,

   λ> alergias 1
   [Huevos]
   λ> alergias 2
   [Cacahuetes]
   λ> alergias 3
   [Huevos,Cacahuetes]
   λ> alergias 5
   [Huevos,Mariscos]
   λ> alergias 255
   [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

Soluciones

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

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

[/schedule]

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

import Data.List (subsequences)
import Test.QuickCheck
 
data Alergeno =
    Huevos
  | Cacahuetes
  | Mariscos
  | Fresas
  | Tomates
  | Chocolate
  | Polen
  | Gatos
  deriving (Enum, Eq, Show, Bounded)
 
-- 1ª solución
-- ===========
 
alergias1 :: Int -> [Alergeno]
alergias1 n =
  [a | (a,c) <- zip alergenos codigos, c `elem` descomposicion n]
 
-- codigos es la lista de los códigos de los alergenos.
codigos :: [Int]
codigos = [2^x| x <- [0..7]]
 
-- (descomposicion n) es la descomposición de n como sumas de potencias
-- de 2. Por ejemplo,
--    descomposicion 3    ==  [1,2]
--    descomposicion 5    ==  [1,4]
--    descomposicion 248  ==  [8,16,32,64,128]
--    descomposicion 255  ==  [1,2,4,8,16,32,64,128]
descomposicion :: Int -> [Int]
descomposicion n =
  head [xs | xs <- subsequences codigos, sum xs == n]
 
-- 2ª solución
-- ===========
 
alergias2 :: Int -> [Alergeno]
alergias2 = map toEnum . codigosAlergias
 
-- (codigosAlergias n) es la lista de códigos de alergias
-- correspondiente a una puntuación n. Por ejemplo,
--    codigosAlergias 1  ==  [0]
--    codigosAlergias 2  ==  [1]
--    codigosAlergias 3  ==  [0,1]
--    codigosAlergias 4  ==  [2]
--    codigosAlergias 5  ==  [0,2]
--    codigosAlergias 6  ==  [1,2]
codigosAlergias :: Int -> [Int]
codigosAlergias = aux [0..7]
  where aux []     _             = []
        aux (x:xs) n | odd n     = x : aux xs (n `div` 2)
                     | otherwise = aux xs (n `div` 2)
 
-- 3ª solución
-- ===========
 
alergias3 :: Int -> [Alergeno]
alergias3 = map toEnum . codigosAlergias3
 
codigosAlergias3 :: Int -> [Int]
codigosAlergias3 n =
  [x | (x,y) <- zip [0..7] (int2bin n), y == 1]
 
-- (int2bin n) es la representación binaria del número n. Por ejemplo,
--    int2bin 10  ==  [0,1,0,1]
-- ya que 10 = 0*1 + 1*2 + 0*4 + 1*8
int2bin :: Int -> [Int]
int2bin n | n < 2     = [n]
          | otherwise = n `rem` 2 : int2bin (n `div` 2)
 
-- 4ª solución
-- ===========
 
alergias4 :: Int -> [Alergeno]
alergias4 = map toEnum . codigosAlergias4
 
codigosAlergias4 :: Int -> [Int]
codigosAlergias4 n =
  map fst (filter ((== 1) . snd) (zip  [0..7] (int2bin n)))
 
-- 5ª solución
-- ===========
 
alergias5 :: Int -> [Alergeno]
alergias5 = map (toEnum . fst)
          . filter ((1 ==) . snd)
          . zip [0..7]
          . int2bin
 
-- 6ª solución
-- ===========
 
alergias6 :: Int -> [Alergeno]
alergias6 = aux alergenos
  where aux []     _             = []
        aux (x:xs) n | odd n     = x : aux xs (n `div` 2)
                     | otherwise = aux xs (n `div` 2)
 
-- alergenos es la lista de los alergenos. Por ejemplo.
--    take 3 alergenos  ==  [Huevos,Cacahuetes,Mariscos]
alergenos :: [Alergeno]
alergenos = [minBound..maxBound]
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_alergias :: Property
prop_alergias =
  forAll (arbitrary `suchThat` esValido) $ \n ->
  all (== alergias1 n)
      [alergias2 n,
       alergias3 n,
       alergias4 n,
       alergias5 n,
       alergias6 n]
  where esValido x = 1 <= x && x <= 255
 
-- La comprobación es
--    λ> quickCheck prop_alergias
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> last (map alergias1 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.02 secs, 1,657,912 bytes)
--    λ> last (map alergias2 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.01 secs, 597,080 bytes)
--    λ> last (map alergias3 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.01 secs, 597,640 bytes)
--    λ> last (map alergias4 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.01 secs, 598,152 bytes)
--    λ> last (map alergias5 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.01 secs, 596,888 bytes)

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

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>

[/schedule]

Ordenación de estructuras

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)

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]

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]

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.

El código se encuentra en GitHub.

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

La bandera tricolor

El problema de la bandera tricolor consiste en lo siguiente: Dada un lista de objetos xs que pueden ser rojos, amarillos o morados, se pide devolver una lista ys que contiene los elementos de xs, primero los rojos, luego los amarillos y por último los morados.

Definir el tipo de dato Color para representar los colores con los constructores R, A y M correspondientes al rojo, azul y morado y la función

   banderaTricolor :: [Color] -> [Color]

tal que (banderaTricolor xs) es la bandera tricolor formada con los elementos de xs. Por ejemplo,

   bandera [M,R,A,A,R,R,A,M,M]  ==  [R,R,R,A,A,A,M,M,M]
   bandera [M,R,A,R,R,A]        ==  [R,R,R,A,A,M]

Soluciones

import Data.List (sort)
import Test.QuickCheck (Arbitrary(arbitrary), elements, quickCheck)
 
data Color = R | A | M
  deriving (Show, Eq, Ord, Enum)
 
-- 1ª solución
-- ===========
 
banderaTricolor1 :: [Color] -> [Color]
banderaTricolor1 xs =
  [x | x <- xs, x == R] ++
  [x | x <- xs, x == A] ++
  [x | x <- xs, x == M]
 
-- 2ª solución
-- ===========
 
banderaTricolor2 :: [Color] -> [Color]
banderaTricolor2 xs =
  colores R ++ colores A ++ colores M
  where colores c = filter (== c) xs
 
-- 3ª solución
-- ===========
 
banderaTricolor3 :: [Color] -> [Color]
banderaTricolor3 xs =
  concat [[x | x <- xs, x == c] | c <- [R,A,M]]
 
-- 4ª solución
-- ===========
 
banderaTricolor4 :: [Color] -> [Color]
banderaTricolor4 xs = aux xs ([],[],[])
  where aux []     (rs,as,ms) = rs ++ as ++ ms
        aux (R:ys) (rs,as,ms) = aux ys (R:rs,   as,   ms)
        aux (A:ys) (rs,as,ms) = aux ys (  rs, A:as,   ms)
        aux (M:ys) (rs,as,ms) = aux ys (  rs,   as, M:ms)
 
-- 5ª solución
-- ===========
 
banderaTricolor5 :: [Color] -> [Color]
banderaTricolor5 = sort
 
-- Comprobación de equivalencia
-- ============================
 
instance Arbitrary Color where
  arbitrary = elements [A,R,M]
 
-- La propiedad es
prop_banderaTricolor :: [Color] -> Bool
prop_banderaTricolor xs =
  all (== banderaTricolor1 xs)
      [banderaTricolor2 xs,
       banderaTricolor3 xs,
       banderaTricolor4 xs,
       banderaTricolor5 xs]
 
verifica_banderaTricolor :: IO ()
verifica_banderaTricolor =
  quickCheck prop_banderaTricolor
 
-- La comprobación es
--    λ> verifica_banderaTricolor
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> bandera n = concat [replicate n c | c <- [M,R,A]]
--    λ> length (banderaTricolor1 (bandera (10^6)))
--    3000000
--    (1.51 secs, 1,024,454,768 bytes)
--    λ> length (banderaTricolor1 (bandera (2*10^6)))
--    6000000
--    (2.94 secs, 2,048,454,832 bytes)
--    λ> length (banderaTricolor2 (bandera (2*10^6)))
--    6000000
--    (2.35 secs, 1,232,454,920 bytes)
--    λ> length (banderaTricolor3 (bandera (2*10^6)))
--    6000000
--    (4.28 secs, 2,304,455,360 bytes)
--    λ> length (banderaTricolor4 (bandera (2*10^6)))
--    6000000
--    (3.01 secs, 1,904,454,672 bytes)
--    λ> length (banderaTricolor5 (bandera (2*10^6)))
--    6000000
--    (2.47 secs, 1,248,454,744 bytes)

El código se encuentra en GitHub.