abril 2022 – Exercitium

Números con todos sus dígitos primos

PorJosé A. Alonso 29-abril-20221-mayo-2022

Definir la lista

   numerosConDigitosPrimos :: [Integer]

1	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

λ> 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)

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

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

Producto cartesiano de una familia de conjuntos

PorJosé A. Alonso 27-abril-20221-mayo-2022

Definir la función

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

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

λ> 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.

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

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

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

Representación de Zeckendorf

PorJosé A. Alonso 25-abril-20221-mayo-2022

Los primeros números de Fibonacci son

   1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, ...

1	1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, ...

tales que los dos primeros son iguales a 1 y los siguientes se obtienen sumando los dos anteriores.

El teorema de Zeckendorf establece que todo entero positivo n se puede representar, de manera única, como la suma de números de Fibonacci no consecutivos decrecientes. Dicha suma se llama la representación de Zeckendorf de n. Por ejemplo, la representación de Zeckendorf de 100 es

   100 = 89 + 8 + 3

1	100 = 89 + 8 + 3

Hay otras formas de representar 100 como sumas de números de Fibonacci; por ejemplo,

   100 = 89 +  8 + 2 + 1
   100 = 55 + 34 + 8 + 3

1 2	100 = 89 + 8 + 2 + 1 100 = 55 + 34 + 8 + 3

pero no son representaciones de Zeckendorf porque 1 y 2 son números de Fibonacci consecutivos, al igual que 34 y 55.

Definir la función

   zeckendorf :: Integer -> [Integer]

1	zeckendorf :: Integer -> [Integer]

tal que (zeckendorf n) es la representación de Zeckendorf de n. Por ejemplo,

   zeckendorf 100 == [89,8,3]
   zeckendorf 200 == [144,55,1]
   zeckendorf 300 == [233,55,8,3,1]
   length (zeckendorf (10^50000)) == 66097

zeckendorf 100 == [89,8,3]

zeckendorf 200 == [144,55,1]

zeckendorf 300 == [233,55,8,3,1]

length (zeckendorf (10^50000)) == 66097

Soluciones

module Representacion_de_Zeckendorf where

import Data.List (subsequences)
import Test.QuickCheck

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

zeckendorf1 :: Integer -> [Integer]
zeckendorf1 = head . zeckendorf1Aux

zeckendorf1Aux :: Integer -> [[Integer]]
zeckendorf1Aux n =
  [xs | xs <- subsequences (reverse (takeWhile (<= n) (tail fibs))),
        sum xs == n,
        sinFibonacciConsecutivos xs]

-- fibs es la la sucesión de los números de Fibonacci. Por ejemplo,
--    take 14 fibs  == [1,1,2,3,5,8,13,21,34,55,89,144,233,377]
fibs :: [Integer]
fibs = 1 : scanl (+) 1 fibs
-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión
-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por
-- ejemplo, 

-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión
-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por
-- ejemplo, 
--    sinFibonacciConsecutivos [89, 8, 3]      ==  True
--    sinFibonacciConsecutivos [55, 34, 8, 3]  ==  False
sinFibonacciConsecutivos :: [Integer] -> Bool
sinFibonacciConsecutivos xs =
  and [x /= siguienteFibonacci y | (x,y) <- zip xs (tail xs)]

-- (siguienteFibonacci n) es el menor número de Fibonacci mayor que
-- n. Por ejemplo, 
--    siguienteFibonacci 34  ==  55
siguienteFibonacci :: Integer -> Integer
siguienteFibonacci n =
  head (dropWhile (<= n) fibs)

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

zeckendorf2 :: Integer -> [Integer]
zeckendorf2 = head . zeckendorf2Aux

zeckendorf2Aux :: Integer -> [[Integer]]
zeckendorf2Aux n = map reverse (aux n (tail fibs))
  where aux 0 _ = [[]]
        aux m (x:y:zs)
            | x <= m     = [x:xs | xs <- aux (m-x) zs] ++ aux m (y:zs)
            | otherwise  = []

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

zeckendorf3 :: Integer -> [Integer]
zeckendorf3 0 = []
zeckendorf3 n = x : zeckendorf3 (n - x)
  where x = last (takeWhile (<= n) fibs)

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

zeckendorf4 :: Integer -> [Integer]
zeckendorf4 n = aux n (reverse (takeWhile (<= n) fibs))
  where aux 0 _      = []
        aux m (x:xs) = x : aux (m-x) (dropWhile (>m-x) xs)

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_zeckendorf :: Positive Integer -> Bool
prop_zeckendorf (Positive n) =
  all (== zeckendorf1 n)
      [zeckendorf2 n,
       zeckendorf3 n,
       zeckendorf4 n]

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

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

-- La comparación es
--    λ> zeckendorf1 (7*10^4)
--    [46368,17711,4181,1597,89,34,13,5,2]
--    (1.49 secs, 2,380,707,744 bytes)
--    λ> zeckendorf2 (7*10^4)
--    [46368,17711,4181,1597,89,34,13,5,2]
--    (0.07 secs, 21,532,008 bytes)
--
--    λ> zeckendorf2 (10^6)
--    [832040,121393,46368,144,55]
--    (1.40 secs, 762,413,432 bytes)
--    λ> zeckendorf3 (10^6)
--    [832040,121393,46368,144,55]
--    (0.01 secs, 542,488 bytes)
--    λ> zeckendorf4 (10^6)
--    [832040,121393,46368,144,55]
--    (0.01 secs, 536,424 bytes)
--
--    λ> length (zeckendorf3 (10^3000))
--    3947
--    (3.02 secs, 1,611,966,408 bytes)
--    λ> length (zeckendorf4 (10^2000))
--    2611
--    (0.02 secs, 10,434,336 bytes)
--
--    λ> length (zeckendorf4 (10^50000))
--    66097
--    (2.84 secs, 3,976,483,760 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

module Representacion_de_Zeckendorf where

import Data.List (subsequences)

import Test.QuickCheck

-- 1ª solución

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

zeckendorf1 :: Integer -> [Integer]

zeckendorf1 = head . zeckendorf1Aux

zeckendorf1Aux :: Integer -> [[Integer]]

zeckendorf1Aux n =

[xs | xs <- subsequences (reverse (takeWhile (<= n) (tail fibs))),

sum xs == n,

sinFibonacciConsecutivos xs]

-- fibs es la la sucesión de los números de Fibonacci. Por ejemplo,

-- take 14 fibs == [1,1,2,3,5,8,13,21,34,55,89,144,233,377]

fibs :: [Integer]

fibs = 1 : scanl (+) 1 fibs

-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión

-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por

-- ejemplo,

-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión

-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por

-- ejemplo,

-- sinFibonacciConsecutivos [89, 8, 3] == True

-- sinFibonacciConsecutivos [55, 34, 8, 3] == False

sinFibonacciConsecutivos :: [Integer] -> Bool

sinFibonacciConsecutivos xs =

and [x /= siguienteFibonacci y | (x,y) <- zip xs (tail xs)]

-- (siguienteFibonacci n) es el menor número de Fibonacci mayor que

-- n. Por ejemplo,

-- siguienteFibonacci 34 == 55

siguienteFibonacci :: Integer -> Integer

siguienteFibonacci n =

head (dropWhile (<= n) fibs)

-- 2ª solución

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

zeckendorf2 :: Integer -> [Integer]

zeckendorf2 = head . zeckendorf2Aux

zeckendorf2Aux :: Integer -> [[Integer]]

zeckendorf2Aux n = map reverse (aux n (tail fibs))

where aux 0 _ = [[]]

aux m (x:y:zs)

| x <= m = [x:xs | xs <- aux (m-x) zs] ++ aux m (y:zs)

| otherwise = []

-- 3ª solución

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

zeckendorf3 :: Integer -> [Integer]

zeckendorf3 0 = []

zeckendorf3 n = x : zeckendorf3 (n - x)

where x = last (takeWhile (<= n) fibs)

-- 4ª solución

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

zeckendorf4 :: Integer -> [Integer]

zeckendorf4 n = aux n (reverse (takeWhile (<= n) fibs))

where aux 0 _ = []

aux m (x:xs) = x : aux (m-x) (dropWhile (>m-x) xs)

-- Comprobación de equivalencia

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

-- La propiedad es

prop_zeckendorf :: Positive Integer -> Bool

prop_zeckendorf (Positive n) =

all (== zeckendorf1 n)

[zeckendorf2 n,

zeckendorf3 n,

zeckendorf4 n]

-- La comprobación es

-- λ> quickCheck prop_zeckendorf

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> zeckendorf1 (7*10^4)

-- [46368,17711,4181,1597,89,34,13,5,2]

-- (1.49 secs, 2,380,707,744 bytes)

-- λ> zeckendorf2 (7*10^4)

-- [46368,17711,4181,1597,89,34,13,5,2]

-- (0.07 secs, 21,532,008 bytes)

-- λ> zeckendorf2 (10^6)

-- [832040,121393,46368,144,55]

-- (1.40 secs, 762,413,432 bytes)

-- λ> zeckendorf3 (10^6)

-- [832040,121393,46368,144,55]

-- (0.01 secs, 542,488 bytes)

-- λ> zeckendorf4 (10^6)

-- [832040,121393,46368,144,55]

-- (0.01 secs, 536,424 bytes)

-- λ> length (zeckendorf3 (10^3000))

-- 3947

-- (3.02 secs, 1,611,966,408 bytes)

-- λ> length (zeckendorf4 (10^2000))

-- 2611

-- (0.02 secs, 10,434,336 bytes)

-- λ> length (zeckendorf4 (10^50000))

-- 66097

-- (2.84 secs, 3,976,483,760 bytes)

El código se encuentra en GitHub.

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

Ordenada cíclicamente

PorJosé A. Alonso 22-abril-202230-abril-2022

Se dice que una sucesión x(1), …, x(n) está ordenada cíclicamente si existe un índice i tal que la sucesión

   x(i), x(i+1), ..., x(n), x(1), ..., x(i-1)

1	x(i), x(i+1), ..., x(n), x(1), ..., x(i-1)

está ordenada crecientemente de forma estricta.

Definir la función

   ordenadaCiclicamente :: Ord a => [a] -> Maybe Int

1	ordenadaCiclicamente :: Ord a => [a] -> Maybe Int

tal que (ordenadaCiclicamente xs) es el índice a partir del cual está ordenada, si la lista está ordenado cíclicamente y Nothing en caso contrario. Por ejemplo,

   ordenadaCiclicamente [1,2,3,4]      ==  Just 0
   ordenadaCiclicamente [5,8,1,3]      ==  Just 2
   ordenadaCiclicamente [4,6,7,5,1,3]  ==  Nothing
   ordenadaCiclicamente [1,0,3,2]      ==  Nothing
   ordenadaCiclicamente [1,2,0]        ==  Just 2
   ordenadaCiclicamente "cdeab"        ==  Just 3

ordenadaCiclicamente [1,2,3,4] == Just 0

ordenadaCiclicamente [5,8,1,3] == Just 2

ordenadaCiclicamente [4,6,7,5,1,3] == Nothing

ordenadaCiclicamente [1,0,3,2] == Nothing

ordenadaCiclicamente [1,2,0] == Just 2

ordenadaCiclicamente "cdeab" == Just 3

Nota: Se supone que el argumento es una lista no vacía sin elementos repetidos.

Soluciones

module Ordenada_ciclicamente where

import Test.QuickCheck (Arbitrary, Gen, NonEmptyList (NonEmpty), Property,
                        arbitrary, chooseInt, collect, quickCheck)
import Data.List       (nub, sort)
import Data.Maybe      (isJust, listToMaybe)

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

ordenadaCiclicamente1 :: Ord a => [a] -> Maybe Int
ordenadaCiclicamente1 xs = aux 0 xs
  where n = length xs
        aux i zs
          | i == n      = Nothing
          | ordenada zs = Just i
          | otherwise   = aux (i+1) (siguienteCiclo zs)

-- (ordenada xs) se verifica si la lista xs está ordenada
-- crecientemente. Por ejemplo,
--   ordenada "acd"   ==  True
--   ordenada "acdb"  ==  False
ordenada :: Ord a => [a] -> Bool
ordenada []     = True
ordenada (x:xs) = all (x <) xs && ordenada xs

-- (siguienteCiclo xs) es la lista obtenida añadiendo el primer elemento
-- de xs al final del resto de xs. Por ejemplo,
--   siguienteCiclo [3,2,5]  =>  [2,5,3]
siguienteCiclo :: [a] -> [a]
siguienteCiclo []     = []
siguienteCiclo (x:xs) = xs ++ [x]

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

ordenadaCiclicamente2 :: Ord a => [a] -> Maybe Int
ordenadaCiclicamente2 xs =
  listToMaybe [n | n <- [0..length xs-1],
                   ordenada (drop n xs ++ take n xs)]

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

ordenadaCiclicamente3 :: Ord a => [a] -> Maybe Int
ordenadaCiclicamente3 xs
  | ordenada (bs ++ as) = Just k
  | otherwise           = Nothing
  where (_,k)   = minimum (zip xs [0..])
        (as,bs) = splitAt k xs

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_ordenadaCiclicamente1 :: NonEmptyList Int -> Bool
prop_ordenadaCiclicamente1 (NonEmpty xs) =
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

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

-- La propiedad para analizar los casos de prueba
prop_ordenadaCiclicamente2 :: NonEmptyList Int -> Property
prop_ordenadaCiclicamente2 (NonEmpty xs) =
  collect (isJust (ordenadaCiclicamente1 xs)) $
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es
--    λ> quickCheck prop_ordenadaCiclicamente2
--    +++ OK, passed 100 tests:
--    89% False
--    11% True

-- Tipo para generar listas
newtype Lista = L [Int]
  deriving Show

-- Generador de listas.
listaArbitraria :: Gen Lista
listaArbitraria = do
  x <- arbitrary
  xs <- arbitrary
  let ys = x : xs
  k <- chooseInt (0, length ys)
  let (as,bs) = splitAt k (sort (nub ys))
  return (L (bs ++ as))

-- Lista es una subclase de Arbitrary.
instance Arbitrary Lista where
  arbitrary = listaArbitraria

-- La propiedad para analizar los casos de prueba
prop_ordenadaCiclicamente3 :: Lista -> Property
prop_ordenadaCiclicamente3 (L xs) =
  collect (isJust (ordenadaCiclicamente1 xs)) $
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es
--    λ> quickCheck prop_ordenadaCiclicamente3
--    +++ OK, passed 100 tests (100% True).

-- Tipo para generar
newtype Lista2 = L2 [Int]
  deriving Show

-- Generador de listas
listaArbitraria2 :: Gen Lista2
listaArbitraria2 = do
  x' <- arbitrary
  xs <- arbitrary
  let ys = x' : xs
  k <- chooseInt (0, length ys)
  let (as,bs) = splitAt k (sort (nub ys))
  n <- chooseInt (0,1)
  return (if even n
          then L2 (bs ++ as)
          else L2 ys)

-- Lista es una subclase de Arbitrary.
instance Arbitrary Lista2 where
  arbitrary = listaArbitraria2

-- La propiedad para analizar los casos de prueba
prop_ordenadaCiclicamente4 :: Lista2 -> Property
prop_ordenadaCiclicamente4 (L2 xs) =
  collect (isJust (ordenadaCiclicamente1 xs)) $
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es
--    λ> quickCheck prop_ordenadaCiclicamente4
--    +++ OK, passed 100 tests:
--    51% True
--    49% False

-- La propiedad es
prop_ordenadaCiclicamente :: Lista2 -> Bool
prop_ordenadaCiclicamente (L2 xs) =
  all (== ordenadaCiclicamente1 xs)
      [ordenadaCiclicamente2 xs,
       ordenadaCiclicamente3 xs]

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

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

-- La comparación es
--    λ> ordenadaCiclicamente1 ([100..4000] ++ [1..99])
--    Just 3901
--    (3.27 secs, 2,138,864,568 bytes)
--    λ> ordenadaCiclicamente2 ([100..4000] ++ [1..99])
--    Just 3901
--    (2.44 secs, 1,430,040,008 bytes)
--    λ> ordenadaCiclicamente3 ([100..4000] ++ [1..99])
--    Just 3901
--    (1.18 secs, 515,549,200 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

147

148

149

150

151

152

153

154

155

156

157

158

159

160

module Ordenada_ciclicamente where

import Test.QuickCheck (Arbitrary, Gen, NonEmptyList (NonEmpty), Property,

arbitrary, chooseInt, collect, quickCheck)

import Data.List (nub, sort)

import Data.Maybe (isJust, listToMaybe)

-- 1ª solución

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

ordenadaCiclicamente1 :: Ord a => [a] -> Maybe Int

ordenadaCiclicamente1 xs = aux 0 xs

where n = length xs

aux i zs

| i == n = Nothing

| ordenada zs = Just i

| otherwise = aux (i+1) (siguienteCiclo zs)

-- (ordenada xs) se verifica si la lista xs está ordenada

-- crecientemente. Por ejemplo,

-- ordenada "acd" == True

-- ordenada "acdb" == False

ordenada :: Ord a => [a] -> Bool

ordenada [] = True

ordenada (x:xs) = all (x <) xs && ordenada xs

-- (siguienteCiclo xs) es la lista obtenida añadiendo el primer elemento

-- de xs al final del resto de xs. Por ejemplo,

-- siguienteCiclo [3,2,5] => [2,5,3]

siguienteCiclo :: [a] -> [a]

siguienteCiclo [] = []

siguienteCiclo (x:xs) = xs ++ [x]

-- 2ª solución

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

ordenadaCiclicamente2 :: Ord a => [a] -> Maybe Int

ordenadaCiclicamente2 xs =

listToMaybe [n | n <- [0..length xs-1],

ordenada (drop n xs ++ take n xs)]

-- 3ª solución

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

ordenadaCiclicamente3 :: Ord a => [a] -> Maybe Int

ordenadaCiclicamente3 xs

| ordenada (bs ++ as) = Just k

| otherwise = Nothing

where (_,k) = minimum (zip xs [0..])

(as,bs) = splitAt k xs

-- Comprobación de equivalencia

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

-- La propiedad es

prop_ordenadaCiclicamente1 :: NonEmptyList Int -> Bool

prop_ordenadaCiclicamente1 (NonEmpty xs) =

ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- La comprobación es

-- λ> quickCheck prop_ordenadaCiclicamente1

-- +++ OK, passed 100 tests.

-- La propiedad para analizar los casos de prueba

prop_ordenadaCiclicamente2 :: NonEmptyList Int -> Property

prop_ordenadaCiclicamente2 (NonEmpty xs) =

collect (isJust (ordenadaCiclicamente1 xs)) $

ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es

-- λ> quickCheck prop_ordenadaCiclicamente2

-- +++ OK, passed 100 tests:

-- 89% False

-- 11% True

-- Tipo para generar listas

newtype Lista = L [Int]

deriving Show

-- Generador de listas.

listaArbitraria :: Gen Lista

listaArbitraria = do

x <- arbitrary

xs <- arbitrary

let ys = x : xs

k <- chooseInt (0, length ys)

let (as,bs) = splitAt k (sort (nub ys))

return (L (bs ++ as))

-- Lista es una subclase de Arbitrary.

instance Arbitrary Lista where

arbitrary = listaArbitraria

-- La propiedad para analizar los casos de prueba

prop_ordenadaCiclicamente3 :: Lista -> Property

prop_ordenadaCiclicamente3 (L xs) =

collect (isJust (ordenadaCiclicamente1 xs)) $

ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es

-- λ> quickCheck prop_ordenadaCiclicamente3

-- +++ OK, passed 100 tests (100% True).

-- Tipo para generar

newtype Lista2 = L2 [Int]

deriving Show

-- Generador de listas

listaArbitraria2 :: Gen Lista2

listaArbitraria2 = do

x' <- arbitrary

xs <- arbitrary

let ys = x' : xs

k <- chooseInt (0, length ys)

let (as,bs) = splitAt k (sort (nub ys))

n <- chooseInt (0,1)

return (if even n

then L2 (bs ++ as)

else L2 ys)

-- Lista es una subclase de Arbitrary.

instance Arbitrary Lista2 where

arbitrary = listaArbitraria2

-- La propiedad para analizar los casos de prueba

prop_ordenadaCiclicamente4 :: Lista2 -> Property

prop_ordenadaCiclicamente4 (L2 xs) =

collect (isJust (ordenadaCiclicamente1 xs)) $

ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es

-- λ> quickCheck prop_ordenadaCiclicamente4

-- +++ OK, passed 100 tests:

-- 51% True

-- 49% False

-- La propiedad es

prop_ordenadaCiclicamente :: Lista2 -> Bool

prop_ordenadaCiclicamente (L2 xs) =

all (== ordenadaCiclicamente1 xs)

[ordenadaCiclicamente2 xs,

ordenadaCiclicamente3 xs]

-- La comprobación es

-- λ> quickCheck prop_ordenadaCiclicamente

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> ordenadaCiclicamente1 ([100..4000] ++ [1..99])

-- Just 3901

-- (3.27 secs, 2,138,864,568 bytes)

-- λ> ordenadaCiclicamente2 ([100..4000] ++ [1..99])

-- Just 3901

-- (2.44 secs, 1,430,040,008 bytes)

-- λ> ordenadaCiclicamente3 ([100..4000] ++ [1..99])

-- Just 3901

-- (1.18 secs, 515,549,200 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>

Eliminación de las ocurrencias aisladas.

PorJosé A. Alonso 20-abril-202230-abril-2022

Definir la función

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

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

tal que (eliminaAisladas x ys) es la lista obtenida eliminando en ys las ocurrencias aisladas de x (es decir, aquellas ocurrencias de x tales que su elemento anterior y posterior son distintos de x). Por ejemplo,

   eliminaAisladas 'X' ""                  == ""
   eliminaAisladas 'X' "X"                 == ""
   eliminaAisladas 'X' "XX"                == "XX"
   eliminaAisladas 'X' "XXX"               == "XXX"
   eliminaAisladas 'X' "abcd"              == "abcd"
   eliminaAisladas 'X' "Xabcd"             == "abcd"
   eliminaAisladas 'X' "XXabcd"            == "XXabcd"
   eliminaAisladas 'X' "XXXabcd"           == "XXXabcd"
   eliminaAisladas 'X' "abcdX"             == "abcd"
   eliminaAisladas 'X' "abcdXX"            == "abcdXX"
   eliminaAisladas 'X' "abcdXXX"           == "abcdXXX"
   eliminaAisladas 'X' "abXcd"             == "abcd"
   eliminaAisladas 'X' "abXXcd"            == "abXXcd"
   eliminaAisladas 'X' "abXXXcd"           == "abXXXcd"
   eliminaAisladas 'X' "XabXcdX"           == "abcd"
   eliminaAisladas 'X' "XXabXXcdXX"        == "XXabXXcdXX"
   eliminaAisladas 'X' "XXXabXXXcdXXX"     == "XXXabXXXcdXXX"
   eliminaAisladas 'X' "XabXXcdXeXXXfXx"   == "abXXcdeXXXfx"

eliminaAisladas 'X' "" == ""

eliminaAisladas 'X' "X" == ""

eliminaAisladas 'X' "XX" == "XX"

eliminaAisladas 'X' "XXX" == "XXX"

eliminaAisladas 'X' "abcd" == "abcd"

eliminaAisladas 'X' "Xabcd" == "abcd"

eliminaAisladas 'X' "XXabcd" == "XXabcd"

eliminaAisladas 'X' "XXXabcd" == "XXXabcd"

eliminaAisladas 'X' "abcdX" == "abcd"

eliminaAisladas 'X' "abcdXX" == "abcdXX"

eliminaAisladas 'X' "abcdXXX" == "abcdXXX"

eliminaAisladas 'X' "abXcd" == "abcd"

eliminaAisladas 'X' "abXXcd" == "abXXcd"

eliminaAisladas 'X' "abXXXcd" == "abXXXcd"

eliminaAisladas 'X' "XabXcdX" == "abcd"

eliminaAisladas 'X' "XXabXXcdXX" == "XXabXXcdXX"

eliminaAisladas 'X' "XXXabXXXcdXXX" == "XXXabXXXcdXXX"

eliminaAisladas 'X' "XabXXcdXeXXXfXx" == "abXXcdeXXXfx"

Soluciones

module Elimina_aisladas where

import Data.List (group)
import Test.QuickCheck

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

eliminaAisladas1 :: Eq a => a -> [a] -> [a]
eliminaAisladas1 _ [] = []
eliminaAisladas1 x [y]
  | x == y    = []
  | otherwise = [y]
eliminaAisladas1 x (y1:y2:ys)
  | y1 /= x   = y1 : eliminaAisladas1 x (y2:ys)
  | y2 /= x   = y2 : eliminaAisladas1 x ys
  | otherwise = takeWhile (==x) (y1:y2:ys) ++
                eliminaAisladas1 x (dropWhile (==x) ys)

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

eliminaAisladas2 :: Eq a => a -> [a] -> [a]
eliminaAisladas2 _ [] = []
eliminaAisladas2 x ys
  | cs == [x] = as ++ eliminaAisladas2 x ds
  | otherwise = as ++ cs ++ eliminaAisladas2 x ds
  where (as,bs) = span (/=x) ys
        (cs,ds) = span (==x) bs

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

eliminaAisladas3 :: Eq a => a -> [a] -> [a]
eliminaAisladas3 x ys = concat [zs | zs <- group ys, zs /= [x]]

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

eliminaAisladas4 :: Eq a => a -> [a] -> [a]
eliminaAisladas4 x = concat . filter (/= [x]) . group


-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_eliminaAisladas :: Int -> [Int] -> Bool
prop_eliminaAisladas x ys =
  all (== eliminaAisladas1 x ys)
      [eliminaAisladas2 x ys,
       eliminaAisladas3 x ys,
       eliminaAisladas4 x ys]

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

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

-- La comparación es
--    λ> length (eliminaAisladas1 'a' (take (5*10^6) (cycle "abca")))
--    4999998
--    (3.86 secs, 2,030,515,400 bytes)
--    λ> length (eliminaAisladas2 'a' (take (5*10^6) (cycle "abca")))
--    4999998
--    (3.41 secs, 2,210,516,832 bytes)
--    λ> length (eliminaAisladas3 'a' (take (5*10^6) (cycle "abca")))
--    4999998
--    (2.11 secs, 2,280,516,448 bytes)
--    λ> length (eliminaAisladas4 'a' (take (5*10^6) (cycle "abca")))
--    4999998
--    (0.92 secs, 1,920,516,704 bytes)

module Elimina_aisladas where

import Data.List (group)

import Test.QuickCheck

-- 1ª solución

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

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

eliminaAisladas1 _ [] = []

eliminaAisladas1 x [y]

| x == y = []

| otherwise = [y]

eliminaAisladas1 x (y1:y2:ys)

| y1 /= x = y1 : eliminaAisladas1 x (y2:ys)

| y2 /= x = y2 : eliminaAisladas1 x ys

| otherwise = takeWhile (==x) (y1:y2:ys) ++

eliminaAisladas1 x (dropWhile (==x) ys)

-- 2ª solución

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

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

eliminaAisladas2 _ [] = []

eliminaAisladas2 x ys

| cs == [x] = as ++ eliminaAisladas2 x ds

| otherwise = as ++ cs ++ eliminaAisladas2 x ds

where (as,bs) = span (/=x) ys

(cs,ds) = span (==x) bs

-- 3ª solución

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

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

eliminaAisladas3 x ys = concat [zs | zs <- group ys, zs /= [x]]

-- 4ª solución

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

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

eliminaAisladas4 x = concat . filter (/= [x]) . group

-- Comprobación de equivalencia

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

-- La propiedad es

prop_eliminaAisladas :: Int -> [Int] -> Bool

prop_eliminaAisladas x ys =

all (== eliminaAisladas1 x ys)

[eliminaAisladas2 x ys,

eliminaAisladas3 x ys,

eliminaAisladas4 x ys]

-- La comprobación es

-- λ> quickCheck prop_eliminaAisladas

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (eliminaAisladas1 'a' (take (5*10^6) (cycle "abca")))

-- 4999998

-- (3.86 secs, 2,030,515,400 bytes)

-- λ> length (eliminaAisladas2 'a' (take (5*10^6) (cycle "abca")))

-- 4999998

-- (3.41 secs, 2,210,516,832 bytes)

-- λ> length (eliminaAisladas3 'a' (take (5*10^6) (cycle "abca")))

-- 4999998

-- (2.11 secs, 2,280,516,448 bytes)

-- λ> length (eliminaAisladas4 'a' (take (5*10^6) (cycle "abca")))

-- 4999998

-- (0.92 secs, 1,920,516,704 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 de árboles

PorJosé A. Alonso 18-abril-202230-abril-2022

Los árboles se pueden representar mediante el siguiente tipo de datos

   data Arbol a = N a [Arbol a]
     deriving (Show, Eq)

1 2	data Arbol a = N a [Arbol a] deriving (Show, Eq)

Por ejemplo, los árboles

     1               3
    / \             /|\
   6   3           / | \
       |          5  4  7
       5          |     /\
                  6    2  1

1 3

/ \ /|\

6 3 / | \

| 5 4 7

5 | /\

6 2 1

se representan por

   ej1, ej2 :: Arbol Int
   ej1 = N 1 [N 6 [],N 3 [N 5 []]]
   ej2 = N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]]

ej1, ej2 :: Arbol Int

ej1 = N 1 [N 6 [],N 3 [N 5 []]]

ej2 = N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]]

Definir la función

   emparejaArboles :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c

1	emparejaArboles :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c

tal que (emparejaArboles f a1 a2) es el árbol obtenido aplicando la función f a los elementos de los árboles a1 y a2 que se encuentran en la misma posición. Por ejemplo,

   λ> emparejaArboles (+) (N 1 [N 2 [], N 3[]]) (N 1 [N 6 []])
   N 2 [N 8 []]
   λ> emparejaArboles (+) ej1 ej2
   N 4 [N 11 [],N 7 []]
   λ> emparejaArboles (+) ej1 ej1
   N 2 [N 12 [],N 6 [N 10 []]]

λ> emparejaArboles (+) (N 1 [N 2 [], N 3[]]) (N 1 [N 6 []])

N 2 [N 8 []]

λ> emparejaArboles (+) ej1 ej2

N 4 [N 11 [],N 7 []]

λ> emparejaArboles (+) ej1 ej1

N 2 [N 12 [],N 6 [N 10 []]]

Soluciones

module Emparejamiento_de_arboles where

import Data.Tree (Tree (..))
import Control.Monad.Zip (mzipWith)
import Test.QuickCheck (Arbitrary, Gen, arbitrary, sublistOf, sized, quickCheck)

data Arbol a = N a [Arbol a]
  deriving (Show, Eq)

ej1, ej2 :: Arbol Int
ej1 = N 1 [N 6 [],N 3 [N 5 []]]
ej2 = N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]]

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

emparejaArboles1 :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c
emparejaArboles1 f (N x xs) (N y ys) =
  N (f x y) (zipWith (emparejaArboles1 f) xs ys)

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

emparejaArboles2 :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c
emparejaArboles2 f x y =
  treeAarbol (mzipWith f (arbolAtree x) (arbolAtree y))

arbolAtree :: Arbol a -> Tree a
arbolAtree (N x xs) = Node x (map arbolAtree xs)

treeAarbol :: Tree a -> Arbol a
treeAarbol (Node x xs) = N x (map treeAarbol xs)

-- Comprobación de equivalencia
-- ============================

-- (arbolArbitrario n) es un árbol aleatorio de orden n. Por ejemplo,
--    λ> generate (arbolArbitrario 5 :: Gen (Arbol Int))
--    N (-26) [N 8 [N 6 [N 11 []]],N 7 []]
--    λ> generate (arbolArbitrario 5 :: Gen (Arbol Int))
--    N 1 []
--    λ> generate (arbolArbitrario 5 :: Gen (Arbol Int))
--    N (-19) [N (-11) [],N 25 [],N 19 [N (-27) [],N (-19) [N 17 []]]]
arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)
arbolArbitrario n = do
  x  <- arbitrary
  ms <- sublistOf [0 .. n `div` 2]
  as <- mapM arbolArbitrario ms
  return (N x as)

-- Arbol es una subclase de Arbitraria
instance Arbitrary a => Arbitrary (Arbol a) where
  arbitrary = sized arbolArbitrario

-- La propiedad es
prop_emparejaArboles :: Arbol Int -> Arbol Int -> Bool
prop_emparejaArboles x y =
  emparejaArboles1 (+) x y == emparejaArboles2 (+) x y &&
  emparejaArboles1 (*) x y == emparejaArboles2 (*) x y

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

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

-- La comparación es
--    λ> a500 <- generate (arbolArbitrario 500 :: Gen (Arbol Int))
--    λ> emparejaArboles1 (+) a500 a500 == emparejaArboles1 (+) a500 a500
--    True
--    (1.92 secs, 1,115,813,352 bytes)
--    λ> emparejaArboles2 (+) a500 a500 == emparejaArboles2 (+) a500 a500
--    True
--    (3.28 secs, 2,212,257,928 bytes)
--
--    λ> b500 = arbolAtree a500
--    λ> mzipWith (+) b500 b500 == mzipWith (+) b500 b500
--    True
--    (0.21 secs, 563,503,112 bytes)

module Emparejamiento_de_arboles where

import Data.Tree (Tree (..))

import Control.Monad.Zip (mzipWith)

import Test.QuickCheck (Arbitrary, Gen, arbitrary, sublistOf, sized, quickCheck)

data Arbol a = N a [Arbol a]

deriving (Show, Eq)

ej1, ej2 :: Arbol Int

ej1 = N 1 [N 6 [],N 3 [N 5 []]]

ej2 = N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]]

-- 1ª solución

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

emparejaArboles1 :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c

emparejaArboles1 f (N x xs) (N y ys) =

N (f x y) (zipWith (emparejaArboles1 f) xs ys)

-- 2ª solución

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

emparejaArboles2 :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c

emparejaArboles2 f x y =

treeAarbol (mzipWith f (arbolAtree x) (arbolAtree y))

arbolAtree :: Arbol a -> Tree a

arbolAtree (N x xs) = Node x (map arbolAtree xs)

treeAarbol :: Tree a -> Arbol a

treeAarbol (Node x xs) = N x (map treeAarbol xs)

-- Comprobación de equivalencia

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

-- (arbolArbitrario n) es un árbol aleatorio de orden n. Por ejemplo,

-- λ> generate (arbolArbitrario 5 :: Gen (Arbol Int))

-- N (-26) [N 8 [N 6 [N 11 []]],N 7 []]

-- λ> generate (arbolArbitrario 5 :: Gen (Arbol Int))

-- N 1 []

-- λ> generate (arbolArbitrario 5 :: Gen (Arbol Int))

-- N (-19) [N (-11) [],N 25 [],N 19 [N (-27) [],N (-19) [N 17 []]]]

arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)

arbolArbitrario n = do

x <- arbitrary

ms <- sublistOf [0 .. n `div` 2]

as <- mapM arbolArbitrario ms

return (N x as)

-- Arbol es una subclase de Arbitraria

instance Arbitrary a => Arbitrary (Arbol a) where

arbitrary = sized arbolArbitrario

-- La propiedad es

prop_emparejaArboles :: Arbol Int -> Arbol Int -> Bool

prop_emparejaArboles x y =

emparejaArboles1 (+) x y == emparejaArboles2 (+) x y &&

emparejaArboles1 (*) x y == emparejaArboles2 (*) x y

-- La comprobación es

-- λ> quickCheck prop_emparejaArboles

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> a500 <- generate (arbolArbitrario 500 :: Gen (Arbol Int))

-- λ> emparejaArboles1 (+) a500 a500 == emparejaArboles1 (+) a500 a500

-- True

-- (1.92 secs, 1,115,813,352 bytes)

-- λ> emparejaArboles2 (+) a500 a500 == emparejaArboles2 (+) a500 a500

-- True

-- (3.28 secs, 2,212,257,928 bytes)

-- λ> b500 = arbolAtree a500

-- λ> mzipWith (+) b500 b500 == mzipWith (+) b500 b500

-- True

-- (0.21 secs, 563,503,112 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>

Separación por posición

PorJosé A. Alonso 15-abril-202230-abril-2022

Definir la función

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

1	particion :: [a] -> ([a],[a])

tal que (particion xs) es el par cuya primera componente son los elementos de xs en posiciones pares y su segunda componente son los restantes elementos. Por ejemplo,

   particion [3,5,6,2]    ==  ([3,6],[5,2])
   particion [3,5,6,2,7]  ==  ([3,6,7],[5,2])
   particion "particion"  ==  ("priin","atco")

particion [3,5,6,2] == ([3,6],[5,2])

particion [3,5,6,2,7] == ([3,6,7],[5,2])

particion "particion" == ("priin","atco")

Soluciones

module Separacion_por_posicion where

import Data.List (partition)
import qualified Data.Vector as V ((!), fromList, length)
import Test.QuickCheck (quickCheck)

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

particion1 :: [a] -> ([a],[a])
particion1 xs = ([x | (n,x) <- nxs, even n],
                 [x | (n,x) <- nxs, odd n])
  where nxs = enumeracion xs

--(numeracion xs) es la enumeración de xs. Por ejemplo,
--    enumeracion [7,9,6,8]  ==  [(0,7),(1,9),(2,6),(3,8)]
enumeracion :: [a] -> [(Int,a)]
enumeracion = zip [0..]

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

particion2 :: [a] -> ([a],[a])
particion2 []     = ([],[])
particion2 (x:xs) = (x:zs,ys)
  where (ys,zs) = particion2 xs

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

particion3 :: [a] -> ([a],[a])
particion3 = foldr f ([],[])
  where f x (ys,zs) = (x:zs,ys)

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

particion4 :: [a] -> ([a],[a])
particion4 = foldr (\x (ys,zs) -> (x:zs,ys)) ([],[])

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

particion5 :: [a] -> ([a],[a])
particion5 xs =
  ([xs!!k | k <- [0,2..n]],
   [xs!!k | k <- [1,3..n]])
  where n = length xs - 1

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

particion6 :: [a] -> ([a],[a])
particion6 xs = (pares xs, impares xs)

-- (pares xs) es la lista de los elementos de xs en posiciones
-- pares. Por ejemplo,
--    pares [3,5,6,2]  ==  [3,6]
pares :: [a] -> [a]
pares []     = []
pares (x:xs) = x : impares xs

-- (impares xs) es la lista de los elementos de xs en posiciones
-- impares. Por ejemplo,
--    impares [3,5,6,2]  ==  [5,2]
impares :: [a] -> [a]
impares []     = []
impares (_:xs) = pares xs

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

particion7 :: [a] -> ([a],[a])
particion7 [] = ([],[])
particion7 xs =
  ([v V.! k | k <- [0,2..n-1]],
   [v V.! k | k <- [1,3..n-1]])
  where v = V.fromList xs
        n = V.length v

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

particion8 :: [a] -> ([a],[a])
particion8 xs =
  (map snd ys, map snd zs)
  where (ys,zs) = partition posicionPar (zip [0..] xs)

posicionPar :: (Int,a) -> Bool
posicionPar = even . fst

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_particion :: [Int] -> Bool
prop_particion xs =
  all (== particion1 xs)
      [particion2 xs,
       particion3 xs,
       particion4 xs,
       particion5 xs,
       particion6 xs,
       particion7 xs,
       particion8 xs]

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

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

-- La comparación es
--    λ> last (snd (particion1 [1..6*10^6]))
--    6000000
--    (2.74 secs, 2,184,516,080 bytes)
--    λ> last (snd (particion2 [1..6*10^6]))
--    6000000
--    (2.02 secs, 1,992,515,880 bytes)
--    λ> last (snd (particion3 [1..6*10^6]))
--    6000000
--    (3.17 secs, 1,767,423,240 bytes)
--    λ> last (snd (particion4 [1..6*10^6]))
--    6000000
--    (3.23 secs, 1,767,423,240 bytes)
--    λ> last (snd (particion5 [1..6*10^6]))
--    6000000
--    (1.62 secs, 1,032,516,192 bytes)
--    λ> last (snd (particion5 [1..6*10^6]))
--    6000000
--    (1.33 secs, 1,032,516,192 bytes)
--    λ> last (snd (particion6 [1..6*10^6]))
--    6000000
--    (1.80 secs, 888,515,960 bytes)
--    λ> last (snd (particion7 [1..6*10^6]))
--    6000000
--    (1.29 secs, 1,166,865,672 bytes)
--    λ> last (snd (particion8 [1..6*10^6]))
--    6000000
--    (0.87 secs, 3,384,516,616 bytes)
--
--    λ> last (snd (particion5 [1..10^7]))
--    10000000
--    (1.94 secs, 1,720,516,872 bytes)
--    λ> last (snd (particion7 [1..10^7]))
--    10000000
--    (2.54 secs, 1,989,215,176 bytes)
--    λ> last (snd (particion8 [1..10^7]))
--    10000000
--    (1.33 secs, 5,640,516,960 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

147

148

149

150

151

module Separacion_por_posicion where

import Data.List (partition)

import qualified Data.Vector as V ((!), fromList, length)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

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

particion1 xs = ([x | (n,x) <- nxs, even n],

[x | (n,x) <- nxs, odd n])

where nxs = enumeracion xs

--(numeracion xs) es la enumeración de xs. Por ejemplo,

-- enumeracion [7,9,6,8] == [(0,7),(1,9),(2,6),(3,8)]

enumeracion :: [a] -> [(Int,a)]

enumeracion = zip [0..]

-- 2ª solución

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

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

particion2 [] = ([],[])

particion2 (x:xs) = (x:zs,ys)

where (ys,zs) = particion2 xs

-- 3ª solución

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

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

particion3 = foldr f ([],[])

where f x (ys,zs) = (x:zs,ys)

-- 4ª solución

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

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

particion4 = foldr (\x (ys,zs) -> (x:zs,ys)) ([],[])

-- 5ª solución

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

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

particion5 xs =

([xs!!k | k <- [0,2..n]],

[xs!!k | k <- [1,3..n]])

where n = length xs - 1

-- 6ª solución

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

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

particion6 xs = (pares xs, impares xs)

-- (pares xs) es la lista de los elementos de xs en posiciones

-- pares. Por ejemplo,

-- pares [3,5,6,2] == [3,6]

pares :: [a] -> [a]

pares [] = []

pares (x:xs) = x : impares xs

-- (impares xs) es la lista de los elementos de xs en posiciones

-- impares. Por ejemplo,

-- impares [3,5,6,2] == [5,2]

impares :: [a] -> [a]

impares [] = []

impares (_:xs) = pares xs

-- 7ª solución

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

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

particion7 [] = ([],[])

particion7 xs =

([v V.! k | k <- [0,2..n-1]],

[v V.! k | k <- [1,3..n-1]])

where v = V.fromList xs

n = V.length v

-- 8ª solución

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

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

particion8 xs =

(map snd ys, map snd zs)

where (ys,zs) = partition posicionPar (zip [0..] xs)

posicionPar :: (Int,a) -> Bool

posicionPar = even . fst

-- Comprobación de equivalencia

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

-- La propiedad es

prop_particion :: [Int] -> Bool

prop_particion xs =

all (== particion1 xs)

[particion2 xs,

particion3 xs,

particion4 xs,

particion5 xs,

particion6 xs,

particion7 xs,

particion8 xs]

-- La comprobación es

-- λ> quickCheck prop_particion

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (snd (particion1 [1..6*10^6]))

-- 6000000

-- (2.74 secs, 2,184,516,080 bytes)

-- λ> last (snd (particion2 [1..6*10^6]))

-- 6000000

-- (2.02 secs, 1,992,515,880 bytes)

-- λ> last (snd (particion3 [1..6*10^6]))

-- 6000000

-- (3.17 secs, 1,767,423,240 bytes)

-- λ> last (snd (particion4 [1..6*10^6]))

-- 6000000

-- (3.23 secs, 1,767,423,240 bytes)

-- λ> last (snd (particion5 [1..6*10^6]))

-- 6000000

-- (1.62 secs, 1,032,516,192 bytes)

-- λ> last (snd (particion5 [1..6*10^6]))

-- 6000000

-- (1.33 secs, 1,032,516,192 bytes)

-- λ> last (snd (particion6 [1..6*10^6]))

-- 6000000

-- (1.80 secs, 888,515,960 bytes)

-- λ> last (snd (particion7 [1..6*10^6]))

-- 6000000

-- (1.29 secs, 1,166,865,672 bytes)

-- λ> last (snd (particion8 [1..6*10^6]))

-- 6000000

-- (0.87 secs, 3,384,516,616 bytes)

-- λ> last (snd (particion5 [1..10^7]))

-- 10000000

-- (1.94 secs, 1,720,516,872 bytes)

-- λ> last (snd (particion7 [1..10^7]))

-- 10000000

-- (2.54 secs, 1,989,215,176 bytes)

-- λ> last (snd (particion8 [1..10^7]))

-- 10000000

-- (1.33 secs, 5,640,516,960 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>

Número de inversiones

PorJosé A. Alonso 14-abril-202213-abril-2022

Se dice que en una sucesión de números x(1), x(2), …, x(n) hay una inversión cuando existe un par de números x(i) > x(j), siendo i < j. Por ejemplo, en la permutación 2, 1, 4, 3 hay dos inversiones (2 antes que 1 y 4 antes que 3) y en la permutación 4, 3, 1, 2 hay cinco inversiones (4 antes 3, 4 antes 1, 4 antes 2, 3 antes 1, 3 antes 2).

Definir la función

   numeroInversiones :: Ord a => [a] -> Int

1	numeroInversiones :: Ord a => [a] -> Int

tal que (numeroInversiones xs) es el número de inversiones de xs. Por ejemplo,

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

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

Soluciones

[schedule expon=’2022-04-21′ 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-21′ at=»06:00″]

import Test.QuickCheck (quickCheck)
import Data.Array ((!), listArray)

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

numeroInversiones1 :: Ord a => [a] -> Int
numeroInversiones1 = length . indicesInversiones

-- (indicesInversiones xs) es la lista de los índices de las inversiones
-- de xs. Por ejemplo,
--    indicesInversiones [2,1,4,3]  ==  [(0,1),(2,3)]
--    indicesInversiones [4,3,1,2]  ==  [(0,1),(0,2),(0,3),(1,2),(1,3)]
indicesInversiones :: Ord a => [a] -> [(Int,Int)]
indicesInversiones xs = [(i,j) | i <- [0..n-2],
                                 j <- [i+1..n-1],
                                 xs!!i > xs!!j]
  where n = length xs

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

numeroInversiones2 :: Ord a => [a] -> Int
numeroInversiones2 = length . indicesInversiones2

indicesInversiones2 :: Ord a => [a] -> [(Int,Int)]
indicesInversiones2 xs = [(i,j) | i <- [0..n-2],
                                  j <- [i+1..n-1],
                                  v!i > v!j]
  where n = length xs
        v = listArray (0,n-1) xs

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

numeroInversiones3 :: Ord a => [a] -> Int
numeroInversiones3 = length . inversiones

-- (inversiones xs) es la lista de las inversiones  de xs. Por ejemplo,
--    Inversiones [2,1,4,3]  ==  [(2,1),(4,3)]
--    Inversiones [4,3,1,2]  ==  [(4,3),(4,1),(4,2),(3,1),(3,2)]
inversiones :: Ord a => [a] -> [(a,a)]
inversiones []     = []
inversiones (x:xs) = [(x,y) | y <- xs, y < x] ++ inversiones xs

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

numeroInversiones4 :: Ord a => [a] -> Int
numeroInversiones4 []     = 0
numeroInversiones4 (x:xs) = length (filter (x>) xs) + numeroInversiones4 xs

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_numeroInversiones :: [Int] -> Bool
prop_numeroInversiones xs =
  all (== numeroInversiones1 xs)
      [numeroInversiones2 xs,
       numeroInversiones3 xs,
       numeroInversiones4 xs]

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

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

-- La comparación es
--    λ> numeroInversiones1 [1200,1199..1]
--    719400
--    (2.30 secs, 236,976,776 bytes)
--    λ> numeroInversiones2 [1200,1199..1]
--    719400
--    (0.61 secs, 294,538,488 bytes)
--    λ> numeroInversiones3 [1200,1199..1]
--    719400
--    (0.26 secs, 150,543,056 bytes)
--    λ> numeroInversiones4 [1200,1199..1]
--    719400
--    (0.10 secs, 41,274,888 bytes)
--
--    λ> numeroInversiones3 [3000,2999..1]
--    4498500
--    (1.35 secs, 937,186,992 bytes)
--    λ> numeroInversiones4 [3000,2999..1]
--    4498500
--    (0.61 secs, 253,665,928 bytes)

import Test.QuickCheck (quickCheck)

import Data.Array ((!), listArray)

-- 1ª solución

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

numeroInversiones1 :: Ord a => [a] -> Int

numeroInversiones1 = length . indicesInversiones

-- (indicesInversiones xs) es la lista de los índices de las inversiones

-- de xs. Por ejemplo,

-- indicesInversiones [2,1,4,3] == [(0,1),(2,3)]

-- indicesInversiones [4,3,1,2] == [(0,1),(0,2),(0,3),(1,2),(1,3)]

indicesInversiones :: Ord a => [a] -> [(Int,Int)]

indicesInversiones xs = [(i,j) | i <- [0..n-2],

j <- [i+1..n-1],

xs!!i > xs!!j]

where n = length xs

-- 2ª solución

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

numeroInversiones2 :: Ord a => [a] -> Int

numeroInversiones2 = length . indicesInversiones2

indicesInversiones2 :: Ord a => [a] -> [(Int,Int)]

indicesInversiones2 xs = [(i,j) | i <- [0..n-2],

j <- [i+1..n-1],

v!i > v!j]

where n = length xs

v = listArray (0,n-1) xs

-- 3ª solución

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

numeroInversiones3 :: Ord a => [a] -> Int

numeroInversiones3 = length . inversiones

-- (inversiones xs) es la lista de las inversiones de xs. Por ejemplo,

-- Inversiones [2,1,4,3] == [(2,1),(4,3)]

-- Inversiones [4,3,1,2] == [(4,3),(4,1),(4,2),(3,1),(3,2)]

inversiones :: Ord a => [a] -> [(a,a)]

inversiones [] = []

inversiones (x:xs) = [(x,y) | y <- xs, y < x] ++ inversiones xs

-- 4ª solución

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

numeroInversiones4 :: Ord a => [a] -> Int

numeroInversiones4 [] = 0

numeroInversiones4 (x:xs) = length (filter (x>) xs) + numeroInversiones4 xs

-- Comprobación de equivalencia

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

-- La propiedad es

prop_numeroInversiones :: [Int] -> Bool

prop_numeroInversiones xs =

all (== numeroInversiones1 xs)

[numeroInversiones2 xs,

numeroInversiones3 xs,

numeroInversiones4 xs]

-- La comprobación es

-- λ> quickCheck prop_numeroInversiones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> numeroInversiones1 [1200,1199..1]

-- 719400

-- (2.30 secs, 236,976,776 bytes)

-- λ> numeroInversiones2 [1200,1199..1]

-- 719400

-- (0.61 secs, 294,538,488 bytes)

-- λ> numeroInversiones3 [1200,1199..1]

-- 719400

-- (0.26 secs, 150,543,056 bytes)

-- λ> numeroInversiones4 [1200,1199..1]

-- 719400

-- (0.10 secs, 41,274,888 bytes)

-- λ> numeroInversiones3 [3000,2999..1]

-- 4498500

-- (1.35 secs, 937,186,992 bytes)

-- λ> numeroInversiones4 [3000,2999..1]

-- 4498500

-- (0.61 secs, 253,665,928 bytes)

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

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]

Descomposiciones triangulares

PorJosé A. Alonso 13-abril-202215-abril-2022

Los números triangulares se forman como sigue

   *     *      *
        * *    * *
              * * *
   1     3      6

* * *

* * * *

* * *

1 3 6

La sucesión de los números triangulares se obtiene sumando los números naturales. Así, los 5 primeros números triangulares son

    1 = 1
    3 = 1 + 2
    6 = 1 + 2 + 3
   10 = 1 + 2 + 3 + 4
   15 = 1 + 2 + 3 + 4 + 5

1 = 1

3 = 1 + 2

6 = 1 + 2 + 3

10 = 1 + 2 + 3 + 4

15 = 1 + 2 + 3 + 4 + 5

Definir la función

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

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

tal que (descomposicionesTriangulares n) es la lista de las ternas correspondientes a las descomposiciones de n en tres sumandos formados por números triangulares. Por ejemplo,

   descomposicionesTriangulares  4 == []
   descomposicionesTriangulares  5 == [(1,1,3)]
   descomposicionesTriangulares 12 == [(1,1,10),(3,3,6)]
   descomposicionesTriangulares 30 == [(1,1,28),(3,6,21),(10,10,10)]
   descomposicionesTriangulares 61 == [(1,15,45),(3,3,55),(6,10,45),(10,15,36)]
   descomposicionesTriangulares 52 == [(1,6,45),(1,15,36),(3,21,28),(6,10,36),(10,21,21)]
   descomposicionesTriangulares 82 == [(1,3,78),(1,15,66),(1,36,45),(6,10,66),(6,21,55),(10,36,36)]
   length (descomposicionesTriangulares (5*10^5)) == 124

descomposicionesTriangulares 4 == []

descomposicionesTriangulares 5 == [(1,1,3)]

descomposicionesTriangulares 12 == [(1,1,10),(3,3,6)]

descomposicionesTriangulares 30 == [(1,1,28),(3,6,21),(10,10,10)]

descomposicionesTriangulares 61 == [(1,15,45),(3,3,55),(6,10,45),(10,15,36)]

descomposicionesTriangulares 52 == [(1,6,45),(1,15,36),(3,21,28),(6,10,36),(10,21,21)]

descomposicionesTriangulares 82 == [(1,3,78),(1,15,66),(1,36,45),(6,10,66),(6,21,55),(10,36,36)]

length (descomposicionesTriangulares (5*10^5)) == 124

Soluciones

[schedule expon=’2022-04-20′ 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-20′ at=»06:00″]

import Test.QuickCheck

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

descomposicionesTriangulares1 :: Int -> [(Int, Int, Int)]
descomposicionesTriangulares1 n =
  [(x,y,z) | x <- xs,
             y <- xs,
             z <- xs,
             x <= y && y <= z,
             x + y + z == n]
  where xs = takeWhile (<=n) triangulares

-- triangulares es la lista de los números triangulares. Por ejemplo,
--    take 9 triangulares  ==  [1,3,6,10,15,21,28,36,45]
triangulares :: [Int]
triangulares = scanl (+) 1 [2..]

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

descomposicionesTriangulares2 :: Int -> [(Int, Int, Int)]
descomposicionesTriangulares2 n =
  [(x,y,z) | x <- xs,
             y <- xs,
             x <= y,
             z <- xs,
             y <= z,
             x + y + z == n]
  where xs = takeWhile (<=n) triangulares

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

descomposicionesTriangulares3 :: Int -> [(Int, Int, Int)]
descomposicionesTriangulares3 n =
  [(x,y,z) | x <- xs,
             y <- xs,
             x <= y,
             let z = n - x - y,
             y <= z,
             z `elem` xs]
  where xs = takeWhile (<=n) triangulares

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

descomposicionesTriangulares4 :: Int -> [(Int, Int, Int)]
descomposicionesTriangulares4 n =
  [(x,y,n-x-y) | x <- xs,
                 y <- dropWhile (<x) xs,
                 let z = n - x - y,
                 y <= z,
                 z `elem` xs]
  where xs = takeWhile (<=n) triangulares

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_descomposicionesTriangulares ::  Positive Int -> Bool
prop_descomposicionesTriangulares (Positive n) =
  all (== descomposicionesTriangulares1 n)
      [descomposicionesTriangulares2 n,
       descomposicionesTriangulares3 n,
       descomposicionesTriangulares4 n]

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

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

-- La comparación es
--   λ> last (descomposicionesTriangulares1 (2*10^4))
--   (5671,6328,8001)
--   (3.34 secs, 1,469,517,168 bytes)
--   λ> last (descomposicionesTriangulares2 (2*10^4))
--   (5671,6328,8001)
--   (1.29 secs, 461,433,928 bytes)
--   λ> last (descomposicionesTriangulares3 (2*10^4))
--   (5671,6328,8001)
--   (0.08 secs, 6,574,056 bytes)
--
--   λ> last (descomposicionesTriangulares3 (5*10^5))
--   (140185,148240,211575)
--   (2.12 secs, 151,137,280 bytes)
--   λ> last (descomposicionesTriangulares4 (5*10^5))
--   (140185,148240,211575)
--   (2.30 secs, 103,280,216 bytes)

import Test.QuickCheck

-- 1ª solución

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

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

descomposicionesTriangulares1 n =

[(x,y,z) | x <- xs,

y <- xs,

z <- xs,

x <= y && y <= z,

x + y + z == n]

where xs = takeWhile (<=n) triangulares

-- triangulares es la lista de los números triangulares. Por ejemplo,

-- take 9 triangulares == [1,3,6,10,15,21,28,36,45]

triangulares :: [Int]

triangulares = scanl (+) 1 [2..]

-- 2ª solución

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

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

descomposicionesTriangulares2 n =

[(x,y,z) | x <- xs,

y <- xs,

x <= y,

z <- xs,

y <= z,

x + y + z == n]

where xs = takeWhile (<=n) triangulares

-- 3ª solución

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

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

descomposicionesTriangulares3 n =

[(x,y,z) | x <- xs,

y <- xs,

x <= y,

let z = n - x - y,

y <= z,

z `elem` xs]

where xs = takeWhile (<=n) triangulares

-- 4ª solución

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

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

descomposicionesTriangulares4 n =

[(x,y,n-x-y) | x <- xs,

y <- dropWhile (<x) xs,

let z = n - x - y,

y <= z,

z `elem` xs]

where xs = takeWhile (<=n) triangulares

-- Comprobación de equivalencia

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

-- La propiedad es

prop_descomposicionesTriangulares :: Positive Int -> Bool

prop_descomposicionesTriangulares (Positive n) =

all (== descomposicionesTriangulares1 n)

[descomposicionesTriangulares2 n,

descomposicionesTriangulares3 n,

descomposicionesTriangulares4 n]

-- La comprobación es

-- λ> quickCheck prop_descomposicionesTriangulares

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (descomposicionesTriangulares1 (2*10^4))

-- (5671,6328,8001)

-- (3.34 secs, 1,469,517,168 bytes)

-- λ> last (descomposicionesTriangulares2 (2*10^4))

-- (5671,6328,8001)

-- (1.29 secs, 461,433,928 bytes)

-- λ> last (descomposicionesTriangulares3 (2*10^4))

-- (5671,6328,8001)

-- (0.08 secs, 6,574,056 bytes)

-- λ> last (descomposicionesTriangulares3 (5*10^5))

-- (140185,148240,211575)

-- (2.12 secs, 151,137,280 bytes)

-- λ> last (descomposicionesTriangulares4 (5*10^5))

-- (140185,148240,211575)

-- (2.30 secs, 103,280,216 bytes)

El código se encuentra en [GitHub](https://github.com/jaalonso/Exercitium/blob/main/src/Descomposiciones_triangulares.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]

Índices de valores verdaderos

PorJosé A. Alonso 12-abril-202211-abril-2022

Definir la función

   indicesVerdaderos :: [Int] -> [Bool]

1	indicesVerdaderos :: [Int] -> [Bool]

tal que (indicesVerdaderos xs) es la lista infinita de booleanos tal que sólo son verdaderos los elementos cuyos índices pertenecen a la lista estrictamente creciente xs. Por ejemplo,

   λ> take 6 (indicesVerdaderos [1,4])
   [False,True,False,False,True,False]
   λ> take 6 (indicesVerdaderos [0,2..])
   [True,False,True,False,True,False]
   λ> take 3 (indicesVerdaderos [])
   [False,False,False]
   λ> take 6 (indicesVerdaderos [1..])
   [False,True,True,True,True,True]
   λ> last (take (8*10^7) (indicesVerdaderos [0,5..]))
   False

λ> take 6 (indicesVerdaderos [1,4])

[False,True,False,False,True,False]

λ> take 6 (indicesVerdaderos [0,2..])

[True,False,True,False,True,False]

λ> take 3 (indicesVerdaderos [])

[False,False,False]

λ> take 6 (indicesVerdaderos [1..])

[False,True,True,True,True,True]

λ> last (take (8*10^7) (indicesVerdaderos [0,5..]))

False

Soluciones

[schedule expon=’2022-04-19′ 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-19′ at=»06:00″]

import Data.List.Ordered (member)
import Test.QuickCheck

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

indicesVerdaderos1 :: [Int] -> [Bool]
indicesVerdaderos1 []     = repeat False
indicesVerdaderos1 (x:ys) =
  replicate x False ++ [True] ++ indicesVerdaderos1 [y-x-1 | y <- ys]

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

indicesVerdaderos2 :: [Int] -> [Bool]
indicesVerdaderos2 = aux 0
  where aux _ []     = repeat False
        aux n (x:xs) | x == n    = True  : aux (n+1) xs
                     | otherwise = False : aux (n+1) (x:xs)

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

indicesVerdaderos3 :: [Int] -> [Bool]
indicesVerdaderos3 = aux [0..]
  where aux _      []                 = repeat False
        aux (i:is) (x:xs) | i == x    = True  : aux is xs
                          | otherwise = False : aux is (x:xs)

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

indicesVerdaderos4 :: [Int] -> [Bool]
indicesVerdaderos4 xs = [pertenece x xs | x <- [0..]]

-- (pertenece x ys) se verifica si x pertenece a la lista estrictamente
-- creciente (posiblemente infinita) ys. Por ejemplo,
--    pertenece 9 [1,3..]  ==  True
--    pertenece 6 [1,3..]  ==  False
pertenece :: Int -> [Int] -> Bool
pertenece x ys = x `elem` takeWhile (<=x) ys

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

indicesVerdaderos5 :: [Int] -> [Bool]
indicesVerdaderos5 xs = map (`pertenece2` xs) [0..]

pertenece2 :: Int -> [Int] -> Bool
pertenece2 x = aux
  where aux [] = False
        aux (y:ys) = case compare x y of
                       LT -> False
                       EQ -> True
                       GT -> aux ys

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

indicesVerdaderos6 :: [Int] -> [Bool]
indicesVerdaderos6 xs = map (`member` xs) [0..]

-- Comprobación de equivalencia
-- ============================

-- ListaCreciente es un tipo de dato para generar lista de enteros
-- crecientes arbitrarias.
newtype ListaCreciente = LC [Int]
  deriving Show

-- listaCrecienteArbitraria es un generador de lista de enteros
-- crecientes arbitrarias. Por ejemplo,
--    λ> sample listaCrecienteArbitraria
--    LC []
--    LC [2,5]
--    LC [4,8]
--    LC [6,13]
--    LC [7,15,20,28,33]
--    LC [11,15,20,29,35,40]
--    LC [5,17,25,36,42,50,52,64]
--    LC [9,16,31,33,46,59,74,83,85,89,104,113,118]
--    LC [9,22,29,35,37,49,53,62,68,77,83,100]
--    LC []
--    LC [3,22,25,34,36,51,72,75,89]
listaCrecienteArbitraria :: Gen ListaCreciente
listaCrecienteArbitraria = do
  xs <- arbitrary
  return (LC (listaCreciente xs))

-- (listaCreciente xs) es la lista creciente correspondiente a xs. Por ejemplo,
--    listaCreciente [-1,3,-4,3,0]   ==  [2,6,11,15,16]
listaCreciente :: [Int] -> [Int]
listaCreciente xs =
  scanl1 (+) (map (succ . abs) xs)

-- ListaCreciente está contenida en Arbitrary
instance Arbitrary ListaCreciente where
  arbitrary = listaCrecienteArbitraria

-- La propiedad es
prop_indicesVerdaderos :: ListaCreciente -> Bool
prop_indicesVerdaderos (LC xs) =
  all (== take n (indicesVerdaderos1 xs))
      [take n (f xs) | f <-[indicesVerdaderos2,
                            indicesVerdaderos3,
                            indicesVerdaderos4,
                            indicesVerdaderos5,
                            indicesVerdaderos6]]
  where n = length xs

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

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

-- La comparación es
--    λ> last (take (2*10^4) (indicesVerdaderos1 [0,5..]))
--    False
--    (2.69 secs, 2,611,031,544 bytes)
--    λ> last (take (2*10^4) (indicesVerdaderos2 [0,5..]))
--    False
--    (0.03 secs, 10,228,880 bytes)
--
--    λ> last (take (4*10^6) (indicesVerdaderos2 [0,5..]))
--    False
--    (2.37 secs, 1,946,100,856 bytes)
--    λ> last (take (4*10^6) (indicesVerdaderos3 [0,5..]))
--    False
--    (1.54 secs, 1,434,100,984 bytes)
--
--    λ> last (take (6*10^6) (indicesVerdaderos3 [0,5..]))
--    False
--    (2.30 secs, 2,150,900,984 bytes)
--    λ> last (take (6*10^6) (indicesVerdaderos4 [0,5..]))
--    False
--    (1.55 secs, 1,651,701,184 bytes)
--    λ> last (take (6*10^6) (indicesVerdaderos5 [0,5..]))
--    False
--    (0.58 secs, 1,584,514,304 bytes)
--
--    λ> last (take (3*10^7) (indicesVerdaderos5 [0,5..]))
--    False
--    (2.74 secs, 7,920,514,360 bytes)
--    λ> last (take (3*10^7) (indicesVerdaderos6 [0,5..]))
--    False
--    (0.82 secs, 6,960,514,136 bytes)

--    λ> last (take (2*10^4) (indicesVerdaderos1 [0,5..]))
--    False
--    (2.69 secs, 2,611,031,544 bytes)
--    λ> last (take (2*10^4) (indicesVerdaderos6 [0,5..]))
--    False
--    (0.01 secs, 5,154,040 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

147

148

149

150

151

152

153

154

155

import Data.List.Ordered (member)

import Test.QuickCheck

-- 1ª solución

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

indicesVerdaderos1 :: [Int] -> [Bool]

indicesVerdaderos1 [] = repeat False

indicesVerdaderos1 (x:ys) =

replicate x False ++ [True] ++ indicesVerdaderos1 [y-x-1 | y <- ys]

-- 2ª solución

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

indicesVerdaderos2 :: [Int] -> [Bool]

indicesVerdaderos2 = aux 0

where aux _ [] = repeat False

aux n (x:xs) | x == n = True : aux (n+1) xs

| otherwise = False : aux (n+1) (x:xs)

-- 3ª solución

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

indicesVerdaderos3 :: [Int] -> [Bool]

indicesVerdaderos3 = aux [0..]

where aux _ [] = repeat False

aux (i:is) (x:xs) | i == x = True : aux is xs

| otherwise = False : aux is (x:xs)

-- 4ª solución

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

indicesVerdaderos4 :: [Int] -> [Bool]

indicesVerdaderos4 xs = [pertenece x xs | x <- [0..]]

-- (pertenece x ys) se verifica si x pertenece a la lista estrictamente

-- creciente (posiblemente infinita) ys. Por ejemplo,

-- pertenece 9 [1,3..] == True

-- pertenece 6 [1,3..] == False

pertenece :: Int -> [Int] -> Bool

pertenece x ys = x `elem` takeWhile (<=x) ys

-- 5ª solución

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

indicesVerdaderos5 :: [Int] -> [Bool]

indicesVerdaderos5 xs = map (`pertenece2` xs) [0..]

pertenece2 :: Int -> [Int] -> Bool

pertenece2 x = aux

where aux [] = False

aux (y:ys) = case compare x y of

LT -> False

EQ -> True

GT -> aux ys

-- 6ª solución

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

indicesVerdaderos6 :: [Int] -> [Bool]

indicesVerdaderos6 xs = map (`member` xs) [0..]

-- Comprobación de equivalencia

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

-- ListaCreciente es un tipo de dato para generar lista de enteros

-- crecientes arbitrarias.

newtype ListaCreciente = LC [Int]

deriving Show

-- listaCrecienteArbitraria es un generador de lista de enteros

-- crecientes arbitrarias. Por ejemplo,

-- λ> sample listaCrecienteArbitraria

-- LC []

-- LC [2,5]

-- LC [4,8]

-- LC [6,13]

-- LC [7,15,20,28,33]

-- LC [11,15,20,29,35,40]

-- LC [5,17,25,36,42,50,52,64]

-- LC [9,16,31,33,46,59,74,83,85,89,104,113,118]

-- LC [9,22,29,35,37,49,53,62,68,77,83,100]

-- LC []

-- LC [3,22,25,34,36,51,72,75,89]

listaCrecienteArbitraria :: Gen ListaCreciente

listaCrecienteArbitraria = do

xs <- arbitrary

return (LC (listaCreciente xs))

-- (listaCreciente xs) es la lista creciente correspondiente a xs. Por ejemplo,

-- listaCreciente [-1,3,-4,3,0] == [2,6,11,15,16]

listaCreciente :: [Int] -> [Int]

listaCreciente xs =

scanl1 (+) (map (succ . abs) xs)

-- ListaCreciente está contenida en Arbitrary

instance Arbitrary ListaCreciente where

arbitrary = listaCrecienteArbitraria

-- La propiedad es

prop_indicesVerdaderos :: ListaCreciente -> Bool

prop_indicesVerdaderos (LC xs) =

all (== take n (indicesVerdaderos1 xs))

[take n (f xs) | f <-[indicesVerdaderos2,

indicesVerdaderos3,

indicesVerdaderos4,

indicesVerdaderos5,

indicesVerdaderos6]]

where n = length xs

-- La comprobación es

-- λ> quickCheck prop_indicesVerdaderos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (take (2*10^4) (indicesVerdaderos1 [0,5..]))

-- False

-- (2.69 secs, 2,611,031,544 bytes)

-- λ> last (take (2*10^4) (indicesVerdaderos2 [0,5..]))

-- False

-- (0.03 secs, 10,228,880 bytes)

-- λ> last (take (4*10^6) (indicesVerdaderos2 [0,5..]))

-- False

-- (2.37 secs, 1,946,100,856 bytes)

-- λ> last (take (4*10^6) (indicesVerdaderos3 [0,5..]))

-- False

-- (1.54 secs, 1,434,100,984 bytes)

-- λ> last (take (6*10^6) (indicesVerdaderos3 [0,5..]))

-- False

-- (2.30 secs, 2,150,900,984 bytes)

-- λ> last (take (6*10^6) (indicesVerdaderos4 [0,5..]))

-- False

-- (1.55 secs, 1,651,701,184 bytes)

-- λ> last (take (6*10^6) (indicesVerdaderos5 [0,5..]))

-- False

-- (0.58 secs, 1,584,514,304 bytes)

-- λ> last (take (3*10^7) (indicesVerdaderos5 [0,5..]))

-- False

-- (2.74 secs, 7,920,514,360 bytes)

-- λ> last (take (3*10^7) (indicesVerdaderos6 [0,5..]))

-- False

-- (0.82 secs, 6,960,514,136 bytes)

-- λ> last (take (2*10^4) (indicesVerdaderos1 [0,5..]))

-- False

-- (2.69 secs, 2,611,031,544 bytes)

-- λ> last (take (2*10^4) (indicesVerdaderos6 [0,5..]))

-- False

-- (0.01 secs, 5,154,040 bytes)

El código se encuentra en [GitHub](https://github.com/jaalonso/Exercitium/blob/main/src/Indices_verdaderos.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]

Código de las alergias

PorJosé A. Alonso 11-abril-2022

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

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)

data Alergeno = Huevos

| Cacahuetes

| Mariscos

| Fresas

| Tomates

| Chocolate

| Polen

| Gatos

deriving (Enum, Eq, Show, Bounded)

Definir la función

   alergias :: Int -> [Alergeno]

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

λ> 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)

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

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]

Reiteración de una función

PorJosé A. Alonso 8-abril-202216-abril-2022

Definir la función

   reiteracion :: (a -> a) -> Int -> a -> a

1	reiteracion :: (a -> a) -> Int -> a -> a

tal que (reiteracion f n x) es el resultado de aplicar n veces la función f a x. Por ejemplo,

   reiteracion (+1) 10 5  ==  15
   reiteracion (+5) 10 0  ==  50
   reiteracion (*2)  4 1  ==  16
   reiteracion (5:)  4 [] ==  [5,5,5,5]

reiteracion (+1) 10 5 == 15

reiteracion (+5) 10 0 == 50

reiteracion (*2) 4 1 == 16

reiteracion (5:) 4 [] == [5,5,5,5]

Soluciones

import Test.QuickCheck (Fun (..), Positive (..), quickCheck)

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

reiteracion1 :: (a -> a) -> Int -> a -> a
reiteracion1 _ 0 x = x
reiteracion1 f n x = f (reiteracion1 f (n-1) x)

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

reiteracion2 :: (a -> a) -> Int -> a -> a
reiteracion2 _ 0 = id
reiteracion2 f n = f . reiteracion2 f (n-1)

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

reiteracion3 :: (a -> a) -> Int -> a -> a
reiteracion3 _ 0 = id
reiteracion3 f n
  | even n    = reiteracion3 (f . f) (n `div` 2)
  | otherwise = f . reiteracion3 (f . f) (n `div` 2)

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

reiteracion4 :: (a -> a) -> Int -> a -> a
reiteracion4 f n x = reiteraciones f x !! n

reiteraciones :: (a -> a) -> a -> [a]
reiteraciones f x = x : reiteraciones f (f x)

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

reiteracion5 :: (a -> a) -> Int -> a -> a
reiteracion5 f n x = (iterate f x) !! n

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

-- Se puede eliminar los argumentos de la definición anterior como sigue:
--    reiteracion4 f n x = iterate f x !! n
--    reiteracion4 f n x = ((!!) (iterate f x)) n
--    reiteracion4 f n x = (((!!) . (iterate f)) x) n
--    reiteracion4 f n x = ((!!) . (iterate f)) x n
--    reiteracion4 f n x = flip ((!!) . (iterate f)) n x
--    reiteracion4 f = flip ((!!) . (iterate f))
--    reiteracion4 f = flip (((!!) .) (iterate f))
--    reiteracion4 f = flip (((!!) .) . iterate) f
--    reiteracion4 f = (flip . ((!!) .) . iterate) f
--    reiteracion4   = flip . ((!!) .) . iterate

reiteracion6 :: (a -> a) -> Int -> a -> a
reiteracion6 = flip . ((!!) .) . iterate

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_reiteracion :: Fun Int Int -> Positive Int -> Int -> Bool
prop_reiteracion (Fun _ f) (Positive n) x =
  all (== reiteracion1 f n x)
      [reiteracion2 f n x,
       reiteracion3 f n x,
       reiteracion4 f n x,
       reiteracion5 f n x,
       reiteracion6 f n x]

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

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

-- La comparación es
--    λ> reiteracion1 (+1) (10^7) 0
--    10000000
--    (5.09 secs, 2,505,392,792 bytes)
--    λ> reiteracion2 (+1) (10^7) 0
--    10000000
--    (5.45 secs, 2,896,899,728 bytes)
--    λ> reiteracion3 (+1) (10^7) 0
--    10000000
--    (2.14 secs, 816,909,416 bytes)
--    λ> reiteracion4 (+1) (10^7) 0
--    10000000
--    (4.24 secs, 1,696,899,816 bytes)
--    λ> reiteracion5 (+1) (10^7) 0
--    10000000
--    (2.53 secs, 1,376,899,800 bytes)
--    λ> reiteracion6 (+1) (10^7) 0
--    10000000
--    (2.34 secs, 1,376,899,984 bytes)

import Test.QuickCheck (Fun (..), Positive (..), quickCheck)

-- 1ª solución

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

reiteracion1 :: (a -> a) -> Int -> a -> a

reiteracion1 _ 0 x = x

reiteracion1 f n x = f (reiteracion1 f (n-1) x)

-- 2ª solución

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

reiteracion2 :: (a -> a) -> Int -> a -> a

reiteracion2 _ 0 = id

reiteracion2 f n = f . reiteracion2 f (n-1)

-- 3ª solución

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

reiteracion3 :: (a -> a) -> Int -> a -> a

reiteracion3 _ 0 = id

reiteracion3 f n

| even n = reiteracion3 (f . f) (n `div` 2)

| otherwise = f . reiteracion3 (f . f) (n `div` 2)

-- 4ª solución

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

reiteracion4 :: (a -> a) -> Int -> a -> a

reiteracion4 f n x = reiteraciones f x !! n

reiteraciones :: (a -> a) -> a -> [a]

reiteraciones f x = x : reiteraciones f (f x)

-- 5ª solución

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

reiteracion5 :: (a -> a) -> Int -> a -> a

reiteracion5 f n x = (iterate f x) !! n

-- 6ª solución

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

-- Se puede eliminar los argumentos de la definición anterior como sigue:

-- reiteracion4 f n x = iterate f x !! n

-- reiteracion4 f n x = ((!!) (iterate f x)) n

-- reiteracion4 f n x = (((!!) . (iterate f)) x) n

-- reiteracion4 f n x = ((!!) . (iterate f)) x n

-- reiteracion4 f n x = flip ((!!) . (iterate f)) n x

-- reiteracion4 f = flip ((!!) . (iterate f))

-- reiteracion4 f = flip (((!!) .) (iterate f))

-- reiteracion4 f = flip (((!!) .) . iterate) f

-- reiteracion4 f = (flip . ((!!) .) . iterate) f

-- reiteracion4 = flip . ((!!) .) . iterate

reiteracion6 :: (a -> a) -> Int -> a -> a

reiteracion6 = flip . ((!!) .) . iterate

-- Comprobación de equivalencia

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

-- La propiedad es

prop_reiteracion :: Fun Int Int -> Positive Int -> Int -> Bool

prop_reiteracion (Fun _ f) (Positive n) x =

all (== reiteracion1 f n x)

[reiteracion2 f n x,

reiteracion3 f n x,

reiteracion4 f n x,

reiteracion5 f n x,

reiteracion6 f n x]

-- La comprobación es

-- λ> quickCheck prop_reiteracion

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> reiteracion1 (+1) (10^7) 0

-- 10000000

-- (5.09 secs, 2,505,392,792 bytes)

-- λ> reiteracion2 (+1) (10^7) 0

-- 10000000

-- (5.45 secs, 2,896,899,728 bytes)

-- λ> reiteracion3 (+1) (10^7) 0

-- 10000000

-- (2.14 secs, 816,909,416 bytes)

-- λ> reiteracion4 (+1) (10^7) 0

-- 10000000

-- (4.24 secs, 1,696,899,816 bytes)

-- λ> reiteracion5 (+1) (10^7) 0

-- 10000000

-- (2.53 secs, 1,376,899,800 bytes)

-- λ> reiteracion6 (+1) (10^7) 0

-- 10000000

-- (2.34 secs, 1,376,899,984 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>

Elementos de una matriz con algún vecino menor

PorJosé A. Alonso 7-abril-202215-abril-2022

Las matrices pueden representarse mediante tablas cuyos índices son pares de números naturales. Su tipo se define por

   type Matriz = Array (Int,Int) Int

1	type Matriz = Array (Int,Int) Int

Por ejemplo, la matriz

   |9 4 6 5|
   |8 1 7 3|
   |4 2 5 4|

|9 4 6 5|

|8 1 7 3|

|4 2 5 4|

se define por

   ej :: Matriz
   ej = listArray ((1,1),(3,4)) [9,4,6,5,8,1,7,3,4,2,5,4]

1 2	ej :: Matriz ej = listArray ((1,1),(3,4)) [9,4,6,5,8,1,7,3,4,2,5,4]

Los vecinos de un elemento son los que están a un paso en la misma fila, columna o diagonal. Por ejemplo, en la matriz anterior, el 1 tiene 8 vecinos (el 9, 4, 6, 8, 7, 4, 2 y 5) pero el 9 sólo tiene 3 vecinos (el 4, 8 y 1).

Definir la función

   algunoMenor :: Matriz -> [Int]

1	algunoMenor :: Matriz -> [Int]

tal que (algunoMenor p) es la lista de los elementos de p que tienen algún vecino menor que él. Por ejemplo,

   algunoMenor ej == [9,4,6,5,8,7,4,2,5,4]

1	algunoMenor ej == [9,4,6,5,8,7,4,2,5,4]

pues sólo el 1 y el 3 no tienen ningún vecino menor en la matriz.

Soluciones

import Data.Array (Array, (!), bounds, indices, inRange, listArray)
import Test.QuickCheck (Arbitrary, Gen, arbitrary, chooseInt, quickCheck,
                        vectorOf)

type Matriz = Array (Int,Int) Int

ej :: Matriz
ej = listArray ((1,1),(3,4)) [9,4,6,5,8,1,7,3,4,2,5,4]

type Pos = (Int,Int)

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

algunoMenor1 :: Matriz -> [Int]
algunoMenor1 a =
  [a!p| p <- indices a,
        any (< a!p) (vecinos1 a p)]

-- (vecinos q p) es la lista de los vecinos en la matriz a de la
-- posición p. Por ejemplo,
--    vecinos1 ej (2,2)  ==  [9,4,6,8,7,4,2,5]
--    vecinos1 ej (1,1)  ==  [4,8,1]
vecinos1 :: Matriz -> Pos -> [Int]
vecinos1 a p =
  [a!p' | p' <- posicionesVecinos1 a p]

-- (posicionesVecinos a p) es la lista de las posiciones de los
-- vecino de p en la matriz a. Por ejemplo,
--    λ> posicionesVecinos1 3 3 (2,2)
--    [(1,1),(1,2),(1,3),(2,1),(2,3),(3,1),(3,2),(3,3)]
--    λ> posicionesVecinos1 3 3 (1,1)
--    [(1,2),(2,1),(2,2)]
posicionesVecinos1 :: Matriz -> Pos -> [Pos]
posicionesVecinos1 a (i,j) =
  [(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1),
                             ( 0,-1),       ( 0,1),
                             ( 1,-1),( 1,0),( 1,1)],
                 inRange (bounds a) (i+di,j+dj)]

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

algunoMenor2 :: Matriz -> [Int]
algunoMenor2 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos2 p)]
  where
    vecinos2 p =
      [a!p' | p' <- posicionesVecinos2 p]
    posicionesVecinos2 (i,j) =
      [(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1),
                                 ( 0,-1),       ( 0,1),
                                 ( 1,-1),( 1,0),( 1,1)],
                     inRange (bounds a) (i+di,j+dj)]

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

algunoMenor3 :: Matriz -> [Int]
algunoMenor3 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos3 p)]
  where
    vecinos3 p =
      [a!p' | p' <- posicionesVecinos3 p]
    posicionesVecinos3 (i,j) =
      [(i',j') | i' <- [i-1..i+1],
                 j' <- [j-1..j+1],
                 (i',j') /= (i,j),
                 inRange (bounds a) (i',j')]

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

algunoMenor4 :: Matriz -> [Int]
algunoMenor4 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos4 p)]
  where
    vecinos4 p =
      [a!p' | p' <- posicionesVecinos4 p]
    posicionesVecinos4 (i,j) =
      [(i',j') | i' <- [max 1 (i-1)..min m (i+1)],
                 j' <- [max 1 (j-1)..min n (j+1)],
                 (i',j') /= (i,j)]
      where (_,(m,n)) = bounds a


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

algunoMenor5 :: Matriz -> [Int]
algunoMenor5 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos5 p)]
  where
    vecinos5 p =
      [a!p' | p' <- posicionesVecinos5 p]
    posicionesVecinos5 (i,j) =
      [(i-1,j-1) | i > 1, j > 1] ++
      [(i-1,j)   | i > 1]        ++
      [(i-1,j+1) | i > 1, j < n] ++
      [(i,j-1)   | j > 1]        ++
      [(i,j+1)   | j < n]        ++
      [(i+1,j-1) | i < m, j > 1] ++
      [(i+1,j)   | i < m]        ++
      [(i+1,j+1) | i < m, j < n]
      where (_,(m,n)) = bounds a

-- ---------------------------------------------------------------------

-- Comprobación de equivalencia
-- ============================

newtype Matriz2 = M Matriz
  deriving Show

-- Generador de matrices arbitrarias. Por ejemplo,
--    λ> generate matrizArbitraria
--    M (array ((1,1),(3,4))
--             [((1,1),18),((1,2),6), ((1,3),-23),((1,4),-13),
--              ((2,1),-2),((2,2),22),((2,3),-25),((2,4),-5),
--              ((3,1),2), ((3,2),16),((3,3),-15),((3,4),7)])
matrizArbitraria :: Gen Matriz2
matrizArbitraria = do
  m  <- chooseInt (1,10)
  n  <- chooseInt (1,10)
  xs <- vectorOf (m*n) arbitrary
  return (M (listArray ((1,1),(m,n)) xs))

-- Matriz es una subclase de Arbitrary.
instance Arbitrary Matriz2 where
  arbitrary = matrizArbitraria

-- La propiedad es
prop_algunoMenor :: Matriz2 -> Bool
prop_algunoMenor (M p) =
  all (== algunoMenor1 p)
      [algunoMenor2 p,
       algunoMenor3 p,
       algunoMenor4 p,
       algunoMenor5 p]

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

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

-- La comparación es
--    λ> maximum (algunoMenor1 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.20 secs, 1,350,075,240 bytes)
--    λ> maximum (algunoMenor2 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.24 secs, 1,373,139,968 bytes)
--    λ> maximum (algunoMenor3 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.08 secs, 1,200,734,112 bytes)
--    λ> maximum (algunoMenor4 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.76 secs, 1,287,653,136 bytes)
--    λ> maximum (algunoMenor5 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (1.67 secs, 953,937,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

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

import Data.Array (Array, (!), bounds, indices, inRange, listArray)

import Test.QuickCheck (Arbitrary, Gen, arbitrary, chooseInt, quickCheck,

vectorOf)

type Matriz = Array (Int,Int) Int

ej :: Matriz

ej = listArray ((1,1),(3,4)) [9,4,6,5,8,1,7,3,4,2,5,4]

type Pos = (Int,Int)

-- 1ª solución

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

algunoMenor1 :: Matriz -> [Int]

algunoMenor1 a =

[a!p| p <- indices a,

any (< a!p) (vecinos1 a p)]

-- (vecinos q p) es la lista de los vecinos en la matriz a de la

-- posición p. Por ejemplo,

-- vecinos1 ej (2,2) == [9,4,6,8,7,4,2,5]

-- vecinos1 ej (1,1) == [4,8,1]

vecinos1 :: Matriz -> Pos -> [Int]

vecinos1 a p =

[a!p' | p' <- posicionesVecinos1 a p]

-- (posicionesVecinos a p) es la lista de las posiciones de los

-- vecino de p en la matriz a. Por ejemplo,

-- λ> posicionesVecinos1 3 3 (2,2)

-- [(1,1),(1,2),(1,3),(2,1),(2,3),(3,1),(3,2),(3,3)]

-- λ> posicionesVecinos1 3 3 (1,1)

-- [(1,2),(2,1),(2,2)]

posicionesVecinos1 :: Matriz -> Pos -> [Pos]

posicionesVecinos1 a (i,j) =

[(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1),

( 0,-1), ( 0,1),

( 1,-1),( 1,0),( 1,1)],

inRange (bounds a) (i+di,j+dj)]

-- 2ª solución

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

algunoMenor2 :: Matriz -> [Int]

algunoMenor2 a =

[a!p | p <- indices a,

any (<a!p) (vecinos2 p)]

where

vecinos2 p =

[a!p' | p' <- posicionesVecinos2 p]

posicionesVecinos2 (i,j) =

[(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1),

( 0,-1), ( 0,1),

( 1,-1),( 1,0),( 1,1)],

inRange (bounds a) (i+di,j+dj)]

-- 3ª solución

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

algunoMenor3 :: Matriz -> [Int]

algunoMenor3 a =

[a!p | p <- indices a,

any (<a!p) (vecinos3 p)]

where

vecinos3 p =

[a!p' | p' <- posicionesVecinos3 p]

posicionesVecinos3 (i,j) =

[(i',j') | i' <- [i-1..i+1],

j' <- [j-1..j+1],

(i',j') /= (i,j),

inRange (bounds a) (i',j')]

-- 4ª solución

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

algunoMenor4 :: Matriz -> [Int]

algunoMenor4 a =

[a!p | p <- indices a,

any (<a!p) (vecinos4 p)]

where

vecinos4 p =

[a!p' | p' <- posicionesVecinos4 p]

posicionesVecinos4 (i,j) =

[(i',j') | i' <- [max 1 (i-1)..min m (i+1)],

j' <- [max 1 (j-1)..min n (j+1)],

(i',j') /= (i,j)]

where (_,(m,n)) = bounds a

-- 5ª solución

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

algunoMenor5 :: Matriz -> [Int]

algunoMenor5 a =

[a!p | p <- indices a,

any (<a!p) (vecinos5 p)]

where

vecinos5 p =

[a!p' | p' <- posicionesVecinos5 p]

posicionesVecinos5 (i,j) =

[(i-1,j-1) | i > 1, j > 1] ++

[(i-1,j) | i > 1] ++

[(i-1,j+1) | i > 1, j < n] ++

[(i,j-1) | j > 1] ++

[(i,j+1) | j < n] ++

[(i+1,j-1) | i < m, j > 1] ++

[(i+1,j) | i < m] ++

[(i+1,j+1) | i < m, j < n]

where (_,(m,n)) = bounds a

-- ---------------------------------------------------------------------

-- Comprobación de equivalencia

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

newtype Matriz2 = M Matriz

deriving Show

-- Generador de matrices arbitrarias. Por ejemplo,

-- λ> generate matrizArbitraria

-- M (array ((1,1),(3,4))

-- [((1,1),18),((1,2),6), ((1,3),-23),((1,4),-13),

-- ((2,1),-2),((2,2),22),((2,3),-25),((2,4),-5),

-- ((3,1),2), ((3,2),16),((3,3),-15),((3,4),7)])

matrizArbitraria :: Gen Matriz2

matrizArbitraria = do

m <- chooseInt (1,10)

n <- chooseInt (1,10)

xs <- vectorOf (m*n) arbitrary

return (M (listArray ((1,1),(m,n)) xs))

-- Matriz es una subclase de Arbitrary.

instance Arbitrary Matriz2 where

arbitrary = matrizArbitraria

-- La propiedad es

prop_algunoMenor :: Matriz2 -> Bool

prop_algunoMenor (M p) =

all (== algunoMenor1 p)

[algunoMenor2 p,

algunoMenor3 p,

algunoMenor4 p,

algunoMenor5 p]

-- La comprobación es

-- λ> quickCheck prop_algunoMenor

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximum (algunoMenor1 (listArray ((1,1),(600,800)) [0..]))

-- 479999

-- (2.20 secs, 1,350,075,240 bytes)

-- λ> maximum (algunoMenor2 (listArray ((1,1),(600,800)) [0..]))

-- 479999

-- (2.24 secs, 1,373,139,968 bytes)

-- λ> maximum (algunoMenor3 (listArray ((1,1),(600,800)) [0..]))

-- 479999

-- (2.08 secs, 1,200,734,112 bytes)

-- λ> maximum (algunoMenor4 (listArray ((1,1),(600,800)) [0..]))

-- 479999

-- (2.76 secs, 1,287,653,136 bytes)

-- λ> maximum (algunoMenor5 (listArray ((1,1),(600,800)) [0..]))

-- 479999

-- (1.67 secs, 953,937,600 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>

Enumeración de árboles binarios

PorJosé A. Alonso 6-abril-202213-abril-2022

Los árboles binarios se pueden representar mediante el tipo Arbol definido por

   data Arbol a = H a
                | N (Arbol a) a (Arbol a)
      deriving Show

data Arbol a = H a

| N (Arbol a) a (Arbol a)

deriving Show

Por ejemplo, el árbol

        "B"
        / \
       /   \
      /     \
    "B"     "A"
    / \     / \
  "A" "B" "C" "C"

"B"

/ \

"B" "A"

/ \ / \

"A" "B" "C" "C"

se puede definir por

   ej1 :: Arbol String
   ej1 = N (N (H "A") "B" (H "B")) "B" (N (H "C") "A" (H "C"))

1 2	ej1 :: Arbol String ej1 = N (N (H "A") "B" (H "B")) "B" (N (H "C") "A" (H "C"))

Definir la función

   enumeraArbol :: Arbol t -> Arbol Int

1	enumeraArbol :: Arbol t -> Arbol Int

tal que (enumeraArbol a) es el árbol obtenido numerando las hojas y los nodos de a desde la hoja izquierda hasta la raíz. Por ejemplo,

   λ> enumeraArbol ej1
   N (N (H 0) 1 (H 2)) 3 (N (H 4) 5 (H 6))

1 2	λ> enumeraArbol ej1 N (N (H 0) 1 (H 2)) 3 (N (H 4) 5 (H 6))

Gráficamente,

         3
        / \
       /   \
      /     \
     1       5
    / \     / \
   0   2   4   6

/ \

1 5

/ \ / \

0 2 4 6

Soluciones

import Test.QuickCheck (Arbitrary, Gen, arbitrary, quickCheck, sized)
import Control.Monad.State (State, evalState, get, put)

data Arbol a = H a
             | N (Arbol a) a (Arbol a)
  deriving (Show, Eq)

ej1 :: Arbol String
ej1 = N (N (H "A") "B" (H "B")) "B" (N (H "C") "A" (H "C"))

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

enumeraArbol1 :: Arbol t -> Arbol Int
enumeraArbol1 a = fst (aux a 0)
  where aux :: Arbol t -> Int -> (Arbol Int, Int)
        aux (H _) n     = (H n, n+1)
        aux (N i _ d) n = (N i' n1 d', n2)
          where (i', n1) = aux i n
                (d', n2) = aux d (n1+1)

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

enumeraArbol2 :: Arbol t -> Arbol Int
enumeraArbol2 a = evalState (aux a) 0
  where aux :: Arbol t -> State Int (Arbol Int)
        aux (H _)     = H <$> contador
        aux (N i _ d) = do
          i' <- aux i
          n1 <- contador
          d' <- aux d
          return (N i' n1 d')

contador :: State Int Int
contador = do
  n <- get
  put (n+1)
  return n

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

enumeraArbol3 :: Arbol t -> Arbol Int
enumeraArbol3 a = evalState (aux a) 0
  where aux :: Arbol t -> State Int (Arbol Int)
        aux (H _)     = H <$> contador
        aux (N i _ d) = N <$> aux i <*> contador <*> aux d

-- Comprobación de equivalencia
-- ============================

-- (arbolArbitrario n) genera un árbol aleatorio de orden n. Por
-- ejemplo,
--    λ> generate (arbolArbitrario 3 :: Gen (Arbol Int))
--    N (N (H 19) 0 (H (-27))) 21 (N (H 2) 17 (H 26))
arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)
arbolArbitrario n
  | n <= 0    = H <$> arbitrary
  | otherwise = N <$> subarbol <*> arbitrary <*> subarbol
  where subarbol = arbolArbitrario (n `div` 2)

-- Arbol es una subclase de Arbitrary.
instance Arbitrary a => Arbitrary (Arbol a) where
  arbitrary = sized arbolArbitrario

-- La propiedad es
prop_enumeraArbol :: Arbol Int -> Bool
prop_enumeraArbol a =
  all (== enumeraArbol1 a)
      [enumeraArbol2 a,
       enumeraArbol3 a]

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

import Test.QuickCheck (Arbitrary, Gen, arbitrary, quickCheck, sized)

import Control.Monad.State (State, evalState, get, put)

data Arbol a = H a

| N (Arbol a) a (Arbol a)

deriving (Show, Eq)

ej1 :: Arbol String

ej1 = N (N (H "A") "B" (H "B")) "B" (N (H "C") "A" (H "C"))

-- 1ª solución

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

enumeraArbol1 :: Arbol t -> Arbol Int

enumeraArbol1 a = fst (aux a 0)

where aux :: Arbol t -> Int -> (Arbol Int, Int)

aux (H _) n = (H n, n+1)

aux (N i _ d) n = (N i' n1 d', n2)

where (i', n1) = aux i n

(d', n2) = aux d (n1+1)

-- 2ª solución

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

enumeraArbol2 :: Arbol t -> Arbol Int

enumeraArbol2 a = evalState (aux a) 0

where aux :: Arbol t -> State Int (Arbol Int)

aux (H _) = H <$> contador

aux (N i _ d) = do

i' <- aux i

n1 <- contador

d' <- aux d

return (N i' n1 d')

contador :: State Int Int

contador = do

n <- get

put (n+1)

return n

-- 3ª solución

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

enumeraArbol3 :: Arbol t -> Arbol Int

enumeraArbol3 a = evalState (aux a) 0

where aux :: Arbol t -> State Int (Arbol Int)

aux (H _) = H <$> contador

aux (N i _ d) = N <$> aux i <*> contador <*> aux d

-- Comprobación de equivalencia

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

-- (arbolArbitrario n) genera un árbol aleatorio de orden n. Por

-- ejemplo,

-- λ> generate (arbolArbitrario 3 :: Gen (Arbol Int))

-- N (N (H 19) 0 (H (-27))) 21 (N (H 2) 17 (H 26))

arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)

arbolArbitrario n

| n <= 0 = H <$> arbitrary

| otherwise = N <$> subarbol <*> arbitrary <*> subarbol

where subarbol = arbolArbitrario (n `div` 2)

-- Arbol es una subclase de Arbitrary.

instance Arbitrary a => Arbitrary (Arbol a) where

arbitrary = sized arbolArbitrario

-- La propiedad es

prop_enumeraArbol :: Arbol Int -> Bool

prop_enumeraArbol a =

all (== enumeraArbol1 a)

[enumeraArbol2 a,

enumeraArbol3 a]

-- La comprobación es

-- λ> quickCheck prop_enumeraArbol

-- +++ OK, passed 100 tests.

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>

[/schedule]

Números triangulares con n cifras distintas

PorJosé A. Alonso 5-abril-202212-abril-2022

Los números triangulares se forman como sigue

   *     *      *
        * *    * *
              * * *
   1     3      6

* * *

* * * *

* * *

1 3 6

La sucesión de los números triangulares se obtiene sumando los números naturales. Así, los 5 primeros números triangulares son

    1 = 1
    3 = 1 + 2
    6 = 1 + 2 + 3
   10 = 1 + 2 + 3 + 4
   15 = 1 + 2 + 3 + 4 + 5

1 = 1

3 = 1 + 2

6 = 1 + 2 + 3

10 = 1 + 2 + 3 + 4

15 = 1 + 2 + 3 + 4 + 5

Definir la función

   triangularesConCifras :: Int -> [Integer]

1	triangularesConCifras :: Int -> [Integer]

tal que (triangulares n) es la lista de los números triangulares con n cifras distintas. Por ejemplo,

   take 6 (triangularesConCifras 1)   ==  [1,3,6,55,66,666]
   take 6 (triangularesConCifras 2)   ==  [10,15,21,28,36,45]
   take 6 (triangularesConCifras 3)   ==  [105,120,136,153,190,210]
   take 5 (triangularesConCifras 4)   ==  [1035,1275,1326,1378,1485]
   take 2 (triangularesConCifras 10)  ==  [1062489753,1239845706]

take 6 (triangularesConCifras 1) == [1,3,6,55,66,666]

take 6 (triangularesConCifras 2) == [10,15,21,28,36,45]

take 6 (triangularesConCifras 3) == [105,120,136,153,190,210]

take 5 (triangularesConCifras 4) == [1035,1275,1326,1378,1485]

take 2 (triangularesConCifras 10) == [1062489753,1239845706]

Soluciones

import Data.List (nub)
import Test.QuickCheck

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

triangularesConCifras1 :: Int -> [Integer]
triangularesConCifras1 n =
  [x | x <- triangulares1,
       nCifras x == n]

-- triangulares1 es la lista de los números triangulares. Por ejemplo,
--    take 10 triangulares1 == [1,3,6,10,15,21,28,36,45,55]
triangulares1 :: [Integer]
triangulares1 = map triangular [1..]

triangular :: Integer -> Integer
triangular 1 = 1
triangular n = triangular (n-1) + n

-- (nCifras x) es el número de cifras distintas del número x. Por
-- ejemplo,
--    nCifras 325275  ==  4
nCifras :: Integer -> Int
nCifras = length . nub . show

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

triangularesConCifras2 :: Int -> [Integer]
triangularesConCifras2 n =
  [x | x <- triangulares2,
       nCifras x == n]

triangulares2 :: [Integer]
triangulares2 = [(n*(n+1)) `div` 2 | n <- [1..]]

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

triangularesConCifras3 :: Int -> [Integer]
triangularesConCifras3 n =
  [x | x <- triangulares3,
       nCifras x == n]

triangulares3 :: [Integer]
triangulares3 = 1 : [x+y | (x,y) <- zip [2..] triangulares3]

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

triangularesConCifras4 :: Int -> [Integer]
triangularesConCifras4 n =
  [x | x <- triangulares4,
       nCifras x == n]

triangulares4 :: [Integer]
triangulares4 = 1 : zipWith (+) [2..] triangulares4

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

triangularesConCifras5 :: Int -> [Integer]
triangularesConCifras5 n =
  [x | x <- triangulares5,
       nCifras x == n]

triangulares5 :: [Integer]
triangulares5 = scanl (+) 1 [2..]

-- Comprobación de equivalencia
-- ============================

-- La 1ª propiedad es
prop_triangularesConCifras1 :: Bool
prop_triangularesConCifras1 =
  [take 2 (triangularesConCifras1 n) | n <- [1..7]] ==
  [take 2 (triangularesConCifras2 n) | n <- [1..7]]

-- La comprobación es
--    λ> prop_triangularesConCifras1
--    True

-- La 2ª propiedad es
prop_triangularesConCifras2 :: Int -> Bool
prop_triangularesConCifras2 n =
  all (== take 5 (triangularesConCifras2 n'))
      [take 5 (triangularesConCifras3 n'),
       take 5 (triangularesConCifras4 n'),
       take 5 (triangularesConCifras5 n')]
  where n' = 1 + n `mod` 9

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

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

-- La comparación es
--    λ> (triangularesConCifras1 3) !! 220
--    5456556
--    (2.48 secs, 1,228,690,120 bytes)
--    λ> (triangularesConCifras2 3) !! 220
--    5456556
--    (0.01 secs, 4,667,288 bytes)
--
--    λ> (triangularesConCifras2 3) !! 600
--    500010500055
--    (1.76 secs, 1,659,299,872 bytes)
--    λ> (triangularesConCifras3 3) !! 600
--    500010500055
--    (1.67 secs, 1,603,298,648 bytes)
--    λ> (triangularesConCifras4 3) !! 600
--    500010500055
--    (1.20 secs, 1,507,298,248 bytes)
--    λ> (triangularesConCifras5 3) !! 600
--    500010500055
--    (1.15 secs, 1,507,298,256 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

import Data.List (nub)

import Test.QuickCheck

-- 1ª solución

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

triangularesConCifras1 :: Int -> [Integer]

triangularesConCifras1 n =

[x | x <- triangulares1,

nCifras x == n]

-- triangulares1 es la lista de los números triangulares. Por ejemplo,

-- take 10 triangulares1 == [1,3,6,10,15,21,28,36,45,55]

triangulares1 :: [Integer]

triangulares1 = map triangular [1..]

triangular :: Integer -> Integer

triangular 1 = 1

triangular n = triangular (n-1) + n

-- (nCifras x) es el número de cifras distintas del número x. Por

-- ejemplo,

-- nCifras 325275 == 4

nCifras :: Integer -> Int

nCifras = length . nub . show

-- 2ª solución

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

triangularesConCifras2 :: Int -> [Integer]

triangularesConCifras2 n =

[x | x <- triangulares2,

nCifras x == n]

triangulares2 :: [Integer]

triangulares2 = [(n*(n+1)) `div` 2 | n <- [1..]]

-- 3ª solución

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

triangularesConCifras3 :: Int -> [Integer]

triangularesConCifras3 n =

[x | x <- triangulares3,

nCifras x == n]

triangulares3 :: [Integer]

triangulares3 = 1 : [x+y | (x,y) <- zip [2..] triangulares3]

-- 4ª solución

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

triangularesConCifras4 :: Int -> [Integer]

triangularesConCifras4 n =

[x | x <- triangulares4,

nCifras x == n]

triangulares4 :: [Integer]

triangulares4 = 1 : zipWith (+) [2..] triangulares4

-- 5ª solución

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

triangularesConCifras5 :: Int -> [Integer]

triangularesConCifras5 n =

[x | x <- triangulares5,

nCifras x == n]

triangulares5 :: [Integer]

triangulares5 = scanl (+) 1 [2..]

-- Comprobación de equivalencia

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

-- La 1ª propiedad es

prop_triangularesConCifras1 :: Bool

prop_triangularesConCifras1 =

[take 2 (triangularesConCifras1 n) | n <- [1..7]] ==

[take 2 (triangularesConCifras2 n) | n <- [1..7]]

-- La comprobación es

-- λ> prop_triangularesConCifras1

-- True

-- La 2ª propiedad es

prop_triangularesConCifras2 :: Int -> Bool

prop_triangularesConCifras2 n =

all (== take 5 (triangularesConCifras2 n'))

[take 5 (triangularesConCifras3 n'),

take 5 (triangularesConCifras4 n'),

take 5 (triangularesConCifras5 n')]

where n' = 1 + n `mod` 9

-- La comprobación es

-- λ> quickCheck prop_triangularesConCifras

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> (triangularesConCifras1 3) !! 220

-- 5456556

-- (2.48 secs, 1,228,690,120 bytes)

-- λ> (triangularesConCifras2 3) !! 220

-- 5456556

-- (0.01 secs, 4,667,288 bytes)

-- λ> (triangularesConCifras2 3) !! 600

-- 500010500055

-- (1.76 secs, 1,659,299,872 bytes)

-- λ> (triangularesConCifras3 3) !! 600

-- 500010500055

-- (1.67 secs, 1,603,298,648 bytes)

-- λ> (triangularesConCifras4 3) !! 600

-- 500010500055

-- (1.20 secs, 1,507,298,248 bytes)

-- λ> (triangularesConCifras5 3) !! 600

-- 500010500055

-- (1.15 secs, 1,507,298,256 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>

Trenzado de listas

PorJosé A. Alonso 4-abril-202211-abril-2022

Definir la función

   trenza :: [a] -> [a] -> [a]

1	trenza :: [a] -> [a] -> [a]

tal que (trenza xs ys) es la lista obtenida intercalando los elementos de xs e ys. Por ejemplo,

   trenza [5,1] [2,7,4]             ==  [5,2,1,7]
   trenza [5,1,7] [2..]             ==  [5,2,1,3,7,4]
   trenza [2..] [5,1,7]             ==  [2,5,3,1,4,7]
   take 8 (trenza [2,4..] [1,5..])  ==  [2,1,4,5,6,9,8,13]

trenza [5,1] [2,7,4] == [5,2,1,7]

trenza [5,1,7] [2..] == [5,2,1,3,7,4]

trenza [2..] [5,1,7] == [2,5,3,1,4,7]

take 8 (trenza [2,4..] [1,5..]) == [2,1,4,5,6,9,8,13]

Soluciones

import Test.QuickCheck (quickCheck)

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

trenza1 :: [a] -> [a] -> [a]
trenza1 []     _      = []
trenza1 _      []     = []
trenza1 (x:xs) (y:ys) = x : y : trenza1 xs ys

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

trenza2 :: [a] -> [a] -> [a]
trenza2 (x:xs) (y:ys) = x : y : trenza2 xs ys
trenza2 _      _      = []

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

trenza3 :: [a] -> [a] -> [a]
trenza3 xs ys = concat [[x,y] | (x,y) <- zip xs ys]

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

trenza4 :: [a] -> [a] -> [a]
trenza4 xs ys = concat (zipWith par xs ys)

par :: a -> a -> [a]
par x y = [x,y]

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

-- Explicación de eliminación de argumentos en composiciones con varios
-- argumentos:

f :: Int -> Int
f x = x + 1

g :: Int -> Int -> Int
g x y = x + y

h1, h2, h3, h4, h5, h6, h7 :: Int -> Int -> Int
h1 x y  = f (g x y)
h2 x y  = f ((g x) y)
h3 x y  = (f . (g x)) y
h4 x    = f . (g x)
h5 x    = (f .) (g x)
h6 x    = ((f .) . g) x
h7      = (f .) . g

prop_composicion :: Int -> Int -> Bool
prop_composicion x y =
  all (== h1 x y)
      [p x y | p <- [h2, h3, h4, h5, h6, h7]]

-- λ> quickCheck prop_composicion
-- +++ OK, passed 100 tests.

-- En general,
--    f . g             --> \x -> f (g x)
--    (f .) . g         --> \x y -> f (g x y)
--    ((f .) .) . g     --> \x y z -> f (g x y z)
--    (((f .) .) .) . g --> \w x y z -> f (g w x y z)

trenza5 :: [a] -> [a] -> [a]
trenza5 = (concat .) . zipWith par

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_trenza :: [Int] -> [Int] -> Bool
prop_trenza xs ys =
  all (== trenza1 xs ys)
      [trenza2 xs ys,
       trenza3 xs ys,
       trenza4 xs ys,
       trenza5 xs ys]

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

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

-- La comparación es
--    λ> last (trenza1 [1,1..] [1..4*10^6])
--    4000000
--    (2.33 secs, 1,472,494,952 bytes)
--    λ> last (trenza2 [1,1..] [1..4*10^6])
--    4000000
--    (2.24 secs, 1,376,494,928 bytes)
--    λ> last (trenza3 [1,1..] [1..4*10^6])
--    4000000
--    (1.33 secs, 1,888,495,048 bytes)
--    λ> last (trenza4 [1,1..] [1..4*10^6])
--    4000000
--    (0.76 secs, 1,696,494,968 bytes)
--    λ> last (trenza5 [1,1..] [1..4*10^6])
--    4000000
--    (0.76 secs, 1,696,495,064 bytes)

100

101

102

103

104

105

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

trenza1 :: [a] -> [a] -> [a]

trenza1 [] _ = []

trenza1 _ [] = []

trenza1 (x:xs) (y:ys) = x : y : trenza1 xs ys

-- 2ª solución

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

trenza2 :: [a] -> [a] -> [a]

trenza2 (x:xs) (y:ys) = x : y : trenza2 xs ys

trenza2 _ _ = []

-- 3ª solución

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

trenza3 :: [a] -> [a] -> [a]

trenza3 xs ys = concat [[x,y] | (x,y) <- zip xs ys]

-- 4ª solución

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

trenza4 :: [a] -> [a] -> [a]

trenza4 xs ys = concat (zipWith par xs ys)

par :: a -> a -> [a]

par x y = [x,y]

-- 5ª solución

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

-- Explicación de eliminación de argumentos en composiciones con varios

-- argumentos:

f :: Int -> Int

f x = x + 1

g :: Int -> Int -> Int

g x y = x + y

h1, h2, h3, h4, h5, h6, h7 :: Int -> Int -> Int

h1 x y = f (g x y)

h2 x y = f ((g x) y)

h3 x y = (f . (g x)) y

h4 x = f . (g x)

h5 x = (f .) (g x)

h6 x = ((f .) . g) x

h7 = (f .) . g

prop_composicion :: Int -> Int -> Bool

prop_composicion x y =

all (== h1 x y)

[p x y | p <- [h2, h3, h4, h5, h6, h7]]

-- λ> quickCheck prop_composicion

-- +++ OK, passed 100 tests.

-- En general,

-- f . g --> \x -> f (g x)

-- (f .) . g --> \x y -> f (g x y)

-- ((f .) .) . g --> \x y z -> f (g x y z)

-- (((f .) .) .) . g --> \w x y z -> f (g w x y z)

trenza5 :: [a] -> [a] -> [a]

trenza5 = (concat .) . zipWith par

-- Comprobación de equivalencia

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

-- La propiedad es

prop_trenza :: [Int] -> [Int] -> Bool

prop_trenza xs ys =

all (== trenza1 xs ys)

[trenza2 xs ys,

trenza3 xs ys,

trenza4 xs ys,

trenza5 xs ys]

-- La comprobación es

-- λ> quickCheck prop_trenza

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (trenza1 [1,1..] [1..4*10^6])

-- 4000000

-- (2.33 secs, 1,472,494,952 bytes)

-- λ> last (trenza2 [1,1..] [1..4*10^6])

-- 4000000

-- (2.24 secs, 1,376,494,928 bytes)

-- λ> last (trenza3 [1,1..] [1..4*10^6])

-- 4000000

-- (1.33 secs, 1,888,495,048 bytes)

-- λ> last (trenza4 [1,1..] [1..4*10^6])

-- 4000000

-- (0.76 secs, 1,696,494,968 bytes)

-- λ> last (trenza5 [1,1..] [1..4*10^6])

-- 4000000

-- (0.76 secs, 1,696,495,064 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>

Biparticiones de una lista

PorJosé A. Alonso 1-abril-20228-abril-2022

Definir la función

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

1	biparticiones :: [a] -> [([a],[a])]

tal que (biparticiones xs) es la lista de pares formados por un prefijo de xs y el resto de xs. Por ejemplo,

   λ> biparticiones [3,2,5]
   [([],[3,2,5]),([3],[2,5]),([3,2],[5]),([3,2,5],[])]
   λ> biparticiones "Roma"
   [("","Roma"),("R","oma"),("Ro","ma"),("Rom","a"),("Roma","")]

λ> biparticiones [3,2,5]

[([],[3,2,5]),([3],[2,5]),([3,2],[5]),([3,2,5],[])]

λ> biparticiones "Roma"

[("","Roma"),("R","oma"),("Ro","ma"),("Rom","a"),("Roma","")]

Soluciones

import Data.List (inits, tails)
import Control.Applicative (liftA2)
import Test.QuickCheck (quickCheck)

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

biparticiones1 :: [a] -> [([a],[a])]
biparticiones1 [] = [([],[])]
biparticiones1 (x:xs) =
  ([],(x:xs)) : [(x:ys,zs) | (ys,zs) <- biparticiones1 xs]

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

biparticiones2 :: [a] -> [([a],[a])]
biparticiones2 xs =
  [(take i xs, drop i xs) | i <- [0..length xs]]

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

biparticiones3 :: [a] -> [([a],[a])]
biparticiones3 xs =
  [splitAt i xs | i <- [0..length xs]]

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

biparticiones4 :: [a] -> [([a],[a])]
biparticiones4 xs =
  zip (inits xs) (tails xs)

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

biparticiones5 :: [a] -> [([a],[a])]
biparticiones5 = liftA2 zip inits tails

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

biparticiones6 :: [a] -> [([a],[a])]
biparticiones6 = zip <$> inits <*> tails

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_biparticiones :: [Int] -> Bool
prop_biparticiones xs =
  all (== biparticiones1 xs)
      [biparticiones2 xs,
       biparticiones3 xs,
       biparticiones4 xs,
       biparticiones5 xs,
       biparticiones6 xs]

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

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

-- La comparación es
--    λ> length (biparticiones1 [1..6*10^3])
--    6001
--    (2.21 secs, 3,556,073,552 bytes)
--    λ> length (biparticiones2 [1..6*10^3])
--    6001
--    (0.01 secs, 2,508,448 bytes)
--
--    λ> length (biparticiones2 [1..6*10^6])
--    6000001
--    (2.26 secs, 2,016,494,864 bytes)
--    λ> length (biparticiones3 [1..6*10^6])
--    6000001
--    (2.12 secs, 1,584,494,792 bytes)
--    λ> length (biparticiones4 [1..6*10^6])
--    6000001
--    (0.78 secs, 1,968,494,704 bytes)
--    λ> length (biparticiones5 [1..6*10^6])
--    6000001
--    (0.79 secs, 1,968,494,688 bytes)
--    λ> length (biparticiones6 [1..6*10^6])
--    6000001
--    (0.77 secs, 1,968,494,720 bytes)
--
--    λ> length (biparticiones4 [1..10^7])
--    10000001
--    (1.30 secs, 3,280,495,432 bytes)
--    λ> length (biparticiones5 [1..10^7])
--    10000001
--    (1.42 secs, 3,280,495,416 bytes)
--    λ> length (biparticiones6 [1..10^7])
--    10000001
--    (1.30 secs, 3,280,495,448 bytes)

import Data.List (inits, tails)

import Control.Applicative (liftA2)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

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

biparticiones1 [] = [([],[])]

biparticiones1 (x:xs) =

([],(x:xs)) : [(x:ys,zs) | (ys,zs) <- biparticiones1 xs]

-- 2ª solución

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

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

biparticiones2 xs =

[(take i xs, drop i xs) | i <- [0..length xs]]

-- 3ª solución

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

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

biparticiones3 xs =

[splitAt i xs | i <- [0..length xs]]

-- 4ª solución

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

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

biparticiones4 xs =

zip (inits xs) (tails xs)

-- 5ª solución

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

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

biparticiones5 = liftA2 zip inits tails

-- 6ª solución

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

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

biparticiones6 = zip <$> inits <*> tails

-- Comprobación de equivalencia

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

-- La propiedad es

prop_biparticiones :: [Int] -> Bool

prop_biparticiones xs =

all (== biparticiones1 xs)

[biparticiones2 xs,

biparticiones3 xs,

biparticiones4 xs,

biparticiones5 xs,

biparticiones6 xs]

-- La comprobación es

-- λ> quickCheck prop_biparticiones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (biparticiones1 [1..6*10^3])

-- 6001

-- (2.21 secs, 3,556,073,552 bytes)

-- λ> length (biparticiones2 [1..6*10^3])

-- 6001

-- (0.01 secs, 2,508,448 bytes)

-- λ> length (biparticiones2 [1..6*10^6])

-- 6000001

-- (2.26 secs, 2,016,494,864 bytes)

-- λ> length (biparticiones3 [1..6*10^6])

-- 6000001

-- (2.12 secs, 1,584,494,792 bytes)

-- λ> length (biparticiones4 [1..6*10^6])

-- 6000001

-- (0.78 secs, 1,968,494,704 bytes)

-- λ> length (biparticiones5 [1..6*10^6])

-- 6000001

-- (0.79 secs, 1,968,494,688 bytes)

-- λ> length (biparticiones6 [1..6*10^6])

-- 6000001

-- (0.77 secs, 1,968,494,720 bytes)

-- λ> length (biparticiones4 [1..10^7])

-- 10000001

-- (1.30 secs, 3,280,495,432 bytes)

-- λ> length (biparticiones5 [1..10^7])

-- 10000001

-- (1.42 secs, 3,280,495,416 bytes)

-- λ> length (biparticiones6 [1..10^7])

-- 10000001

-- (1.30 secs, 3,280,495,448 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>

Soluciones

Soluciones

Soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Entradas recientes

Buscar

Correo electrónico