febrero 2022 – Exercitium

La bandera tricolor

PorJosé A. Alonso 28-febrero-20227-marzo-2022

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]

1	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]

1 2	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)

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.

Ordenación por el máximo

PorJosé A. Alonso 25-febrero-20224-marzo-2022

Definir la función

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

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

tal que (ordenadosPorMaximo xss) es la lista de los elementos de xss ordenada por sus máximos (se supone que los elementos de xss son listas no vacía) y cuando tiene el mismo máximo se conserva el orden original. Por ejemplo,

   λ> ordenadosPorMaximo [[0,8],[9],[8,1],[6,3],[8,2],[6,1],[6,2]]
   [[6,3],[6,1],[6,2],[0,8],[8,1],[8,2],[9]]
   λ> ordenadosPorMaximo ["este","es","el","primero"]
   ["el","primero","es","este"]

λ> ordenadosPorMaximo [[0,8],[9],[8,1],[6,3],[8,2],[6,1],[6,2]]

[[6,3],[6,1],[6,2],[0,8],[8,1],[8,2],[9]]

λ> ordenadosPorMaximo ["este","es","el","primero"]

["el","primero","es","este"]

Soluciones

import Data.List (sort, sortBy)
import GHC.Exts (sortWith)
import Test.QuickCheck (quickCheck)

-- 1ª solución
ordenadosPorMaximo1 :: Ord a => [[a]] -> [[a]]
ordenadosPorMaximo1 xss =
  map snd (sort [((maximum xs,k),xs) | (k,xs) <- zip [0..] xss])

-- 2ª solución
ordenadosPorMaximo2 :: Ord a => [[a]] -> [[a]]
ordenadosPorMaximo2 xss =
  [xs | (_,xs) <- sort [((maximum xs,k),xs) | (k,xs) <- zip [0..] xss]]

-- 3ª solución
ordenadosPorMaximo3 :: Ord a => [[a]] -> [[a]]
ordenadosPorMaximo3 =
  sortBy (\xs ys -> compare (maximum xs) (maximum ys))

-- 4ª solución
ordenadosPorMaximo4 :: Ord a => [[a]] -> [[a]]
ordenadosPorMaximo4 = sortWith maximum

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

-- La propiedad es
prop_ordenadosPorMaximo :: [[Int]] -> Bool
prop_ordenadosPorMaximo xss =
  all (== ordenadosPorMaximo1 yss)
      [ordenadosPorMaximo2 yss,
       ordenadosPorMaximo3 yss,
       ordenadosPorMaximo4 yss]
  where yss = filter (not . null) xss

verifica_ordenadosPorMaximo :: IO ()
verifica_ordenadosPorMaximo =
  quickCheck prop_ordenadosPorMaximo

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

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

-- La comparación es
--    λ> length (ordenadosPorMaximo1 [[1..k] | k <- [1..10^4]])
--    10000
--    (6.00 secs, 8,763,714,848 bytes)
--    λ> length (ordenadosPorMaximo2 [[1..k] | k <- [1..10^4]])
--    10000
--    (6.15 secs, 8,764,177,472 bytes)
--    λ> length (ordenadosPorMaximo3 [[1..k] | k <- [1..10^4]])
--    10000
--    (8.16 secs, 13,914,503,672 bytes)
--    λ> length (ordenadosPorMaximo4 [[1..k] | k <- [1..10^4]])
--    10000
--    (7.77 secs, 13,914,183,776 bytes)

import Data.List (sort, sortBy)

import GHC.Exts (sortWith)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

ordenadosPorMaximo1 xss =

map snd (sort [((maximum xs,k),xs) | (k,xs) <- zip [0..] xss])

-- 2ª solución

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

ordenadosPorMaximo2 xss =

[xs | (_,xs) <- sort [((maximum xs,k),xs) | (k,xs) <- zip [0..] xss]]

-- 3ª solución

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

ordenadosPorMaximo3 =

sortBy (\xs ys -> compare (maximum xs) (maximum ys))

-- 4ª solución

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

ordenadosPorMaximo4 = sortWith maximum

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_ordenadosPorMaximo :: [[Int]] -> Bool

prop_ordenadosPorMaximo xss =

all (== ordenadosPorMaximo1 yss)

[ordenadosPorMaximo2 yss,

ordenadosPorMaximo3 yss,

ordenadosPorMaximo4 yss]

where yss = filter (not . null) xss

verifica_ordenadosPorMaximo :: IO ()

verifica_ordenadosPorMaximo =

quickCheck prop_ordenadosPorMaximo

-- La comprobación es

-- λ> verifica_ordenadosPorMaximo

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (ordenadosPorMaximo1 [[1..k] | k <- [1..10^4]])

-- 10000

-- (6.00 secs, 8,763,714,848 bytes)

-- λ> length (ordenadosPorMaximo2 [[1..k] | k <- [1..10^4]])

-- 10000

-- (6.15 secs, 8,764,177,472 bytes)

-- λ> length (ordenadosPorMaximo3 [[1..k] | k <- [1..10^4]])

-- 10000

-- (8.16 secs, 13,914,503,672 bytes)

-- λ> length (ordenadosPorMaximo4 [[1..k] | k <- [1..10^4]])

-- 10000

-- (7.77 secs, 13,914,183,776 bytes)

El código se encuentra en GitHub.

Iguales al siguiente

PorJosé A. Alonso 24-febrero-20223-marzo-2022

Definir la función

   igualesAlSiguiente :: Eq a => [a] -> [a]

1	igualesAlSiguiente :: Eq a => [a] -> [a]

tal que (igualesAlSiguiente xs) es la lista de los elementos de xs que son iguales a su siguiente. Por ejemplo,

   igualesAlSiguiente [1,2,2,2,3,3,4]  ==  [2,2,3]
   igualesAlSiguiente [1..10]          ==  []

1 2	igualesAlSiguiente [1,2,2,2,3,3,4] == [2,2,3] igualesAlSiguiente [1..10] == []

Soluciones

import Data.List (group)
import Test.QuickCheck (quickCheck)

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

igualesAlSiguiente1 :: Eq a => [a] -> [a]
igualesAlSiguiente1 xs =
  [x | (x, y) <- consecutivos1 xs, x == y]

-- (consecutivos1 xs) es la lista de pares de elementos consecutivos en
-- xs. Por ejemplo,
--    consecutivos1 [3,5,2,7]  ==  [(3,5),(5,2),(2,7)]
consecutivos1 :: [a] -> [(a, a)]
consecutivos1 xs = zip xs (tail xs)

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

igualesAlSiguiente2 :: Eq a => [a] -> [a]
igualesAlSiguiente2 xs =
  [x | (x,y) <- consecutivos2 xs, x == y]

-- (consecutivos2 xs) es la lista de pares de elementos consecutivos en
-- xs. Por ejemplo,
--    consecutivos2 [3,5,2,7]  ==  [(3,5),(5,2),(2,7)]
consecutivos2 :: [a] -> [(a, a)]
consecutivos2 (x:y:zs) = (x,y) : consecutivos2 (y:zs)
consecutivos2 _        = []

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

igualesAlSiguiente3 :: Eq a => [a] -> [a]
igualesAlSiguiente3 (x:y:zs) | x == y    = x : igualesAlSiguiente3 (y:zs)
                             | otherwise = igualesAlSiguiente3 (y:zs)
igualesAlSiguiente3 _                    = []

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

igualesAlSiguiente4 :: Eq a => [a] -> [a]
igualesAlSiguiente4 xs = concat [ys | (_:ys) <- group xs]

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

igualesAlSiguiente5 :: Eq a => [a] -> [a]
igualesAlSiguiente5 xs = concat (map tail (group xs))

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

igualesAlSiguiente6 :: Eq a => [a] -> [a]
igualesAlSiguiente6 xs = tail =<< group xs

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

igualesAlSiguiente7 :: Eq a => [a] -> [a]
igualesAlSiguiente7 = (tail =<<) . group

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

igualesAlSiguiente8 :: Eq a => [a] -> [a]
igualesAlSiguiente8 xs = concatMap tail (group xs)

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

igualesAlSiguiente9 :: Eq a => [a] -> [a]
igualesAlSiguiente9 = concatMap tail . group

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

igualesAlSiguiente10 :: Eq a => [a] -> [a]
igualesAlSiguiente10 xs = aux xs (tail xs)
  where aux (u:us) (v:vs) | u == v    = u : aux us vs
                          | otherwise = aux us vs
        aux _ _ = []

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

-- La propiedad es
prop_igualesAlSiguiente :: [Int] -> Bool
prop_igualesAlSiguiente xs =
  all (== igualesAlSiguiente1 xs)
      [igualesAlSiguiente2 xs,
       igualesAlSiguiente3 xs,
       igualesAlSiguiente4 xs,
       igualesAlSiguiente5 xs,
       igualesAlSiguiente6 xs,
       igualesAlSiguiente7 xs,
       igualesAlSiguiente8 xs,
       igualesAlSiguiente9 xs,
       igualesAlSiguiente10 xs]

verificacion :: IO ()
verificacion = quickCheck prop_igualesAlSiguiente

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

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

-- La comparación es
--    > ej = concatMap show [1..10^6]
--    (0.01 secs, 446,752 bytes)
--    λ> length ej
--    5888896
--    (0.16 secs, 669,787,856 bytes)
--    λ> length (show (igualesAlSiguiente1 ej))
--    588895
--    (1.60 secs, 886,142,944 bytes)
--    λ> length (show (igualesAlSiguiente2 ej))
--    588895
--    (1.95 secs, 1,734,143,816 bytes)
--    λ> length (show (igualesAlSiguiente3 ej))
--    588895
--    (1.81 secs, 1,178,232,104 bytes)
--    λ> length (show (igualesAlSiguiente4 ej))
--    588895
--    (1.43 secs, 1,932,010,304 bytes)
--    λ> length (show (igualesAlSiguiente5 ej))
--    588895
--    (0.40 secs, 2,016,810,320 bytes)
--    λ> length (show (igualesAlSiguiente6 ej))
--    588895
--    (0.32 secs, 1,550,409,984 bytes)
--    λ> length (show (igualesAlSiguiente7 ej))
--    588895
--    (0.34 secs, 1,550,410,104 bytes)
--    λ> length (show (igualesAlSiguiente8 ej))
--    588895
--    (0.33 secs, 1,550,410,024 bytes)
--    λ> length (show (igualesAlSiguiente9 ej))
--    588895
--    (0.33 secs, 1,550,450,968 bytes)
--    λ> length (show (igualesAlSiguiente10 ej))
--    588895
--    (1.54 secs, 754,272,600 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

import Data.List (group)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

igualesAlSiguiente1 :: Eq a => [a] -> [a]

igualesAlSiguiente1 xs =

[x | (x, y) <- consecutivos1 xs, x == y]

-- (consecutivos1 xs) es la lista de pares de elementos consecutivos en

-- xs. Por ejemplo,

-- consecutivos1 [3,5,2,7] == [(3,5),(5,2),(2,7)]

consecutivos1 :: [a] -> [(a, a)]

consecutivos1 xs = zip xs (tail xs)

-- 2ª solución

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

igualesAlSiguiente2 :: Eq a => [a] -> [a]

igualesAlSiguiente2 xs =

[x | (x,y) <- consecutivos2 xs, x == y]

-- (consecutivos2 xs) es la lista de pares de elementos consecutivos en

-- xs. Por ejemplo,

-- consecutivos2 [3,5,2,7] == [(3,5),(5,2),(2,7)]

consecutivos2 :: [a] -> [(a, a)]

consecutivos2 (x:y:zs) = (x,y) : consecutivos2 (y:zs)

consecutivos2 _ = []

-- 3ª solución

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

igualesAlSiguiente3 :: Eq a => [a] -> [a]

igualesAlSiguiente3 (x:y:zs) | x == y = x : igualesAlSiguiente3 (y:zs)

| otherwise = igualesAlSiguiente3 (y:zs)

igualesAlSiguiente3 _ = []

-- 4ª solución

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

igualesAlSiguiente4 :: Eq a => [a] -> [a]

igualesAlSiguiente4 xs = concat [ys | (_:ys) <- group xs]

-- 5ª solución

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

igualesAlSiguiente5 :: Eq a => [a] -> [a]

igualesAlSiguiente5 xs = concat (map tail (group xs))

-- 6ª solución

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

igualesAlSiguiente6 :: Eq a => [a] -> [a]

igualesAlSiguiente6 xs = tail =<< group xs

-- 7ª solución

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

igualesAlSiguiente7 :: Eq a => [a] -> [a]

igualesAlSiguiente7 = (tail =<<) . group

-- 8ª solución

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

igualesAlSiguiente8 :: Eq a => [a] -> [a]

igualesAlSiguiente8 xs = concatMap tail (group xs)

-- 9ª solución

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

igualesAlSiguiente9 :: Eq a => [a] -> [a]

igualesAlSiguiente9 = concatMap tail . group

-- 10ª solución

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

igualesAlSiguiente10 :: Eq a => [a] -> [a]

igualesAlSiguiente10 xs = aux xs (tail xs)

where aux (u:us) (v:vs) | u == v = u : aux us vs

| otherwise = aux us vs

aux _ _ = []

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_igualesAlSiguiente :: [Int] -> Bool

prop_igualesAlSiguiente xs =

all (== igualesAlSiguiente1 xs)

[igualesAlSiguiente2 xs,

igualesAlSiguiente3 xs,

igualesAlSiguiente4 xs,

igualesAlSiguiente5 xs,

igualesAlSiguiente6 xs,

igualesAlSiguiente7 xs,

igualesAlSiguiente8 xs,

igualesAlSiguiente9 xs,

igualesAlSiguiente10 xs]

verificacion :: IO ()

verificacion = quickCheck prop_igualesAlSiguiente

-- La comprobación es

-- λ> verificacion

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- > ej = concatMap show [1..10^6]

-- (0.01 secs, 446,752 bytes)

-- λ> length ej

-- 5888896

-- (0.16 secs, 669,787,856 bytes)

-- λ> length (show (igualesAlSiguiente1 ej))

-- 588895

-- (1.60 secs, 886,142,944 bytes)

-- λ> length (show (igualesAlSiguiente2 ej))

-- 588895

-- (1.95 secs, 1,734,143,816 bytes)

-- λ> length (show (igualesAlSiguiente3 ej))

-- 588895

-- (1.81 secs, 1,178,232,104 bytes)

-- λ> length (show (igualesAlSiguiente4 ej))

-- 588895

-- (1.43 secs, 1,932,010,304 bytes)

-- λ> length (show (igualesAlSiguiente5 ej))

-- 588895

-- (0.40 secs, 2,016,810,320 bytes)

-- λ> length (show (igualesAlSiguiente6 ej))

-- 588895

-- (0.32 secs, 1,550,409,984 bytes)

-- λ> length (show (igualesAlSiguiente7 ej))

-- 588895

-- (0.34 secs, 1,550,410,104 bytes)

-- λ> length (show (igualesAlSiguiente8 ej))

-- 588895

-- (0.33 secs, 1,550,410,024 bytes)

-- λ> length (show (igualesAlSiguiente9 ej))

-- 588895

-- (0.33 secs, 1,550,450,968 bytes)

-- λ> length (show (igualesAlSiguiente10 ej))

-- 588895

-- (1.54 secs, 754,272,600 bytes)

El código se encuentra en GitHub.

Primos consecutivos con media capicúa

PorJosé A. Alonso 23-febrero-202215-abril-2022

Definir la lista

   primosConsecutivosConMediaCapicua :: [(Int,Int,Int)]

1	primosConsecutivosConMediaCapicua :: [(Int,Int,Int)]

formada por las ternas (x,y,z) tales que x e y son primos consecutivos cuya media, z, es capicúa. Por ejemplo,

   λ> take 5 primosConsecutivosConMediaCapicua
   [(3,5,4),(5,7,6),(7,11,9),(97,101,99),(109,113,111)]
   λ> primosConsecutivosConMediaCapicua !! 500
   (5687863,5687867,5687865)

λ> take 5 primosConsecutivosConMediaCapicua

[(3,5,4),(5,7,6),(7,11,9),(97,101,99),(109,113,111)]

λ> primosConsecutivosConMediaCapicua !! 500

(5687863,5687867,5687865)

Soluciones

import Data.List (genericTake)
import Data.Numbers.Primes (primes)

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

primosConsecutivosConMediaCapicua :: [(Integer,Integer,Integer)]
primosConsecutivosConMediaCapicua =
  [(x,y,z) | (x,y) <- zip primosImpares (tail primosImpares),
             let z = (x + y) `div` 2,
             capicua z]

-- (primo x) se verifica si x es primo. Por ejemplo,
--    primo 7  ==  True
--    primo 8  ==  False
primo :: Integer -> Bool
primo x = [y | y <- [1..x], x `rem` y == 0] == [1,x]

-- primosImpares es la lista de los números primos impares. Por ejemplo,
--    take 10 primosImpares  ==  [3,5,7,11,13,17,19,23,29]
primosImpares :: [Integer]
primosImpares = [x | x <- [3,5..], primo x]

-- (capicua x) se verifica si x es capicúa. Por ejemplo,
capicua :: Integer -> Bool
capicua x = ys == reverse ys
  where ys = show x

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

primosConsecutivosConMediaCapicua2 :: [(Integer,Integer,Integer)]
primosConsecutivosConMediaCapicua2 =
  [(x,y,z) | (x,y) <- zip primosImpares2 (tail primosImpares2),
             let z = (x + y) `div` 2,
             capicua z]

primosImpares2 :: [Integer]
primosImpares2 = tail (criba [2..])
  where criba (p:ps) = p : criba [n | n <- ps, mod n p /= 0]
        criba []     = error "Imposible"

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

primosConsecutivosConMediaCapicua3 :: [(Integer,Integer,Integer)]
primosConsecutivosConMediaCapicua3 =
  [(x,y,z) | (x,y) <- zip (tail primos3) (drop 2 primos3),
             let z = (x + y) `div` 2,
             capicua z]

primos3 :: [Integer]
primos3 = 2 : 3 : criba3 0 (tail primos3) 3
  where criba3 k (p:ps) x = [n | n <- [x+2,x+4..p*p-2],
                                 and [n `rem` q /= 0 | q <- take k (tail primos3)]]
                            ++ criba3 (k+1) ps (p*p)
        criba3 _ [] _     = error "Imposible"

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

primosConsecutivosConMediaCapicua4 :: [(Integer,Integer,Integer)]
primosConsecutivosConMediaCapicua4 =
  [(x,y,z) | (x,y) <- zip (tail primes) (drop 2 primes),
             let z = (x + y) `div` 2,
             capicua z]

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

-- La propiedad es
prop_primosConsecutivosConMediaCapicua :: Integer -> Bool
prop_primosConsecutivosConMediaCapicua n =
  all (== genericTake n primosConsecutivosConMediaCapicua)
      [genericTake n primosConsecutivosConMediaCapicua2,
       genericTake n primosConsecutivosConMediaCapicua3,
       genericTake n primosConsecutivosConMediaCapicua4]

-- La comprobación es
--    λ> prop_primosConsecutivosConMediaCapicua 25 {-# SCC "" #-}
--    True

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

-- La comparación es
--    λ> primosConsecutivosConMediaCapicua !! 30
--    (12919,12923,12921)
--    (4.60 secs, 1,877,064,288 bytes)
--    λ> primosConsecutivosConMediaCapicua2 !! 30
--    (12919,12923,12921)
--    (0.69 secs, 407,055,848 bytes)
--    λ> primosConsecutivosConMediaCapicua3 !! 30
--    (12919,12923,12921)
--    (0.07 secs, 18,597,104 bytes)
--    λ> primosConsecutivosConMediaCapicua4 !! 30
--    (12919,12923,12921)
--    (0.01 secs, 10,065,784 bytes)
--
--    λ> primosConsecutivosConMediaCapicua2 !! 40
--    (29287,29297,29292)
--    (2.67 secs, 1,775,554,576 bytes)
--    λ> primosConsecutivosConMediaCapicua3 !! 40
--    (29287,29297,29292)
--    (0.09 secs, 32,325,808 bytes)
--    λ> primosConsecutivosConMediaCapicua4 !! 40
--    (29287,29297,29292)
--    (0.01 secs, 22,160,072 bytes)
--
--    λ> primosConsecutivosConMediaCapicua3 !! 150
--    (605503,605509,605506)
--    (3.68 secs, 2,298,403,864 bytes)
--    λ> primosConsecutivosConMediaCapicua4 !! 150
--    (605503,605509,605506)
--    (0.24 secs, 491,917,240 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List (genericTake)

import Data.Numbers.Primes (primes)

-- 1ª solución

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

primosConsecutivosConMediaCapicua :: [(Integer,Integer,Integer)]

primosConsecutivosConMediaCapicua =

[(x,y,z) | (x,y) <- zip primosImpares (tail primosImpares),

let z = (x + y) `div` 2,

capicua z]

-- (primo x) se verifica si x es primo. Por ejemplo,

-- primo 7 == True

-- primo 8 == False

primo :: Integer -> Bool

primo x = [y | y <- [1..x], x `rem` y == 0] == [1,x]

-- primosImpares es la lista de los números primos impares. Por ejemplo,

-- take 10 primosImpares == [3,5,7,11,13,17,19,23,29]

primosImpares :: [Integer]

primosImpares = [x | x <- [3,5..], primo x]

-- (capicua x) se verifica si x es capicúa. Por ejemplo,

capicua :: Integer -> Bool

capicua x = ys == reverse ys

where ys = show x

-- 2ª solución

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

primosConsecutivosConMediaCapicua2 :: [(Integer,Integer,Integer)]

primosConsecutivosConMediaCapicua2 =

[(x,y,z) | (x,y) <- zip primosImpares2 (tail primosImpares2),

let z = (x + y) `div` 2,

capicua z]

primosImpares2 :: [Integer]

primosImpares2 = tail (criba [2..])

where criba (p:ps) = p : criba [n | n <- ps, mod n p /= 0]

criba [] = error "Imposible"

-- 3ª solución

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

primosConsecutivosConMediaCapicua3 :: [(Integer,Integer,Integer)]

primosConsecutivosConMediaCapicua3 =

[(x,y,z) | (x,y) <- zip (tail primos3) (drop 2 primos3),

let z = (x + y) `div` 2,

capicua z]

primos3 :: [Integer]

primos3 = 2 : 3 : criba3 0 (tail primos3) 3

where criba3 k (p:ps) x = [n | n <- [x+2,x+4..p*p-2],

and [n `rem` q /= 0 | q <- take k (tail primos3)]]

++ criba3 (k+1) ps (p*p)

criba3 _ [] _ = error "Imposible"

-- 4ª solución

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

primosConsecutivosConMediaCapicua4 :: [(Integer,Integer,Integer)]

primosConsecutivosConMediaCapicua4 =

[(x,y,z) | (x,y) <- zip (tail primes) (drop 2 primes),

let z = (x + y) `div` 2,

capicua z]

-- Equivalencia de definiciones

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

-- La propiedad es

prop_primosConsecutivosConMediaCapicua :: Integer -> Bool

prop_primosConsecutivosConMediaCapicua n =

all (== genericTake n primosConsecutivosConMediaCapicua)

[genericTake n primosConsecutivosConMediaCapicua2,

genericTake n primosConsecutivosConMediaCapicua3,

genericTake n primosConsecutivosConMediaCapicua4]

-- La comprobación es

-- λ> prop_primosConsecutivosConMediaCapicua 25 {-# SCC "" #-}

-- True

-- Comparación de eficiencia

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

-- La comparación es

-- λ> primosConsecutivosConMediaCapicua !! 30

-- (12919,12923,12921)

-- (4.60 secs, 1,877,064,288 bytes)

-- λ> primosConsecutivosConMediaCapicua2 !! 30

-- (12919,12923,12921)

-- (0.69 secs, 407,055,848 bytes)

-- λ> primosConsecutivosConMediaCapicua3 !! 30

-- (12919,12923,12921)

-- (0.07 secs, 18,597,104 bytes)

-- λ> primosConsecutivosConMediaCapicua4 !! 30

-- (12919,12923,12921)

-- (0.01 secs, 10,065,784 bytes)

-- λ> primosConsecutivosConMediaCapicua2 !! 40

-- (29287,29297,29292)

-- (2.67 secs, 1,775,554,576 bytes)

-- λ> primosConsecutivosConMediaCapicua3 !! 40

-- (29287,29297,29292)

-- (0.09 secs, 32,325,808 bytes)

-- λ> primosConsecutivosConMediaCapicua4 !! 40

-- (29287,29297,29292)

-- (0.01 secs, 22,160,072 bytes)

-- λ> primosConsecutivosConMediaCapicua3 !! 150

-- (605503,605509,605506)

-- (3.68 secs, 2,298,403,864 bytes)

-- λ> primosConsecutivosConMediaCapicua4 !! 150

-- (605503,605509,605506)

-- (0.24 secs, 491,917,240 bytes)

El código se encuentra en GitHub.

Mastermind

PorJosé A. Alonso 22-febrero-20221-marzo-2022

El Mastermind es un juego que consiste en deducir un código numérico formado por una lista de números. Cada vez que se empieza una partida, el programa debe elegir un código, que será lo que el jugador debe adivinar en la menor cantidad de intentos posibles. Cada intento consiste en una propuesta de un código posible que propone el jugador, y una respuesta del programa. Las respuestas le darán pistas al jugador para que pueda deducir el código.

Estas pistas indican lo cerca que estuvo el número propuesto de solución a través de dos valores: la cantidad de aciertos es la cantidad de dígitos que propuso el jugador que también están en el código en la misma posición. La cantidad de coincidencias es la cantidad de dígitos que propuso el jugador que también están en el código pero en una posición distinta.

Por ejemplo, si el código que eligió el programa es el [2,6,0,7] el jugador propone el [1,4,0,6], el programa le debe responder acierto (el 0, que está en el código original en el mismo lugar, tercero), y una coincidencia (el 6, que también está en el original, pero en la segunda posición, no en el cuarto como fue propuesto). Si el jugador hubiera propuesto el [3,5,9,1], habría obtenido como respuesta ningún acierto y ninguna coincidencia, ya que no hay números en común con el código original. Si se obtienen cuatro aciertos es porque el jugador adivinó el código y ganó el juego.

Definir la función

   mastermind :: [Int] -> [Int] -> (Int,Int)

1	mastermind :: [Int] -> [Int] -> (Int,Int)

tal que (mastermind xs ys) es el par formado por los números de aciertos y de coincidencias entre xs e ys. Por ejemplo,

   mastermind [3,3] [3,2]          ==  (1,0)
   mastermind [3,5,3] [3,2,5]      ==  (1,1)
   mastermind [3,5,3,2] [3,2,5,3]  ==  (1,3)
   mastermind [3,5,3,3] [3,2,5,3]  ==  (2,1)
   mastermind [1..10^6] [1..10^6]  ==  (1000000,0)

mastermind [3,3] [3,2] == (1,0)

mastermind [3,5,3] [3,2,5] == (1,1)

mastermind [3,5,3,2] [3,2,5,3] == (1,3)

mastermind [3,5,3,3] [3,2,5,3] == (2,1)

mastermind [1..10^6] [1..10^6] == (1000000,0)

Soluciones

import qualified Data.Set as S
import Test.QuickCheck (quickCheck)

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

mastermind :: [Int] -> [Int] -> (Int, Int)
mastermind xs ys =
  (length (aciertos xs ys), length (coincidencias xs ys))

-- (aciertos xs ys) es la lista de las posiciones de los aciertos entre
-- xs e ys. Por ejemplo,
--    aciertos [1,1,0,7] [1,0,1,7]  ==  [0,3]
aciertos :: Eq a => [a] -> [a] -> [Int]
aciertos xs ys =
  [n | (n,x,y) <- zip3 [0..] xs ys, x == y]

-- (coincidencia xs ys) es la lista de las posiciones de las
-- coincidencias entre xs e ys. Por ejemplo,
--    coincidencias [1,1,0,7] [1,0,1,7]  ==  [1,2]
coincidencias :: Eq a => [a] -> [a] -> [Int]
coincidencias xs ys =
  [n | (n,y) <- zip [0..] ys,
       y `elem` xs,
       n `notElem` aciertos xs ys]

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

mastermind2 :: [Int] -> [Int] -> (Int, Int)
mastermind2 xs ys =
  (length aciertos2, length coincidencias2)
  where
    aciertos2, coincidencias2 :: [Int]
    aciertos2      = [n | (n,x,y) <- zip3 [0..] xs ys, x == y]
    coincidencias2 = [n | (n,y) <- zip [0..] ys, y `elem` xs, n `notElem` aciertos2]

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

mastermind3 :: [Int] -> [Int] -> (Int, Int)
mastermind3 xs ys = aux xs ys
  where aux (u:us) (v:vs)
          | u == v      = (a+1,b)
          | v `elem` xs = (a,b+1)
          | otherwise   = (a,b)
          where (a,b) = aux us vs
        aux _ _ = (0,0)

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

mastermind4 :: [Int] -> [Int] -> (Int, Int)
mastermind4 xs ys =
  (length aciertos4, length coincidencias4)
  where
    aciertos4, coincidencias4 :: [Int]
    aciertos4      = [n | (n,x,y) <- zip3 [0..] xs ys, x == y]
    xs'            = S.fromList xs
    coincidencias4 = [n | (n,y) <- zip [0..] ys, y `S.member` xs', n `notElem` aciertos4]

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

-- La propiedad es
prop_mastermind :: [Int] -> [Int] -> Bool
prop_mastermind xs ys =
  all (== mastermind xs1 ys1)
      [mastermind2 xs1 ys1,
       mastermind3 xs1 ys1,
       mastermind4 xs1 ys1]
  where n   = min (length xs) (length ys)
        xs1 = take n xs
        ys1 = take n ys

verifica_mastermind :: IO ()
verifica_mastermind = quickCheck prop_mastermind

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

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

-- La comparación es
--    λ> mastermind [1..10^4] (map (*2) [1..10^4])
--    (0,5000)
--    (14.17 secs, 11,209,750,408 bytes)
--    λ> mastermind2 [1..10^4] (map (*2) [1..10^4])
--    (0,5000)
--    (0.83 secs, 8,190,200 bytes)
--    λ> mastermind3 [1..10^4] (map (*2) [1..10^4])
--    (0,5000)
--    (0.61 secs, 7,339,232 bytes)
--    λ> mastermind4 [1..10^4] (map (*2) [1..10^4])
--    (0,5000)
--    (0.03 secs, 8,910,128 bytes)

import qualified Data.Set as S

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

mastermind :: [Int] -> [Int] -> (Int, Int)

mastermind xs ys =

(length (aciertos xs ys), length (coincidencias xs ys))

-- (aciertos xs ys) es la lista de las posiciones de los aciertos entre

-- xs e ys. Por ejemplo,

-- aciertos [1,1,0,7] [1,0,1,7] == [0,3]

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

aciertos xs ys =

[n | (n,x,y) <- zip3 [0..] xs ys, x == y]

-- (coincidencia xs ys) es la lista de las posiciones de las

-- coincidencias entre xs e ys. Por ejemplo,

-- coincidencias [1,1,0,7] [1,0,1,7] == [1,2]

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

coincidencias xs ys =

[n | (n,y) <- zip [0..] ys,

y `elem` xs,

n `notElem` aciertos xs ys]

-- 2ª solución

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

mastermind2 :: [Int] -> [Int] -> (Int, Int)

mastermind2 xs ys =

(length aciertos2, length coincidencias2)

where

aciertos2, coincidencias2 :: [Int]

aciertos2 = [n | (n,x,y) <- zip3 [0..] xs ys, x == y]

coincidencias2 = [n | (n,y) <- zip [0..] ys, y `elem` xs, n `notElem` aciertos2]

-- 3ª solución

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

mastermind3 :: [Int] -> [Int] -> (Int, Int)

mastermind3 xs ys = aux xs ys

where aux (u:us) (v:vs)

| u == v = (a+1,b)

| v `elem` xs = (a,b+1)

| otherwise = (a,b)

where (a,b) = aux us vs

aux _ _ = (0,0)

-- 4ª solución

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

mastermind4 :: [Int] -> [Int] -> (Int, Int)

mastermind4 xs ys =

(length aciertos4, length coincidencias4)

where

aciertos4, coincidencias4 :: [Int]

aciertos4 = [n | (n,x,y) <- zip3 [0..] xs ys, x == y]

xs' = S.fromList xs

coincidencias4 = [n | (n,y) <- zip [0..] ys, y `S.member` xs', n `notElem` aciertos4]

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_mastermind :: [Int] -> [Int] -> Bool

prop_mastermind xs ys =

all (== mastermind xs1 ys1)

[mastermind2 xs1 ys1,

mastermind3 xs1 ys1,

mastermind4 xs1 ys1]

where n = min (length xs) (length ys)

xs1 = take n xs

ys1 = take n ys

verifica_mastermind :: IO ()

verifica_mastermind = quickCheck prop_mastermind

-- La comprobación es

-- λ> verifica_mastermind

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> mastermind [1..10^4] (map (*2) [1..10^4])

-- (0,5000)

-- (14.17 secs, 11,209,750,408 bytes)

-- λ> mastermind2 [1..10^4] (map (*2) [1..10^4])

-- (0,5000)

-- (0.83 secs, 8,190,200 bytes)

-- λ> mastermind3 [1..10^4] (map (*2) [1..10^4])

-- (0,5000)

-- (0.61 secs, 7,339,232 bytes)

-- λ> mastermind4 [1..10^4] (map (*2) [1..10^4])

-- (0,5000)

-- (0.03 secs, 8,910,128 bytes)

El código se encuentra en GitHub.

Meses: febrero 2022

La bandera tricolor

Soluciones

Ordenación por el máximo

Soluciones

Iguales al siguiente

Soluciones

Primos consecutivos con media capicúa

Soluciones

Mastermind

Soluciones

Entradas recientes

Buscar

Correo electrónico