Comprensión – Página 2

Alfabeto comenzando en un carácter

PorJosé A. Alonso 16-marzo-202223-marzo-2022

Definir la función

   alfabetoDesde :: Char -> String

1	alfabetoDesde :: Char -> String

tal que (alfabetoDesde c) es el alfabeto, en minúscula, comenzando en el carácter c, si c es una letra minúscula y comenzando en ‘a’, en caso contrario. Por ejemplo,

   alfabetoDesde 'e'  ==  "efghijklmnopqrstuvwxyzabcd"
   alfabetoDesde 'a'  ==  "abcdefghijklmnopqrstuvwxyz"
   alfabetoDesde '7'  ==  "abcdefghijklmnopqrstuvwxyz"
   alfabetoDesde '{'  ==  "abcdefghijklmnopqrstuvwxyz"
   alfabetoDesde 'B'  ==  "abcdefghijklmnopqrstuvwxyz"

alfabetoDesde 'e' == "efghijklmnopqrstuvwxyzabcd"

alfabetoDesde 'a' == "abcdefghijklmnopqrstuvwxyz"

alfabetoDesde '7' == "abcdefghijklmnopqrstuvwxyz"

alfabetoDesde '{' == "abcdefghijklmnopqrstuvwxyz"

alfabetoDesde 'B' == "abcdefghijklmnopqrstuvwxyz"

Soluciones

import Data.Char (isLower, isAscii)
import Test.QuickCheck

-- 1ª solución
alfabetoDesde1 :: Char -> String
alfabetoDesde1 c =
  dropWhile (<c) ['a'..'z'] ++ takeWhile (<c) ['a'..'z']

-- 2ª solución
alfabetoDesde2 :: Char -> String
alfabetoDesde2 c = ys ++ xs
  where (xs,ys) = span (<c) ['a'..'z']

-- 3ª solución
alfabetoDesde3 :: Char -> String
alfabetoDesde3 c = ys ++ xs
  where (xs,ys) = break (==c) ['a'..'z']

-- 4ª solución
alfabetoDesde4 :: Char -> String
alfabetoDesde4 c
  | 'a' <= c && c <= 'z' = [c..'z'] ++ ['a'..pred c]
  | otherwise            = ['a'..'z']

-- 5ª solución
alfabetoDesde5 :: Char -> String
alfabetoDesde5 c
  | isLower c = [c..'z'] ++ ['a'..pred c]
  | otherwise = ['a'..'z']

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

-- La propiedad es
prop_alfabetoDesde :: Property
prop_alfabetoDesde =
  forAll (arbitrary `suchThat` isAscii) $ \c ->
  all (== alfabetoDesde1 c)
      [f c | f <- [alfabetoDesde2,
                   alfabetoDesde3,
                   alfabetoDesde4,
                   alfabetoDesde5]]


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

import Data.Char (isLower, isAscii)

import Test.QuickCheck

-- 1ª solución

alfabetoDesde1 :: Char -> String

alfabetoDesde1 c =

dropWhile (<c) ['a'..'z'] ++ takeWhile (<c) ['a'..'z']

-- 2ª solución

alfabetoDesde2 :: Char -> String

alfabetoDesde2 c = ys ++ xs

where (xs,ys) = span (<c) ['a'..'z']

-- 3ª solución

alfabetoDesde3 :: Char -> String

alfabetoDesde3 c = ys ++ xs

where (xs,ys) = break (==c) ['a'..'z']

-- 4ª solución

alfabetoDesde4 :: Char -> String

alfabetoDesde4 c

| 'a' <= c && c <= 'z' = [c..'z'] ++ ['a'..pred c]

| otherwise = ['a'..'z']

-- 5ª solución

alfabetoDesde5 :: Char -> String

alfabetoDesde5 c

| isLower c = [c..'z'] ++ ['a'..pred c]

| otherwise = ['a'..'z']

-- Comprobación de equivalencia

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

-- La propiedad es

prop_alfabetoDesde :: Property

prop_alfabetoDesde =

forAll (arbitrary `suchThat` isAscii) $ \c ->

all (== alfabetoDesde1 c)

[f c | f <- [alfabetoDesde2,

alfabetoDesde3,

alfabetoDesde4,

alfabetoDesde5]]

-- La comprobación es

-- λ> quickCheck prop_alfabetoDesde

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

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

Ramas de un árbol

PorJosé A. Alonso 15-marzo-202226-marzo-2022

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

   data Arbol a = N a [Arbol a]
     deriving Show

1 2	data Arbol a = N a [Arbol a] deriving Show

Por ejemplo, los árboles

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

1 3

/ \ /|\

2 3 / | \

| 5 4 7

4 | /\

6 2 1

se representan por

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

ej1, ej2 :: Arbol Int

ej1 = N 1 [N 2 [],N 3 [N 4 []]]

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

Definir la función

   ramas :: Arbol b -> [[b]]

1	ramas :: Arbol b -> [[b]]

tal que (ramas a) es la lista de las ramas del árbol a. Por ejemplo,

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

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

Soluciones

import Test.QuickCheck

data Arbol a = N a [Arbol a]
  deriving Show

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

-- 1ª solución
ramas1 :: Arbol b -> [[b]]
ramas1 (N x []) = [[x]]
ramas1 (N x as) = [x : xs | a <- as, xs <- ramas1 a]

-- 2ª solución
ramas2 :: Arbol b -> [[b]]
ramas2 (N x []) = [[x]]
ramas2 (N x as) = concat (map (map (x:)) (map ramas2 as))

-- 3ª solución
ramas3 :: Arbol b -> [[b]]
ramas3 (N x []) = [[x]]
ramas3 (N x as) = concat (map (map (x:) . ramas3) as)

-- 4ª solución
ramas4 :: Arbol b -> [[b]]
ramas4 (N x []) = [[x]]
ramas4 (N x as) = concatMap (map (x:) . ramas4) as

-- 5ª solución
ramas5 :: Arbol a -> [[a]]
ramas5 (N x []) = [[x]]
ramas5 (N x xs) = map ramas5 xs >>= map (x:)

-- Comprobación de la equivalencia de las definiciones
-- ===================================================

-- (arbolArbitrario n) es un árbol aleatorio de orden n. Por ejemplo,
--    λ> sample (arbolArbitrario 4 :: Gen (Arbol Int))
--    N 0 [N 0 []]
--    N 1 [N 1 [N (-2) [N (-1) [N (-1) [N (-1) [N 1 []]]]]],N (-1) [N 2 []]]
--    N 1 [N (-2) [],N 0 [N (-4) [N (-2) []]]]
--    N (-4) [N 1 [],N 0 [N 6 [N (-4) []],N 2 [N 3 []]]]
--    N (-7) [N (-7) [N (-3) []]]
--    N (-2) [N (-8) []]
--    N (-3) [N 3 [N 2 []]]
--    N (-12) [N 5 [],N 0 []]
--    N 14 [N 13 [N (-12) []],N 11 [],N 8 [N (-13) []]]
--    N (-12) [N (-6) [N 16 [N (-14) [N (-1) []]]]]
--    N (-5) []
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_arbol :: Arbol Int -> Bool
prop_arbol a =
  all (== ramas1 a)
      [ramas2 a,
       ramas3 a,
       ramas4 a,
       ramas5 a]

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

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

-- La comparación es
--    λ> ej600 <- generate (arbolArbitrario 600 :: Gen (Arbol Int))
--    λ> length (ramas1 ej600)
--    1262732
--    (1.92 secs, 1,700,238,488 bytes)
--    λ> length (ramas2 ej600)
--    1262732
--    (1.94 secs, 2,549,877,280 bytes)
--    λ> length (ramas3 ej600)
--    1262732
--    (1.99 secs, 2,446,508,472 bytes)
--    λ> length (ramas4 ej600)
--    1262732
--    (1.67 secs, 2,090,469,104 bytes)
--    λ> length (ramas5 ej600)
--    1262732
--    (1.66 secs, 2,112,198,232 bytes)

import Test.QuickCheck

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2 :: Arbol Int

ej1 = N 1 [N 2 [],N 3 [N 4 []]]

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

-- 1ª solución

ramas1 :: Arbol b -> [[b]]

ramas1 (N x []) = [[x]]

ramas1 (N x as) = [x : xs | a <- as, xs <- ramas1 a]

-- 2ª solución

ramas2 :: Arbol b -> [[b]]

ramas2 (N x []) = [[x]]

ramas2 (N x as) = concat (map (map (x:)) (map ramas2 as))

-- 3ª solución

ramas3 :: Arbol b -> [[b]]

ramas3 (N x []) = [[x]]

ramas3 (N x as) = concat (map (map (x:) . ramas3) as)

-- 4ª solución

ramas4 :: Arbol b -> [[b]]

ramas4 (N x []) = [[x]]

ramas4 (N x as) = concatMap (map (x:) . ramas4) as

-- 5ª solución

ramas5 :: Arbol a -> [[a]]

ramas5 (N x []) = [[x]]

ramas5 (N x xs) = map ramas5 xs >>= map (x:)

-- Comprobación de la equivalencia de las definiciones

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

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

-- λ> sample (arbolArbitrario 4 :: Gen (Arbol Int))

-- N 0 [N 0 []]

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

-- N 1 [N (-2) [],N 0 [N (-4) [N (-2) []]]]

-- N (-4) [N 1 [],N 0 [N 6 [N (-4) []],N 2 [N 3 []]]]

-- N (-7) [N (-7) [N (-3) []]]

-- N (-2) [N (-8) []]

-- N (-3) [N 3 [N 2 []]]

-- N (-12) [N 5 [],N 0 []]

-- N 14 [N 13 [N (-12) []],N 11 [],N 8 [N (-13) []]]

-- N (-12) [N (-6) [N 16 [N (-14) [N (-1) []]]]]

-- N (-5) []

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_arbol :: Arbol Int -> Bool

prop_arbol a =

all (== ramas1 a)

[ramas2 a,

ramas3 a,

ramas4 a,

ramas5 a]

-- La comprobación es

-- λ> quickCheck prop_arbol

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> ej600 <- generate (arbolArbitrario 600 :: Gen (Arbol Int))

-- λ> length (ramas1 ej600)

-- 1262732

-- (1.92 secs, 1,700,238,488 bytes)

-- λ> length (ramas2 ej600)

-- 1262732

-- (1.94 secs, 2,549,877,280 bytes)

-- λ> length (ramas3 ej600)

-- 1262732

-- (1.99 secs, 2,446,508,472 bytes)

-- λ> length (ramas4 ej600)

-- 1262732

-- (1.67 secs, 2,090,469,104 bytes)

-- λ> length (ramas5 ej600)

-- 1262732

-- (1.66 secs, 2,112,198,232 bytes)

El código se encuentra en GitHub.

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

Valores de polinomios representados con vectores

PorJosé A. Alonso 14-marzo-202215-abril-2022

Los polinomios se pueden representar mediante vectores usando la librería Data.Array. En primer lugar, se define el tipo de los polinomios (con coeficientes de tipo a) mediante

   type Polinomio a = Array Int a

1	type Polinomio a = Array Int a

Como ejemplos, definimos el polinomio

   ej_pol1 :: Array Int Int
   ej_pol1 = array (0,4) [(0,6),(1,2),(2,-5),(3,0),(4,7)]

1 2	ej_pol1 :: Array Int Int ej_pol1 = array (0,4) [(0,6),(1,2),(2,-5),(3,0),(4,7)]

que representa a 6 + 2x – 5x^2 + 7x^4 y el polinomio

   ej_pol2 :: Array Int Double
   ej_pol2 = array (0,4) [(0,6.5),(1,2),(2,-5.2),(3,0),(4,7)]

1 2	ej_pol2 :: Array Int Double ej_pol2 = array (0,4) [(0,6.5),(1,2),(2,-5.2),(3,0),(4,7)]

que representa a 6.5 + 2x – 5.2x^2 + 7x^4

Definir la función

   valor :: Num a => Polinomio a -> a -> a

1	valor :: Num a => Polinomio a -> a -> a

tal que (valor p b) es el valor del polinomio p en el punto b. Por ejemplo,

   valor ej_pol1 0  ==  6
   valor ej_pol1 1  ==  10
   valor ej_pol1 2  ==  102
   valor ej_pol2 0  ==  6.5
   valor ej_pol2 1  ==  10.3
   valor ej_pol2 3  ==  532.7
   length (show (valor (listArray (0,5*10^5) (repeat 1)) 2)) == 150516

valor ej_pol1 0 == 6

valor ej_pol1 1 == 10

valor ej_pol1 2 == 102

valor ej_pol2 0 == 6.5

valor ej_pol2 1 == 10.3

valor ej_pol2 3 == 532.7

length (show (valor (listArray (0,5*10^5) (repeat 1)) 2)) == 150516

Soluciones

import Data.List (foldl')
import Data.Array (Array, (!), array, assocs, bounds, elems, listArray)
import Test.QuickCheck

type Polinomio a = Array Int a

ej_pol1 :: Array Int Int
ej_pol1 = array (0,4) [(1,2),(2,-5),(4,7),(0,6),(3,0)]

ej_pol2 :: Array Int Double
ej_pol2 = array (0,4) [(1,2),(2,-5.2),(4,7),(0,6.5),(3,0)]

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

valor1 :: Num a => Polinomio a -> a -> a
valor1 p b = sum [(p!i)*b^i | i <- [0..n]]
  where (_,n) = bounds p

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

valor2 :: Num a => Polinomio a -> a -> a
valor2 p b = sum [(p!i)*b^i | i <- [0..length p - 1]]

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

valor3 :: Num a => Polinomio a -> a -> a
valor3 p b = sum [v*b^i | (i,v) <- assocs p]

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

valor4 :: Num a => Polinomio a -> a -> a
valor4 = valorLista4 . elems

valorLista4 :: Num a => [a] -> a -> a
valorLista4 xs b =
  sum [(xs !! i) * b^i | i <- [0..length xs - 1]]

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

valor5 :: Num a => Polinomio a -> a -> a
valor5 = valorLista5 . elems

valorLista5 :: Num a => [a] -> a -> a
valorLista5 []     _ = 0
valorLista5 (x:xs) b = x + b * valorLista5 xs b

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

valor6 :: Num a => Polinomio a -> a -> a
valor6 = valorLista6 . elems

valorLista6 :: Num a => [a] -> a -> a
valorLista6 xs b = aux xs
  where aux []     = 0
        aux (y:ys) = y + b * aux ys

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

valor7 :: Num a => Polinomio a -> a -> a
valor7 = valorLista7 . elems

valorLista7 :: Num a => [a] -> a -> a
valorLista7 xs b = foldr (\y r -> y + b * r) 0 xs

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

valor8 :: Num a => Polinomio a -> a -> a
valor8 = valorLista8 . elems

valorLista8 :: Num a => [a] -> a -> a
valorLista8 xs b = aux 0 (reverse xs)
  where aux r []     = r
        aux r (y:ys) = aux (y + r * b) ys

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

valor9 :: Num a => Polinomio a -> a -> a
valor9 = valorLista9 . elems

valorLista9 :: Num a => [a] -> a -> a
valorLista9 xs b = aux 0 (reverse xs)
  where aux = foldl (\ r y -> y + r * b)

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

valor10 :: Num a => Polinomio a -> a -> a
valor10 p b =
  foldl (\ r y -> y + r * b) 0 (reverse (elems p))

-- 11ª solución
-- ============

valor11 :: Num a => Polinomio a -> a -> a
valor11 p b =
  foldl' (\ r y -> y + r * b) 0 (reverse (elems p))

-- 12ª solución
-- ============

valor12 :: Num a => Polinomio a -> a -> a
valor12 p b =
  sum (zipWith (*) (elems p) (iterate (* b) 1))

-- 13ª solución
-- ============

valor13 :: Num a => Polinomio a -> a -> a
valor13 p b =
  foldl' (+) 0 (zipWith (*) (elems p) (iterate (* b) 1))

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

-- La propiedad es
prop_valor :: [Integer] -> Integer -> Bool
prop_valor xs b =
  all (== valor1 p b)
      [f p b | f <- [valor2,
                     valor3,
                     valor4,
                     valor5,
                     valor6,
                     valor7,
                     valor8,
                     valor9,
                     valor10,
                     valor11,
                     valor12,
                     valor13]]
  where p = listArray (0, length xs - 1) xs

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

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

-- La comparación es
--    λ> length (show (valor1 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (7.62 secs, 2,953,933,864 bytes)
--    λ> length (show (valor2 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (8.26 secs, 2,953,933,264 bytes)
--    λ> length (show (valor3 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (7.49 secs, 2,954,733,184 bytes)
--    λ> length (show (valor4 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (84.80 secs, 2,956,333,712 bytes)
--    λ> length (show (valor5 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (1.34 secs, 1,307,347,416 bytes)
--    λ> length (show (valor6 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (1.26 secs, 1,308,114,752 bytes)
--    λ> length (show (valor7 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (1.21 secs, 1,296,843,456 bytes)
--    λ> length (show (valor8 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (1.28 secs, 1,309,591,744 bytes)
--    λ> length (show (valor9 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (1.27 secs, 1,299,191,672 bytes)
--    λ> length (show (valor10 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (1.30 secs, 1,299,191,432 bytes)
--    λ> length (show (valor11 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (0.23 secs, 1,287,654,752 bytes)
--    λ> length (show (valor12 (listArray (0,10^5) (repeat 1)) 2))
--    30104
--    (0.75 secs, 1,309,506,968 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

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

import Data.List (foldl')

import Data.Array (Array, (!), array, assocs, bounds, elems, listArray)

import Test.QuickCheck

type Polinomio a = Array Int a

ej_pol1 :: Array Int Int

ej_pol1 = array (0,4) [(1,2),(2,-5),(4,7),(0,6),(3,0)]

ej_pol2 :: Array Int Double

ej_pol2 = array (0,4) [(1,2),(2,-5.2),(4,7),(0,6.5),(3,0)]

-- 1ª solución

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

valor1 :: Num a => Polinomio a -> a -> a

valor1 p b = sum [(p!i)*b^i | i <- [0..n]]

where (_,n) = bounds p

-- 2ª solución

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

valor2 :: Num a => Polinomio a -> a -> a

valor2 p b = sum [(p!i)*b^i | i <- [0..length p - 1]]

-- 3ª solución

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

valor3 :: Num a => Polinomio a -> a -> a

valor3 p b = sum [v*b^i | (i,v) <- assocs p]

-- 4ª solución

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

valor4 :: Num a => Polinomio a -> a -> a

valor4 = valorLista4 . elems

valorLista4 :: Num a => [a] -> a -> a

valorLista4 xs b =

sum [(xs !! i) * b^i | i <- [0..length xs - 1]]

-- 5ª solución

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

valor5 :: Num a => Polinomio a -> a -> a

valor5 = valorLista5 . elems

valorLista5 :: Num a => [a] -> a -> a

valorLista5 [] _ = 0

valorLista5 (x:xs) b = x + b * valorLista5 xs b

-- 6ª solución

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

valor6 :: Num a => Polinomio a -> a -> a

valor6 = valorLista6 . elems

valorLista6 :: Num a => [a] -> a -> a

valorLista6 xs b = aux xs

where aux [] = 0

aux (y:ys) = y + b * aux ys

-- 7ª solución

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

valor7 :: Num a => Polinomio a -> a -> a

valor7 = valorLista7 . elems

valorLista7 :: Num a => [a] -> a -> a

valorLista7 xs b = foldr (\y r -> y + b * r) 0 xs

-- 8ª solución

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

valor8 :: Num a => Polinomio a -> a -> a

valor8 = valorLista8 . elems

valorLista8 :: Num a => [a] -> a -> a

valorLista8 xs b = aux 0 (reverse xs)

where aux r [] = r

aux r (y:ys) = aux (y + r * b) ys

-- 9ª solución

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

valor9 :: Num a => Polinomio a -> a -> a

valor9 = valorLista9 . elems

valorLista9 :: Num a => [a] -> a -> a

valorLista9 xs b = aux 0 (reverse xs)

where aux = foldl (\ r y -> y + r * b)

-- 10ª solución

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

valor10 :: Num a => Polinomio a -> a -> a

valor10 p b =

foldl (\ r y -> y + r * b) 0 (reverse (elems p))

-- 11ª solución

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

valor11 :: Num a => Polinomio a -> a -> a

valor11 p b =

foldl' (\ r y -> y + r * b) 0 (reverse (elems p))

-- 12ª solución

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

valor12 :: Num a => Polinomio a -> a -> a

valor12 p b =

sum (zipWith (*) (elems p) (iterate (* b) 1))

-- 13ª solución

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

valor13 :: Num a => Polinomio a -> a -> a

valor13 p b =

foldl' (+) 0 (zipWith (*) (elems p) (iterate (* b) 1))

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_valor :: [Integer] -> Integer -> Bool

prop_valor xs b =

all (== valor1 p b)

[f p b | f <- [valor2,

valor3,

valor4,

valor5,

valor6,

valor7,

valor8,

valor9,

valor10,

valor11,

valor12,

valor13]]

where p = listArray (0, length xs - 1) xs

-- La comprobación es

-- λ> quickCheck prop_valor

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (show (valor1 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (7.62 secs, 2,953,933,864 bytes)

-- λ> length (show (valor2 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (8.26 secs, 2,953,933,264 bytes)

-- λ> length (show (valor3 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (7.49 secs, 2,954,733,184 bytes)

-- λ> length (show (valor4 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (84.80 secs, 2,956,333,712 bytes)

-- λ> length (show (valor5 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (1.34 secs, 1,307,347,416 bytes)

-- λ> length (show (valor6 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (1.26 secs, 1,308,114,752 bytes)

-- λ> length (show (valor7 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (1.21 secs, 1,296,843,456 bytes)

-- λ> length (show (valor8 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (1.28 secs, 1,309,591,744 bytes)

-- λ> length (show (valor9 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (1.27 secs, 1,299,191,672 bytes)

-- λ> length (show (valor10 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (1.30 secs, 1,299,191,432 bytes)

-- λ> length (show (valor11 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (0.23 secs, 1,287,654,752 bytes)

-- λ> length (show (valor12 (listArray (0,10^5) (repeat 1)) 2))

-- 30104

-- (0.75 secs, 1,309,506,968 bytes)

El código se encuentra en GitHub.

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

Segmentos maximales de elementos consecutivos

PorJosé A. Alonso 11-marzo-202217-marzo-2022

Definir la función

   segmentos :: (Enum a, Eq a) => [a] -> [[a]]

1	segmentos :: (Enum a, Eq a) => [a] -> [[a]]

tal que (segmentos xss) es la lista de los segmentos maximales de xss formados por elementos consecutivos. Por ejemplo,

   segmentos [1,2,5,6,4]     ==  [[1,2],[5,6],[4]]
   segmentos [1,2,3,4,7,8,9] ==  [[1,2,3,4],[7,8,9]]
   segmentos "abbccddeeebc"  ==  ["ab","bc","cd","de","e","e","bc"]

segmentos [1,2,5,6,4] == [[1,2],[5,6],[4]]

segmentos [1,2,3,4,7,8,9] == [[1,2,3,4],[7,8,9]]

segmentos "abbccddeeebc" == ["ab","bc","cd","de","e","e","bc"]

Soluciones

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

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

[/schedule]

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

import Test.QuickCheck

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

segmentos1 :: (Enum a, Eq a) => [a] -> [[a]]
segmentos1 []  = []
segmentos1 xs = ys : segmentos1 zs
  where ys = inicial xs
        n  = length ys
        zs = drop n xs

-- (inicial xs) es el segmento inicial de xs formado por elementos
-- consecutivos. Por ejemplo,
--    inicial [1,2,5,6,4]    ==  [1,2]
--    inicial "abccddeeebc"  ==  "abc"
inicial :: (Enum a, Eq a) => [a] -> [a]
inicial []      = []
inicial [x]     = [x]
inicial (x:y:xs)
  | succ x == y = x : inicial (y:xs)
  | otherwise   = [x]

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

segmentos2 :: (Enum a, Eq a) => [a] -> [[a]]
segmentos2 []  = []
segmentos2 xs = ys : segmentos2 zs
  where (ys,zs) = inicialYresto xs

-- (inicialYresto xs) es par formado por el segmento inicial de xs
-- con elementos consecutivos junto con los restantes elementos. Por
-- ejemplo,
--    inicialYresto [1,2,5,6,4]    ==  ([1,2],[5,6,4])
--    inicialYresto "abccddeeebc"  ==  ("abc","cddeeebc")
inicialYresto :: (Enum a, Eq a) => [a] -> ([a],[a])
inicialYresto []      = ([],[])
inicialYresto [x]     = ([x],[])
inicialYresto (x:y:xs)
  | succ x == y = (x:us,vs)
  | otherwise   = ([x],y:xs)
  where (us,vs) = inicialYresto (y:xs)

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

segmentos3 :: (Enum a, Eq a) => [a] -> [[a]]
segmentos3 []  = []
segmentos3 [x] = [[x]]
segmentos3 (x:xs) | y == succ x = (x:y:ys):zs
                  | otherwise   = [x] : (y:ys):zs
  where ((y:ys):zs) = segmentos3 xs

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

segmentos4 :: (Enum a, Eq a) => [a] -> [[a]]
segmentos4 []  = []
segmentos4 xs = ys : segmentos4 zs
  where ys = inicial4 xs
        n  = length ys
        zs = drop n xs

inicial4 :: (Enum a, Eq a) => [a] -> [a]
inicial4 [] = []
inicial4 (x:xs) =
  map fst (takeWhile (\(u,v) -> u == v) (zip (x:xs) [x..]))

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

segmentos5 :: (Enum a, Eq a) => [a] -> [[a]]
segmentos5 []  = []
segmentos5 xs = ys : segmentos5 zs
  where ys = inicial5 xs
        n  = length ys
        zs = drop n xs

inicial5 :: (Enum a, Eq a) => [a] -> [a]
inicial5 [] = []
inicial5 (x:xs) =
  map fst (takeWhile (uncurry (==)) (zip (x:xs) [x..]))

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

-- La propiedad es
prop_segmentos :: [Int] -> Bool
prop_segmentos xs =
  all (== segmentos1 xs)
      [segmentos2 xs,
       segmentos3 xs,
       segmentos4 xs,
       segmentos5 xs]

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

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

-- La comparación es
--    λ> length (segmentos1 (take (10^6) (cycle [1..10^3])))
--    1000
--    (0.69 secs, 416,742,208 bytes)
--    λ> length (segmentos2 (take (10^6) (cycle [1..10^3])))
--    1000
--    (0.66 secs, 528,861,976 bytes)
--    λ> length (segmentos3 (take (10^6) (cycle [1..10^3])))
--    1000
--    (2.35 secs, 1,016,276,896 bytes)
--    λ> length (segmentos4 (take (10^6) (cycle [1..10^3])))
--    1000
--    (0.27 secs, 409,438,368 bytes)
--    λ> length (segmentos5 (take (10^6) (cycle [1..10^3])))
--    1000
--    (0.13 secs, 401,510,360 bytes)
--
--    λ> length (segmentos4 (take (10^7) (cycle [1..10^3])))
--    10000
--    (2.35 secs, 4,088,926,920 bytes)
--    λ> length (segmentos5 (take (10^7) (cycle [1..10^3])))
--    10000
--    (1.02 secs, 4,009,646,928 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

import Test.QuickCheck

-- 1ª solución

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

segmentos1 :: (Enum a, Eq a) => [a] -> [[a]]

segmentos1 [] = []

segmentos1 xs = ys : segmentos1 zs

where ys = inicial xs

n = length ys

zs = drop n xs

-- (inicial xs) es el segmento inicial de xs formado por elementos

-- consecutivos. Por ejemplo,

-- inicial [1,2,5,6,4] == [1,2]

-- inicial "abccddeeebc" == "abc"

inicial :: (Enum a, Eq a) => [a] -> [a]

inicial [] = []

inicial [x] = [x]

inicial (x:y:xs)

| succ x == y = x : inicial (y:xs)

| otherwise = [x]

-- 2ª solución

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

segmentos2 :: (Enum a, Eq a) => [a] -> [[a]]

segmentos2 [] = []

segmentos2 xs = ys : segmentos2 zs

where (ys,zs) = inicialYresto xs

-- (inicialYresto xs) es par formado por el segmento inicial de xs

-- con elementos consecutivos junto con los restantes elementos. Por

-- ejemplo,

-- inicialYresto [1,2,5,6,4] == ([1,2],[5,6,4])

-- inicialYresto "abccddeeebc" == ("abc","cddeeebc")

inicialYresto :: (Enum a, Eq a) => [a] -> ([a],[a])

inicialYresto [] = ([],[])

inicialYresto [x] = ([x],[])

inicialYresto (x:y:xs)

| succ x == y = (x:us,vs)

| otherwise = ([x],y:xs)

where (us,vs) = inicialYresto (y:xs)

-- 3ª solución

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

segmentos3 :: (Enum a, Eq a) => [a] -> [[a]]

segmentos3 [] = []

segmentos3 [x] = [[x]]

segmentos3 (x:xs) | y == succ x = (x:y:ys):zs

| otherwise = [x] : (y:ys):zs

where ((y:ys):zs) = segmentos3 xs

-- 4ª solución

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

segmentos4 :: (Enum a, Eq a) => [a] -> [[a]]

segmentos4 [] = []

segmentos4 xs = ys : segmentos4 zs

where ys = inicial4 xs

n = length ys

zs = drop n xs

inicial4 :: (Enum a, Eq a) => [a] -> [a]

inicial4 [] = []

inicial4 (x:xs) =

map fst (takeWhile (\(u,v) -> u == v) (zip (x:xs) [x..]))

-- 5ª solución

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

segmentos5 :: (Enum a, Eq a) => [a] -> [[a]]

segmentos5 [] = []

segmentos5 xs = ys : segmentos5 zs

where ys = inicial5 xs

n = length ys

zs = drop n xs

inicial5 :: (Enum a, Eq a) => [a] -> [a]

inicial5 [] = []

inicial5 (x:xs) =

map fst (takeWhile (uncurry (==)) (zip (x:xs) [x..]))

-- Comprobación de equivalencia

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

-- La propiedad es

prop_segmentos :: [Int] -> Bool

prop_segmentos xs =

all (== segmentos1 xs)

[segmentos2 xs,

segmentos3 xs,

segmentos4 xs,

segmentos5 xs]

-- La comprobación es

-- λ> quickCheck prop_segmentos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (segmentos1 (take (10^6) (cycle [1..10^3])))

-- 1000

-- (0.69 secs, 416,742,208 bytes)

-- λ> length (segmentos2 (take (10^6) (cycle [1..10^3])))

-- 1000

-- (0.66 secs, 528,861,976 bytes)

-- λ> length (segmentos3 (take (10^6) (cycle [1..10^3])))

-- 1000

-- (2.35 secs, 1,016,276,896 bytes)

-- λ> length (segmentos4 (take (10^6) (cycle [1..10^3])))

-- 1000

-- (0.27 secs, 409,438,368 bytes)

-- λ> length (segmentos5 (take (10^6) (cycle [1..10^3])))

-- 1000

-- (0.13 secs, 401,510,360 bytes)

-- λ> length (segmentos4 (take (10^7) (cycle [1..10^3])))

-- 10000

-- (2.35 secs, 4,088,926,920 bytes)

-- λ> length (segmentos5 (take (10^7) (cycle [1..10^3])))

-- 10000

-- (1.02 secs, 4,009,646,928 bytes)

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

La elaboración de las soluciones explica en el siguiente vídeo:

[/schedule]

Lista cuadrada

PorJosé A. Alonso 10-marzo-202217-marzo-2022

Definir la función

   listaCuadrada :: Int -> a -> [a] -> [[a]]

1	listaCuadrada :: Int -> a -> [a] -> [[a]]

tal que (listaCuadrada n x xs) es una lista de n listas de longitud n formadas con los elementos de xs completada con x, si no xs no tiene suficientes elementos. Por ejemplo,

   listaCuadrada 3 7 [0,3,5,2,4]  ==  [[0,3,5],[2,4,7],[7,7,7]]
   listaCuadrada 3 7 [0..]        ==  [[0,1,2],[3,4,5],[6,7,8]]
   listaCuadrada 2 'p' "eva"      ==  ["ev","ap"]
   listaCuadrada 2 'p' ['a'..]    ==  ["ab","cd"]

listaCuadrada 3 7 [0,3,5,2,4] == [[0,3,5],[2,4,7],[7,7,7]]

listaCuadrada 3 7 [0..] == [[0,1,2],[3,4,5],[6,7,8]]

listaCuadrada 2 'p' "eva" == ["ev","ap"]

listaCuadrada 2 'p' ['a'..] == ["ab","cd"]

Soluciones

import Data.List.Split (chunksOf)
import Test.QuickCheck

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

listaCuadrada1 :: Int -> a -> [a] -> [[a]]
listaCuadrada1 n x xs =
  take n (grupos n (xs ++ repeat x))

-- (grupos n xs) es la lista obtenida agrupando los elementos de xs en
-- grupos de n elementos, salvo el último que puede tener menos. Por
-- ejemplo,
--    grupos 2 [4,2,5,7,6]     ==  [[4,2],[5,7],[6]]
--    take 3 (grupos 3 [1..])  ==  [[1,2,3],[4,5,6],[7,8,9]]
grupos :: Int -> [a] -> [[a]]
grupos _ [] = []
grupos n xs = take n xs : grupos n (drop n xs)

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

listaCuadrada2 :: Int -> a -> [a] -> [[a]]
listaCuadrada2 n x xs =
  take n (grupos2 n (xs ++ repeat x))

grupos2 :: Int -> [a] -> [[a]]
grupos2 _ [] = []
grupos2 n xs = ys : grupos n zs
  where (ys,zs) = splitAt n xs

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

listaCuadrada3 :: Int -> a -> [a] -> [[a]]
listaCuadrada3 n x xs =
  take n (chunksOf n (xs ++ repeat x))

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

-- La propiedad es
prop_listaCuadrada :: Int -> Int -> [Int] -> Bool
prop_listaCuadrada n x xs =
  all (== listaCuadrada1 n x xs)
      [listaCuadrada2 n x xs,
       listaCuadrada3 n x xs]

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

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

-- La comparación es
--    λ> length (listaCuadrada1 (10^4) 5 [1..])
--    10000
--    (2.02 secs, 12,801,918,616 bytes)
--    λ> length (listaCuadrada2 (10^4) 5 [1..])
--    10000
--    (1.89 secs, 12,803,198,576 bytes)
--    λ> length (listaCuadrada3 (10^4) 5 [1..])
--    10000
--    (1.85 secs, 12,801,518,728 bytes)

import Data.List.Split (chunksOf)

import Test.QuickCheck

-- 1ª solución

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

listaCuadrada1 :: Int -> a -> [a] -> [[a]]

listaCuadrada1 n x xs =

take n (grupos n (xs ++ repeat x))

-- (grupos n xs) es la lista obtenida agrupando los elementos de xs en

-- grupos de n elementos, salvo el último que puede tener menos. Por

-- ejemplo,

-- grupos 2 [4,2,5,7,6] == [[4,2],[5,7],[6]]

-- take 3 (grupos 3 [1..]) == [[1,2,3],[4,5,6],[7,8,9]]

grupos :: Int -> [a] -> [[a]]

grupos _ [] = []

grupos n xs = take n xs : grupos n (drop n xs)

-- 2ª solución

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

listaCuadrada2 :: Int -> a -> [a] -> [[a]]

listaCuadrada2 n x xs =

take n (grupos2 n (xs ++ repeat x))

grupos2 :: Int -> [a] -> [[a]]

grupos2 _ [] = []

grupos2 n xs = ys : grupos n zs

where (ys,zs) = splitAt n xs

-- 3ª solución

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

listaCuadrada3 :: Int -> a -> [a] -> [[a]]

listaCuadrada3 n x xs =

take n (chunksOf n (xs ++ repeat x))

-- Comprobación de la equivalencia

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

-- La propiedad es

prop_listaCuadrada :: Int -> Int -> [Int] -> Bool

prop_listaCuadrada n x xs =

all (== listaCuadrada1 n x xs)

[listaCuadrada2 n x xs,

listaCuadrada3 n x xs]

-- La comprobación es

-- λ> quickCheck prop_listaCuadrada

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (listaCuadrada1 (10^4) 5 [1..])

-- 10000

-- (2.02 secs, 12,801,918,616 bytes)

-- λ> length (listaCuadrada2 (10^4) 5 [1..])

-- 10000

-- (1.89 secs, 12,803,198,576 bytes)

-- λ> length (listaCuadrada3 (10^4) 5 [1..])

-- 10000

-- (1.85 secs, 12,801,518,728 bytes)

El código se encuentra en GitHub.

La elaboración de la solución se muestra en el siguiente vídeo:

Máximos locales

PorJosé A. Alonso 9-marzo-202216-marzo-2022

Un máximo local de una lista es un elemento de la lista que es mayor que su predecesor y que su sucesor en la lista. Por ejemplo, 5 es un máximo local de [3,2,5,3,7,7,1,6,2] ya que es mayor que 2 (su predecesor) y que 3 (su sucesor).

Definir la función

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

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

tal que (maximosLocales xs) es la lista de los máximos locales de la lista xs. Por ejemplo,

   maximosLocales [3,2,5,3,7,7,1,6,2]  ==  [5,6]
   maximosLocales [1..100]             ==  []
   maximosLocales "adbpmqexyz"         ==  "dpq"

maximosLocales [3,2,5,3,7,7,1,6,2] == [5,6]

maximosLocales [1..100] == []

maximosLocales "adbpmqexyz" == "dpq"

Soluciones

import Test.QuickCheck

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

maximosLocales1 :: Ord a => [a] -> [a]
maximosLocales1 (x:y:z:xs)
  | y > x && y > z = y : maximosLocales1 (z:xs)
  | otherwise      = maximosLocales1 (y:z:xs)
maximosLocales1 _ = []

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

maximosLocales2 :: Ord a => [a] -> [a]
maximosLocales2 xs =
  [y | (x,y,z) <- zip3 xs (tail xs) (drop 2 xs), y > x, y > z]

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

-- La propiedad es
prop_maximosLocales :: [Int] -> Property
prop_maximosLocales xs =
  maximosLocales1 xs === maximosLocales2 xs

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

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

-- La comparación es
--    λ> last (maximosLocales1 (take (6*10^6) (cycle "abc")))
--    'c'
--    (3.26 secs, 1,904,464,984 bytes)
--    λ> last (maximosLocales2 (take (6*10^6) (cycle "abc")))
--    'c'
--    (2.79 secs, 1,616,465,088 bytes)

import Test.QuickCheck

-- 1ª solución

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

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

maximosLocales1 (x:y:z:xs)

| y > x && y > z = y : maximosLocales1 (z:xs)

| otherwise = maximosLocales1 (y:z:xs)

maximosLocales1 _ = []

-- 2ª solución

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

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

maximosLocales2 xs =

[y | (x,y,z) <- zip3 xs (tail xs) (drop 2 xs), y > x, y > z]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_maximosLocales :: [Int] -> Property

prop_maximosLocales xs =

maximosLocales1 xs === maximosLocales2 xs

-- La comprobación es

-- λ> quickCheck prop_maximosLocales

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (maximosLocales1 (take (6*10^6) (cycle "abc")))

-- 'c'

-- (3.26 secs, 1,904,464,984 bytes)

-- λ> last (maximosLocales2 (take (6*10^6) (cycle "abc")))

-- 'c'

-- (2.79 secs, 1,616,465,088 bytes)

El código se encuentra en GitHub.

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

Matrices de Toepliz

PorJosé A. Alonso 8-marzo-202215-abril-2022

Una matriz de Toeplitz es una matriz cuadrada que es constante a lo largo de las diagonales paralelas a la diagonal principal. Por ejemplo,

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

|2 5 1 6| |2 5 1 6|

|4 2 5 1| |4 2 6 1|

|7 4 2 5| |7 4 2 5|

|9 7 4 2| |9 7 4 2|

la primera es una matriz de Toeplitz y la segunda no lo es.

Las anteriores matrices se pueden definir por

   ej1, ej2 :: Array (Int,Int) Int
   ej1 = listArray ((1,1),(4,4)) [2,5,1,6,4,2,5,1,7,4,2,5,9,7,4,2]
   ej2 = listArray ((1,1),(4,4)) [2,5,1,6,4,2,6,1,7,4,2,5,9,7,4,2]

ej1, ej2 :: Array (Int,Int) Int

ej1 = listArray ((1,1),(4,4)) [2,5,1,6,4,2,5,1,7,4,2,5,9,7,4,2]

ej2 = listArray ((1,1),(4,4)) [2,5,1,6,4,2,6,1,7,4,2,5,9,7,4,2]

Definir la función

   esToeplitz :: Eq a => Array (Int,Int) a -> Bool

1	esToeplitz :: Eq a => Array (Int,Int) a -> Bool

tal que (esToeplitz p) se verifica si la matriz p es de Toeplitz. Por ejemplo,

   esToeplitz ej1  ==  True
   esToeplitz ej2  ==  False

1 2	esToeplitz ej1 == True esToeplitz ej2 == False

Soluciones

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

ej1, ej2 :: Array (Int,Int) Int
ej1 = listArray ((1,1),(4,4)) [2,5,1,6,4,2,5,1,7,4,2,5,9,7,4,2]
ej2 = listArray ((1,1),(4,4)) [2,5,1,6,4,2,6,1,7,4,2,5,9,7,4,2]

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

esToeplitz1 :: Eq a => Array (Int,Int) a -> Bool
esToeplitz1 p =
  esCuadrada p &&
  all todosIguales (diagonalesPrincipales p)

-- (esCuadrada p) se verifica si la matriz p es cuadrada. Por ejemplo,
--    esCuadrada (listArray ((1,1),(4,4)) [1..])  ==  True
--    esCuadrada (listArray ((1,1),(3,4)) [1..])  ==  False
esCuadrada :: Eq a => Array (Int,Int) a -> Bool
esCuadrada p = m == n
  where (_,(m,n)) = bounds p

-- (diagonalesPrincipales p) es la lista de las diagonales principales
-- de p. Por ejemplo,
--    λ> diagonalesPrincipales ej1
--    [[2,2,2,2],[5,5,5],[1,1],[6],[2,2,2,2],[4,4,4],[7,7],[9]]
--    λ> diagonalesPrincipales ej2
--    [[2,2,2,2],[5,6,5],[1,1],[6],[2,2,2,2],[4,4,4],[7,7],[9]]
diagonalesPrincipales :: Array (Int,Int) a -> [[a]]
diagonalesPrincipales p =
  [[p ! i |i <- is] | is <- posicionesDiagonalesPrincipales m n]
  where (_,(m,n)) = bounds p

-- (posicionesDiagonalesPrincipales m n) es la lista de las
-- posiciones de las diagonales principales de una matriz con m filas y
-- n columnas. Por ejemplo,
--   λ> mapM_ print (posicionesDiagonalesPrincipales 3 4)
--   [(3,1)]
--   [(2,1),(3,2)]
--   [(1,1),(2,2),(3,3)]
--   [(1,2),(2,3),(3,4)]
--   [(1,3),(2,4)]
--   [(1,4)]
--   λ> mapM_ print (posicionesDiagonalesPrincipales 4 4)
--   [(4,1)]
--   [(3,1),(4,2)]
--   [(2,1),(3,2),(4,3)]
--   [(1,1),(2,2),(3,3),(4,4)]
--   [(1,2),(2,3),(3,4)]
--   [(1,3),(2,4)]
--   [(1,4)]
--   λ> mapM_ print (posicionesDiagonalesPrincipales 4 3)
--   [(4,1)]
--   [(3,1),(4,2)]
--   [(2,1),(3,2),(4,3)]
--   [(1,1),(2,2),(3,3)]
--   [(1,2),(2,3)]
--   [(1,3)]
posicionesDiagonalesPrincipales :: Int -> Int -> [[(Int, Int)]]
posicionesDiagonalesPrincipales m n =
  [zip [i..m] [1..n] | i <- [m,m-1..1]] ++
  [zip [1..m] [j..n] | j <- [2..n]]

-- (todosIguales xs) se verifica si todos los elementos de xs son
-- iguales. Por ejemplo,
--    todosIguales [5,5,5]  ==  True
--    todosIguales [5,4,5]  ==  False
todosIguales :: Eq a => [a] -> Bool
todosIguales []     = True
todosIguales (x:xs) = all (== x) xs

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

esToeplitz2 :: Eq a => Array (Int,Int) a -> Bool
esToeplitz2 p = m == n &&
               and [p!(i,j) == p!(i+1,j+1) |
                    i <- [1..n-1], j <- [1..n-1]]
  where (_,(m,n)) = bounds p

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

-- La comparación es
--    λ> esToeplitz1 (listArray ((1,1),(2*10^3,2*10^3)) (repeat 1))
--    True
--    (2.26 secs, 2,211,553,888 bytes)
--    λ> esToeplitz2 (listArray ((1,1),(2*10^3,2*10^3)) (repeat 1))
--    True
--    (4.26 secs, 3,421,651,032 bytes)

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

ej1, ej2 :: Array (Int,Int) Int

ej1 = listArray ((1,1),(4,4)) [2,5,1,6,4,2,5,1,7,4,2,5,9,7,4,2]

ej2 = listArray ((1,1),(4,4)) [2,5,1,6,4,2,6,1,7,4,2,5,9,7,4,2]

-- 1ª solución

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

esToeplitz1 :: Eq a => Array (Int,Int) a -> Bool

esToeplitz1 p =

esCuadrada p &&

all todosIguales (diagonalesPrincipales p)

-- (esCuadrada p) se verifica si la matriz p es cuadrada. Por ejemplo,

-- esCuadrada (listArray ((1,1),(4,4)) [1..]) == True

-- esCuadrada (listArray ((1,1),(3,4)) [1..]) == False

esCuadrada :: Eq a => Array (Int,Int) a -> Bool

esCuadrada p = m == n

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

-- (diagonalesPrincipales p) es la lista de las diagonales principales

-- de p. Por ejemplo,

-- λ> diagonalesPrincipales ej1

-- [[2,2,2,2],[5,5,5],[1,1],[6],[2,2,2,2],[4,4,4],[7,7],[9]]

-- λ> diagonalesPrincipales ej2

-- [[2,2,2,2],[5,6,5],[1,1],[6],[2,2,2,2],[4,4,4],[7,7],[9]]

diagonalesPrincipales :: Array (Int,Int) a -> [[a]]

diagonalesPrincipales p =

[[p ! i |i <- is] | is <- posicionesDiagonalesPrincipales m n]

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

-- (posicionesDiagonalesPrincipales m n) es la lista de las

-- posiciones de las diagonales principales de una matriz con m filas y

-- n columnas. Por ejemplo,

-- λ> mapM_ print (posicionesDiagonalesPrincipales 3 4)

-- [(3,1)]

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

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

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

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

-- [(1,4)]

-- λ> mapM_ print (posicionesDiagonalesPrincipales 4 4)

-- [(4,1)]

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

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

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

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

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

-- [(1,4)]

-- λ> mapM_ print (posicionesDiagonalesPrincipales 4 3)

-- [(4,1)]

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

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

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

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

-- [(1,3)]

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

posicionesDiagonalesPrincipales m n =

[zip [i..m] [1..n] | i <- [m,m-1..1]] ++

[zip [1..m] [j..n] | j <- [2..n]]

-- (todosIguales xs) se verifica si todos los elementos de xs son

-- iguales. Por ejemplo,

-- todosIguales [5,5,5] == True

-- todosIguales [5,4,5] == False

todosIguales :: Eq a => [a] -> Bool

todosIguales [] = True

todosIguales (x:xs) = all (== x) xs

-- 2ª solución

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

esToeplitz2 :: Eq a => Array (Int,Int) a -> Bool

esToeplitz2 p = m == n &&

and [p!(i,j) == p!(i+1,j+1) |

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

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

-- Comparación de eficiencia

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

-- La comparación es

-- λ> esToeplitz1 (listArray ((1,1),(2*10^3,2*10^3)) (repeat 1))

-- True

-- (2.26 secs, 2,211,553,888 bytes)

-- λ> esToeplitz2 (listArray ((1,1),(2*10^3,2*10^3)) (repeat 1))

-- True

-- (4.26 secs, 3,421,651,032 bytes)

El código se encuentra en GitHub.

Diagonales principales de una matriz

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

La lista de las diagonales principales de la matriz

   1  2  3  4
   5  6  7  8
   9 10 11 12

1 2 3 4

5 6 7 8

9 10 11 12

   [[9],[5,10],[1,6,11],[2,7,12],[3,8],[4]]

1	[[9],[5,10],[1,6,11],[2,7,12],[3,8],[4]]

Definir la función

   diagonalesPrincipales :: Array (Int,Int) a -> [[a]]

1	diagonalesPrincipales :: Array (Int,Int) a -> [[a]]

tal que (diagonalesPrincipales p) es la lista de las diagonales principales de p. Por ejemplo,

   λ> diagonalesPrincipales (listArray ((1,1),(3,4)) [1..12])
   [[9],[5,10],[1,6,11],[2,7,12],[3,8],[4]]

1 2	λ> diagonalesPrincipales (listArray ((1,1),(3,4)) [1..12]) [[9],[5,10],[1,6,11],[2,7,12],[3,8],[4]]

Soluciones

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

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

diagonalesPrincipales1 :: Array (Int,Int) a -> [[a]]
diagonalesPrincipales1 p =
  [[p ! ij | ij <- ijs] | ijs <- posicionesDiagonalesPrincipales1 m n]
  where (_,(m,n)) = bounds p

posicionesDiagonalesPrincipales1 :: Int -> Int -> [[(Int, Int)]]
posicionesDiagonalesPrincipales1 m n =
  [extension ij | ij <- iniciales]
  where iniciales = [(i,1) | i <- [m,m-1..2]] ++ [(1,j) | j <- [1..n]]
        extension (i,j) = [(i+k,j+k) | k <- [0..min (m-i) (n-j)]]

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

diagonalesPrincipales2 :: Array (Int,Int) a -> [[a]]
diagonalesPrincipales2 p =
  [[p ! ij | ij <- ijs] | ijs <- posicionesDiagonalesPrincipales2 m n]
  where (_,(m,n)) = bounds p

posicionesDiagonalesPrincipales2 :: Int -> Int -> [[(Int, Int)]]
posicionesDiagonalesPrincipales2 m n =
  [zip [i..m] [1..n] | i <- [m,m-1..1]] ++
  [zip [1..m] [j..n] | j <- [2..n]]

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

-- La propiedad es
prop_diagonalesPrincipales :: Positive Int -> Positive Int -> Bool
prop_diagonalesPrincipales (Positive m) (Positive n) =
  diagonalesPrincipales1 p == diagonalesPrincipales2 p
  where p = listArray ((1,1),(m,n)) [1..]

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

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

-- La comparación es
--    λ> length (diagonalesPrincipales1 (listArray ((1,1),(10^4,10^4)) [1..]))
--    19999
--    (6.90 secs, 8,010,369,224 bytes)
--    λ> length (diagonalesPrincipales2 (listArray ((1,1),(10^4,10^4)) [1..]))
--    19999
--    (6.78 secs, 8,008,289,224 bytes)

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

import Test.QuickCheck

-- 1ª solución

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

diagonalesPrincipales1 :: Array (Int,Int) a -> [[a]]

diagonalesPrincipales1 p =

[[p ! ij | ij <- ijs] | ijs <- posicionesDiagonalesPrincipales1 m n]

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

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

posicionesDiagonalesPrincipales1 m n =

[extension ij | ij <- iniciales]

where iniciales = [(i,1) | i <- [m,m-1..2]] ++ [(1,j) | j <- [1..n]]

extension (i,j) = [(i+k,j+k) | k <- [0..min (m-i) (n-j)]]

-- 2ª solución

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

diagonalesPrincipales2 :: Array (Int,Int) a -> [[a]]

diagonalesPrincipales2 p =

[[p ! ij | ij <- ijs] | ijs <- posicionesDiagonalesPrincipales2 m n]

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

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

posicionesDiagonalesPrincipales2 m n =

[zip [i..m] [1..n] | i <- [m,m-1..1]] ++

[zip [1..m] [j..n] | j <- [2..n]]

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_diagonalesPrincipales :: Positive Int -> Positive Int -> Bool

prop_diagonalesPrincipales (Positive m) (Positive n) =

diagonalesPrincipales1 p == diagonalesPrincipales2 p

where p = listArray ((1,1),(m,n)) [1..]

-- La comprobación es

-- λ> quickCheck prop_diagonalesPrincipales

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (diagonalesPrincipales1 (listArray ((1,1),(10^4,10^4)) [1..]))

-- 19999

-- (6.90 secs, 8,010,369,224 bytes)

-- λ> length (diagonalesPrincipales2 (listArray ((1,1),(10^4,10^4)) [1..]))

-- 19999

-- (6.78 secs, 8,008,289,224 bytes)

El código se encuentra en GitHub

Posiciones de las diagonales principales

PorJosé A. Alonso 4-marzo-202215-abril-2022

Las posiciones de una matriz con 3 filas y 4 columnas son

   (1,1) (1,2) (1,3) (1,4)
   (2,1) (2,2) (2,3) (2,4)
   (3,1) (3,2) (3,3) (3,4)

(1,1) (1,2) (1,3) (1,4)

(2,1) (2,2) (2,3) (2,4)

(3,1) (3,2) (3,3) (3,4)

La posiciones de sus 6 diagonales principales son

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

[(3,1)]

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

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

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

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

[(1,4)]

Definir la función

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

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

tal que (posicionesdiagonalesprincipales m n) es la lista de las posiciones de las diagonales principales de una matriz con m filas y n columnas. Por ejemplo,

  λ> mapM_ print (posicionesDiagonalesPrincipales 3 4)
  [(3,1)]
  [(2,1),(3,2)]
  [(1,1),(2,2),(3,3)]
  [(1,2),(2,3),(3,4)]
  [(1,3),(2,4)]
  [(1,4)]
  λ> mapM_ print (posicionesDiagonalesPrincipales 4 4)
  [(4,1)]
  [(3,1),(4,2)]
  [(2,1),(3,2),(4,3)]
  [(1,1),(2,2),(3,3),(4,4)]
  [(1,2),(2,3),(3,4)]
  [(1,3),(2,4)]
  [(1,4)]
  λ> mapM_ print (posicionesDiagonalesPrincipales 4 3)
  [(4,1)]
  [(3,1),(4,2)]
  [(2,1),(3,2),(4,3)]
  [(1,1),(2,2),(3,3)]
  [(1,2),(2,3)]
  [(1,3)]

λ> mapM_ print (posicionesDiagonalesPrincipales 3 4)

[(3,1)]

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

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

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

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

[(1,4)]

λ> mapM_ print (posicionesDiagonalesPrincipales 4 4)

[(4,1)]

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

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

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

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

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

[(1,4)]

λ> mapM_ print (posicionesDiagonalesPrincipales 4 3)

[(4,1)]

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

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

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

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

[(1,3)]

Soluciones

import Test.QuickCheck

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

posicionesDiagonalesPrincipales1 :: Int -> Int -> [[(Int, Int)]]
posicionesDiagonalesPrincipales1 m n =
  [extension ij | ij <- iniciales]
  where iniciales = [(i,1) | i <- [m,m-1..2]] ++ [(1,j) | j <- [1..n]]
        extension (i,j) = [(i+k,j+k) | k <- [0..min (m-i) (n-j)]]

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

posicionesDiagonalesPrincipales2 :: Int -> Int -> [[(Int, Int)]]
posicionesDiagonalesPrincipales2 m n =
  [zip [i..m] [1..n] | i <- [m,m-1..1]] ++
  [zip [1..m] [j..n] | j <- [2..n]]

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

-- La propiedad es
prop_posicionesDiagonalesPrincipales :: Positive Int -> Positive Int -> Bool
prop_posicionesDiagonalesPrincipales (Positive m) (Positive n) =
  posicionesDiagonalesPrincipales1 m n ==
  posicionesDiagonalesPrincipales2 m n

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

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

-- La comparación es
--   λ> length (posicionesDiagonalesPrincipales1 (10^7) (10^6))
--   10999999
--   (6.14 secs, 3,984,469,440 bytes)
--   λ> length (posicionesDiagonalesPrincipales2 (10^7) (10^6))
--   10999999
--   (3.07 secs, 2,840,469,440 bytes)

import Test.QuickCheck

-- 1ª solución

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

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

posicionesDiagonalesPrincipales1 m n =

[extension ij | ij <- iniciales]

where iniciales = [(i,1) | i <- [m,m-1..2]] ++ [(1,j) | j <- [1..n]]

extension (i,j) = [(i+k,j+k) | k <- [0..min (m-i) (n-j)]]

-- 2ª solución

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

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

posicionesDiagonalesPrincipales2 m n =

[zip [i..m] [1..n] | i <- [m,m-1..1]] ++

[zip [1..m] [j..n] | j <- [2..n]]

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_posicionesDiagonalesPrincipales :: Positive Int -> Positive Int -> Bool

prop_posicionesDiagonalesPrincipales (Positive m) (Positive n) =

posicionesDiagonalesPrincipales1 m n ==

posicionesDiagonalesPrincipales2 m n

-- La comprobación es

-- λ> quickCheck prop_posicionesDiagonalesPrincipales

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (posicionesDiagonalesPrincipales1 (10^7) (10^6))

-- 10999999

-- (6.14 secs, 3,984,469,440 bytes)

-- λ> length (posicionesDiagonalesPrincipales2 (10^7) (10^6))

-- 10999999

-- (3.07 secs, 2,840,469,440 bytes)

El código se encuentra en GitHub

Suma si todos los valores son justos

PorJosé A. Alonso 3-marzo-202210-marzo-2022

Definir la función

   sumaSiTodosJustos :: (Num a, Eq a) => [Maybe a] -> Maybe a

1	sumaSiTodosJustos :: (Num a, Eq a) => [Maybe a] -> Maybe a

tal que (sumaSiTodosJustos xs) es justo la suma de todos los elementos de xs si todos son justos (es decir, si Nothing no pertenece a xs) y Nothing en caso contrario. Por ejemplo,

   sumaSiTodosJustos [Just 2, Just 5]           == Just 7
   sumaSiTodosJustos [Just 2, Just 5, Nothing]  == Nothing

1 2	sumaSiTodosJustos [Just 2, Just 5] == Just 7 sumaSiTodosJustos [Just 2, Just 5, Nothing] == Nothing

Soluciones

import Data.Maybe (catMaybes, isJust, fromJust)
import Test.QuickCheck (quickCheck)

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

sumaSiTodosJustos1 :: (Num a, Eq a) => [Maybe a] -> Maybe a
sumaSiTodosJustos1 xs
  | todosJustos xs = Just (sum [x | (Just x) <- xs])
  | otherwise      = Nothing

-- (todosJustos xs) se verifica si todos los elementos de xs son justos
-- (es decir, si Nothing no pertenece a xs) y Nothing en caso
-- contrario. Por ejemplo,
--    todosJustos [Just 2, Just 5]           == True
--    todosJustos [Just 2, Just 5, Nothing]  == False

-- 1ª definición de todosJustos:
todosJustos1 :: Eq a => [Maybe a] -> Bool
todosJustos1 = notElem Nothing

-- 2ª definición de todosJustos:
todosJustos :: Eq a => [Maybe a] -> Bool
todosJustos = all isJust

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

sumaSiTodosJustos2 :: (Num a, Eq a) => [Maybe a] -> Maybe a
sumaSiTodosJustos2 xs
  | todosJustos xs = Just (sum [fromJust x | x <- xs])
  | otherwise      = Nothing

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

sumaSiTodosJustos3 :: (Num a, Eq a) => [Maybe a] -> Maybe a
sumaSiTodosJustos3 xs
  | todosJustos xs = Just (sum (map fromJust xs))
  | otherwise      = Nothing

-- 4ª solución

sumaSiTodosJustos4 :: (Num a, Eq a) => [Maybe a] -> Maybe a
sumaSiTodosJustos4 xs
  | todosJustos xs = Just (sum (catMaybes xs))
  | otherwise      = Nothing

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

sumaSiTodosJustos5 :: (Num a, Eq a) => [Maybe a] -> Maybe a
sumaSiTodosJustos5 xs = suma (sequence xs)
  where suma Nothing   = Nothing
        suma (Just ys) = Just (sum ys)

-- Nota. En la solución anterior se usa la función
--    sequence :: Monad m => [m a] -> m [a]
-- tal que (sequence xs) es la mónada obtenida evaluando cada una de las
-- de xs de izquierda a derecha. Por ejemplo,
--    sequence [Just 2, Just 5]   ==  Just [2,5]
--    sequence [Just 2, Nothing]  ==  Nothing
--    sequence [[2,4],[5,7]]      ==  [[2,5],[2,7],[4,5],[4,7]]
--    sequence [[2,4],[5,7],[6]]  ==  [[2,5,6],[2,7,6],[4,5,6],[4,7,6]]
--    sequence [[2,4],[5,7],[]]   ==  []

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

sumaSiTodosJustos6 :: (Num a, Eq a) => [Maybe a] -> Maybe a
sumaSiTodosJustos6 xs = fmap sum (sequence xs)

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

sumaSiTodosJustos7 :: (Num a, Eq a) => [Maybe a] -> Maybe a
sumaSiTodosJustos7 = fmap sum . sequence

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

-- La propiedad es
prop_sumaSiTodosJustos :: [Maybe Integer] -> Bool
prop_sumaSiTodosJustos xs =
  all (== sumaSiTodosJustos1 xs)
      [sumaSiTodosJustos2 xs,
       sumaSiTodosJustos3 xs,
       sumaSiTodosJustos4 xs,
       sumaSiTodosJustos5 xs,
       sumaSiTodosJustos6 xs,
       sumaSiTodosJustos7 xs]

verifica_sumaSiTodosJustos :: IO ()
verifica_sumaSiTodosJustos =
  quickCheck prop_sumaSiTodosJustos

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

import Data.Maybe (catMaybes, isJust, fromJust)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

sumaSiTodosJustos1 :: (Num a, Eq a) => [Maybe a] -> Maybe a

sumaSiTodosJustos1 xs

| todosJustos xs = Just (sum [x | (Just x) <- xs])

| otherwise = Nothing

-- (todosJustos xs) se verifica si todos los elementos de xs son justos

-- (es decir, si Nothing no pertenece a xs) y Nothing en caso

-- contrario. Por ejemplo,

-- todosJustos [Just 2, Just 5] == True

-- todosJustos [Just 2, Just 5, Nothing] == False

-- 1ª definición de todosJustos:

todosJustos1 :: Eq a => [Maybe a] -> Bool

todosJustos1 = notElem Nothing

-- 2ª definición de todosJustos:

todosJustos :: Eq a => [Maybe a] -> Bool

todosJustos = all isJust

-- 2ª solución

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

sumaSiTodosJustos2 :: (Num a, Eq a) => [Maybe a] -> Maybe a

sumaSiTodosJustos2 xs

| todosJustos xs = Just (sum [fromJust x | x <- xs])

| otherwise = Nothing

-- 3ª solución

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

sumaSiTodosJustos3 :: (Num a, Eq a) => [Maybe a] -> Maybe a

sumaSiTodosJustos3 xs

| todosJustos xs = Just (sum (map fromJust xs))

| otherwise = Nothing

-- 4ª solución

sumaSiTodosJustos4 :: (Num a, Eq a) => [Maybe a] -> Maybe a

sumaSiTodosJustos4 xs

| todosJustos xs = Just (sum (catMaybes xs))

| otherwise = Nothing

-- 5ª solución

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

sumaSiTodosJustos5 :: (Num a, Eq a) => [Maybe a] -> Maybe a

sumaSiTodosJustos5 xs = suma (sequence xs)

where suma Nothing = Nothing

suma (Just ys) = Just (sum ys)

-- Nota. En la solución anterior se usa la función

-- sequence :: Monad m => [m a] -> m [a]

-- tal que (sequence xs) es la mónada obtenida evaluando cada una de las

-- de xs de izquierda a derecha. Por ejemplo,

-- sequence [Just 2, Just 5] == Just [2,5]

-- sequence [Just 2, Nothing] == Nothing

-- sequence [[2,4],[5,7]] == [[2,5],[2,7],[4,5],[4,7]]

-- sequence [[2,4],[5,7],[6]] == [[2,5,6],[2,7,6],[4,5,6],[4,7,6]]

-- sequence [[2,4],[5,7],[]] == []

-- 6ª solución

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

sumaSiTodosJustos6 :: (Num a, Eq a) => [Maybe a] -> Maybe a

sumaSiTodosJustos6 xs = fmap sum (sequence xs)

-- 7ª solución

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

sumaSiTodosJustos7 :: (Num a, Eq a) => [Maybe a] -> Maybe a

sumaSiTodosJustos7 = fmap sum . sequence

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_sumaSiTodosJustos :: [Maybe Integer] -> Bool

prop_sumaSiTodosJustos xs =

all (== sumaSiTodosJustos1 xs)

[sumaSiTodosJustos2 xs,

sumaSiTodosJustos3 xs,

sumaSiTodosJustos4 xs,

sumaSiTodosJustos5 xs,

sumaSiTodosJustos6 xs,

sumaSiTodosJustos7 xs]

verifica_sumaSiTodosJustos :: IO ()

verifica_sumaSiTodosJustos =

quickCheck prop_sumaSiTodosJustos

-- La comprobación es

-- λ> verifica_sumaSiTodosJustos

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

Primos equidistantes

PorJosé A. Alonso 2-marzo-202215-abril-2022

Definir la función

   primosEquidistantes :: Integer -> [(Integer,Integer)]

1	primosEquidistantes :: Integer -> [(Integer,Integer)]

tal que (primosEquidistantes k) es la lista de los pares de primos cuya diferencia es k. Por ejemplo,

   take 3 (primosEquidistantes 2)  ==  [(3,5),(5,7),(11,13)]
   take 3 (primosEquidistantes 4)  ==  [(7,11),(13,17),(19,23)]
   take 3 (primosEquidistantes 6)  ==  [(23,29),(31,37),(47,53)]
   take 3 (primosEquidistantes 8)  ==  [(89,97),(359,367),(389,397)]
   primosEquidistantes 4 !! (10^5) ==  (18467047,18467051)

take 3 (primosEquidistantes 2) == [(3,5),(5,7),(11,13)]

take 3 (primosEquidistantes 4) == [(7,11),(13,17),(19,23)]

take 3 (primosEquidistantes 6) == [(23,29),(31,37),(47,53)]

take 3 (primosEquidistantes 8) == [(89,97),(359,367),(389,397)]

primosEquidistantes 4 !! (10^5) == (18467047,18467051)

Soluciones

import Data.Numbers.Primes (primes)

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

primosEquidistantes1 :: Integer -> [(Integer,Integer)]
primosEquidistantes1 k = aux primos
  where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)
                     | otherwise  = aux (y:ps)

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

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

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

primosEquidistantes2 :: Integer -> [(Integer,Integer)]
primosEquidistantes2 k = aux primos2
  where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)
                     | otherwise  = aux (y:ps)

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

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

primosEquidistantes3 :: Integer -> [(Integer,Integer)]
primosEquidistantes3 k =
  [(x,y) | (x,y) <- zip primos2 (tail primos2)
         , y - x == k]

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

primosEquidistantes4 :: Integer -> [(Integer,Integer)]
primosEquidistantes4 k = aux primes
  where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)
                     | otherwise  = aux (y:ps)

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

primosEquidistantes5 :: Integer -> [(Integer,Integer)]
primosEquidistantes5 k =
  [(x,y) | (x,y) <- zip primes (tail primes)
         , y - x == k]

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

-- La propiedad es
prop_primosEquidistantes :: Int -> Integer -> Bool
prop_primosEquidistantes n k =
  all (== take n (primosEquidistantes1 k))
      [take n (f k) | f <- [primosEquidistantes2,
                            primosEquidistantes3,
                            primosEquidistantes4,
                            primosEquidistantes5]]

-- La comprobación es
--    λ> prop_primosEquidistantes 100 4
--    True

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

-- La comparación es
--    λ> primosEquidistantes1 4 !! 200
--    (9829,9833)
--    (2.60 secs, 1,126,458,272 bytes)
--    λ> primosEquidistantes2 4 !! 200
--    (9829,9833)
--    (0.44 secs, 249,622,048 bytes)
--    λ> primosEquidistantes3 4 !! 200
--    (9829,9833)
--    (0.36 secs, 207,549,592 bytes)
--    λ> primosEquidistantes4 4 !! 200
--    (9829,9833)
--    (0.02 secs, 4,012,848 bytes)
--    λ> primosEquidistantes5 4 !! 200
--    (9829,9833)
--    (0.01 secs, 7,085,072 bytes)
--
--    λ> primosEquidistantes2 4 !! 600
--    (41617,41621)
--    (5.67 secs, 3,340,313,480 bytes)
--    λ> primosEquidistantes3 4 !! 600
--    (41617,41621)
--    (5.43 secs, 3,090,994,096 bytes)
--    λ> primosEquidistantes4 4 !! 600
--    (41617,41621)
--    (0.03 secs, 15,465,824 bytes)
--    λ> primosEquidistantes5 4 !! 600
--    (41617,41621)
--    (0.04 secs, 28,858,232 bytes)
--
--    λ> primosEquidistantes4 4 !! (10^5)
--    (18467047,18467051)
--    (3.99 secs, 9,565,715,488 bytes)
--    λ> primosEquidistantes5 4 !! (10^5)
--    (18467047,18467051)
--    (7.95 secs, 18,712,469,144 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

import Data.Numbers.Primes (primes)

-- 1ª solución

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

primosEquidistantes1 :: Integer -> [(Integer,Integer)]

primosEquidistantes1 k = aux primos

where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)

| otherwise = aux (y:ps)

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

-- primo 7 == True

-- primo 8 == False

primo :: Integer -> Bool

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

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

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

primos :: [Integer]

primos = 2 : [x | x <- [3,5..], primo x]

-- 2ª solución

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

primosEquidistantes2 :: Integer -> [(Integer,Integer)]

primosEquidistantes2 k = aux primos2

where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)

| otherwise = aux (y:ps)

primos2 :: [Integer]

primos2 = criba [2..]

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

-- 3ª solución

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

primosEquidistantes3 :: Integer -> [(Integer,Integer)]

primosEquidistantes3 k =

[(x,y) | (x,y) <- zip primos2 (tail primos2)

, y - x == k]

-- 4ª solución

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

primosEquidistantes4 :: Integer -> [(Integer,Integer)]

primosEquidistantes4 k = aux primes

where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)

| otherwise = aux (y:ps)

-- 5ª solución

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

primosEquidistantes5 :: Integer -> [(Integer,Integer)]

primosEquidistantes5 k =

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

, y - x == k]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_primosEquidistantes :: Int -> Integer -> Bool

prop_primosEquidistantes n k =

all (== take n (primosEquidistantes1 k))

[take n (f k) | f <- [primosEquidistantes2,

primosEquidistantes3,

primosEquidistantes4,

primosEquidistantes5]]

-- La comprobación es

-- λ> prop_primosEquidistantes 100 4

-- True

-- Comparación de eficiencia

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

-- La comparación es

-- λ> primosEquidistantes1 4 !! 200

-- (9829,9833)

-- (2.60 secs, 1,126,458,272 bytes)

-- λ> primosEquidistantes2 4 !! 200

-- (9829,9833)

-- (0.44 secs, 249,622,048 bytes)

-- λ> primosEquidistantes3 4 !! 200

-- (9829,9833)

-- (0.36 secs, 207,549,592 bytes)

-- λ> primosEquidistantes4 4 !! 200

-- (9829,9833)

-- (0.02 secs, 4,012,848 bytes)

-- λ> primosEquidistantes5 4 !! 200

-- (9829,9833)

-- (0.01 secs, 7,085,072 bytes)

-- λ> primosEquidistantes2 4 !! 600

-- (41617,41621)

-- (5.67 secs, 3,340,313,480 bytes)

-- λ> primosEquidistantes3 4 !! 600

-- (41617,41621)

-- (5.43 secs, 3,090,994,096 bytes)

-- λ> primosEquidistantes4 4 !! 600

-- (41617,41621)

-- (0.03 secs, 15,465,824 bytes)

-- λ> primosEquidistantes5 4 !! 600

-- (41617,41621)

-- (0.04 secs, 28,858,232 bytes)

-- λ> primosEquidistantes4 4 !! (10^5)

-- (18467047,18467051)

-- (3.99 secs, 9,565,715,488 bytes)

-- λ> primosEquidistantes5 4 !! (10^5)

-- (18467047,18467051)

-- (7.95 secs, 18,712,469,144 bytes)

El código se encuentra en GitHub.

Anagramas

PorJosé A. Alonso 1-marzo-20228-marzo-2022

Una palabra es una anagrama de otra si se puede obtener permutando sus letras. Por ejemplo, «mora» y «roma» son anagramas de «amor».

Definir la función

   anagramas :: String -> [String] -> [String]

1	anagramas :: String -> [String] -> [String]

tal que (anagramas x ys) es la lista de los elementos de ys que son anagramas de x. Por ejemplo,

   λ> anagramas "amor" ["Roma","mola","loma","moRa", "rama"]
   ["Roma","moRa"]
   λ> anagramas "rama" ["aMar","amaRa","roMa","marr","aRma"]
   ["aMar","aRma"]

λ> anagramas "amor" ["Roma","mola","loma","moRa", "rama"]

["Roma","moRa"]

λ> anagramas "rama" ["aMar","amaRa","roMa","marr","aRma"]

["aMar","aRma"]

Soluciones

import Data.List (delete, permutations, sort)
import Data.Char (toLower)
import Data.Function (on)

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

anagramas :: String -> [String] -> [String]
anagramas _ [] = []
anagramas x (y:ys)
  | sonAnagramas x y = y : anagramas x ys
  | otherwise        = anagramas x ys

-- (sonAnagramas xs ys) se verifica si xs e ys son anagramas. Por
-- ejemplo,
--    sonAnagramas "amor" "Roma"  ==  True
--    sonAnagramas "amor" "mola"  ==  False
sonAnagramas :: String -> String -> Bool
sonAnagramas xs ys =
  sort (map toLower xs) == sort (map toLower ys)

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

anagramas2 :: String -> [String] -> [String]
anagramas2 _ [] = []
anagramas2 x (y:ys)
  | sonAnagramas2 x y = y : anagramas2 x ys
  | otherwise         = anagramas2 x ys

sonAnagramas2 :: String -> String -> Bool
sonAnagramas2 xs ys =
  (sort . map toLower) xs == (sort . map toLower) ys

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

anagramas3 :: String -> [String] -> [String]
anagramas3 _ [] = []
anagramas3 x (y:ys)
  | sonAnagramas3 x y = y : anagramas3 x ys
  | otherwise         = anagramas3 x ys

sonAnagramas3 :: String -> String -> Bool
sonAnagramas3 = (==) `on` (sort . map toLower)

-- Nota. En la solución anterior se usa la función on ya que
--    (f `on` g) x y
-- es equivalente a
--    f (g x) (g y)
-- Por ejemplo,
--    λ> ((*) `on` (+2)) 3 4
--    30

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

anagramas4 :: String -> [String] -> [String]
anagramas4 x ys = [y | y <- ys, sonAnagramas x y]

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

anagramas5 :: String -> [String] -> [String]
anagramas5 x = filter (`sonAnagramas` x)

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

anagramas6 :: String -> [String] -> [String]
anagramas6 x = filter (((==) `on` (sort . map toLower)) x)

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

anagramas7 :: String -> [String] -> [String]
anagramas7 _ [] = []
anagramas7 x (y:ys)
  | sonAnagramas7 x y = y : anagramas7 x ys
  | otherwise         = anagramas7 x ys

sonAnagramas7 :: String -> String -> Bool
sonAnagramas7 xs ys = aux (map toLower xs) (map toLower ys)
  where
    aux [] [] = True
    aux [] _  = False
    aux (u:us) vs | u `notElem` vs = False
                  | otherwise      = aux us (delete u vs)

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

-- La comparación es
--    λ> ej = take (10^6) (permutations "1234567890")
--    λ> length (anagramas "1234567890" ej)
--    1000000
--    (2.27 secs, 5,627,236,104 bytes)
--    λ> length (anagramas2 "1234567890" ej)
--    1000000
--    (2.80 secs, 5,513,260,584 bytes)
--    λ> length (anagramas3 "1234567890" ej)
--    1000000
--    (1.86 secs, 5,097,260,856 bytes)
--    λ> length (anagramas4 "1234567890" ej)
--    1000000
--    (2.25 secs, 5,073,260,632 bytes)
--    λ> length (anagramas5 "1234567890" ej)
--    1000000
--    (2.14 secs, 5,009,260,616 bytes)
--    λ> length (anagramas6 "1234567890" ej)
--    1000000
--    (1.58 secs, 4,977,260,976 bytes)
--    λ> length (anagramas7 "1234567890" ej)
--    1000000
--    (6.63 secs, 6,904,821,648 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List (delete, permutations, sort)

import Data.Char (toLower)

import Data.Function (on)

-- 1ª solución

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

anagramas :: String -> [String] -> [String]

anagramas _ [] = []

anagramas x (y:ys)

| sonAnagramas x y = y : anagramas x ys

| otherwise = anagramas x ys

-- (sonAnagramas xs ys) se verifica si xs e ys son anagramas. Por

-- ejemplo,

-- sonAnagramas "amor" "Roma" == True

-- sonAnagramas "amor" "mola" == False

sonAnagramas :: String -> String -> Bool

sonAnagramas xs ys =

sort (map toLower xs) == sort (map toLower ys)

-- 2ª solución

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

anagramas2 :: String -> [String] -> [String]

anagramas2 _ [] = []

anagramas2 x (y:ys)

| sonAnagramas2 x y = y : anagramas2 x ys

| otherwise = anagramas2 x ys

sonAnagramas2 :: String -> String -> Bool

sonAnagramas2 xs ys =

(sort . map toLower) xs == (sort . map toLower) ys

-- 3ª solución

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

anagramas3 :: String -> [String] -> [String]

anagramas3 _ [] = []

anagramas3 x (y:ys)

| sonAnagramas3 x y = y : anagramas3 x ys

| otherwise = anagramas3 x ys

sonAnagramas3 :: String -> String -> Bool

sonAnagramas3 = (==) `on` (sort . map toLower)

-- Nota. En la solución anterior se usa la función on ya que

-- (f `on` g) x y

-- es equivalente a

-- f (g x) (g y)

-- Por ejemplo,

-- λ> ((*) `on` (+2)) 3 4

-- 30

-- 4ª solución

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

anagramas4 :: String -> [String] -> [String]

anagramas4 x ys = [y | y <- ys, sonAnagramas x y]

-- 5ª solución

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

anagramas5 :: String -> [String] -> [String]

anagramas5 x = filter (`sonAnagramas` x)

-- 6ª solución

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

anagramas6 :: String -> [String] -> [String]

anagramas6 x = filter (((==) `on` (sort . map toLower)) x)

-- 7ª solución

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

anagramas7 :: String -> [String] -> [String]

anagramas7 _ [] = []

anagramas7 x (y:ys)

| sonAnagramas7 x y = y : anagramas7 x ys

| otherwise = anagramas7 x ys

sonAnagramas7 :: String -> String -> Bool

sonAnagramas7 xs ys = aux (map toLower xs) (map toLower ys)

where

aux [] [] = True

aux [] _ = False

aux (u:us) vs | u `notElem` vs = False

| otherwise = aux us (delete u vs)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> ej = take (10^6) (permutations "1234567890")

-- λ> length (anagramas "1234567890" ej)

-- 1000000

-- (2.27 secs, 5,627,236,104 bytes)

-- λ> length (anagramas2 "1234567890" ej)

-- 1000000

-- (2.80 secs, 5,513,260,584 bytes)

-- λ> length (anagramas3 "1234567890" ej)

-- 1000000

-- (1.86 secs, 5,097,260,856 bytes)

-- λ> length (anagramas4 "1234567890" ej)

-- 1000000

-- (2.25 secs, 5,073,260,632 bytes)

-- λ> length (anagramas5 "1234567890" ej)

-- 1000000

-- (2.14 secs, 5,009,260,616 bytes)

-- λ> length (anagramas6 "1234567890" ej)

-- 1000000

-- (1.58 secs, 4,977,260,976 bytes)

-- λ> length (anagramas7 "1234567890" ej)

-- 1000000

-- (6.63 secs, 6,904,821,648 bytes)

El código se encuentra en GitHub.

La bandera tricolor

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

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

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

   banderaTricolor :: [Color] -> [Color]

1	banderaTricolor :: [Color] -> [Color]

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

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

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

Soluciones

import Data.List (sort)
import Test.QuickCheck (Arbitrary(arbitrary), elements, quickCheck)

data Color = R | A | M
  deriving (Show, Eq, Ord, Enum)

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

banderaTricolor1 :: [Color] -> [Color]
banderaTricolor1 xs =
  [x | x <- xs, x == R] ++
  [x | x <- xs, x == A] ++
  [x | x <- xs, x == M]

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

banderaTricolor2 :: [Color] -> [Color]
banderaTricolor2 xs =
  colores R ++ colores A ++ colores M
  where colores c = filter (== c) xs

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

banderaTricolor3 :: [Color] -> [Color]
banderaTricolor3 xs =
  concat [[x | x <- xs, x == c] | c <- [R,A,M]]

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

banderaTricolor4 :: [Color] -> [Color]
banderaTricolor4 xs = aux xs ([],[],[])
  where aux []     (rs,as,ms) = rs ++ as ++ ms
        aux (R:ys) (rs,as,ms) = aux ys (R:rs,   as,   ms)
        aux (A:ys) (rs,as,ms) = aux ys (  rs, A:as,   ms)
        aux (M:ys) (rs,as,ms) = aux ys (  rs,   as, M:ms)

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

banderaTricolor5 :: [Color] -> [Color]
banderaTricolor5 = sort

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

instance Arbitrary Color where
  arbitrary = elements [A,R,M]

-- La propiedad es
prop_banderaTricolor :: [Color] -> Bool
prop_banderaTricolor xs =
  all (== banderaTricolor1 xs)
      [banderaTricolor2 xs,
       banderaTricolor3 xs,
       banderaTricolor4 xs,
       banderaTricolor5 xs]

verifica_banderaTricolor :: IO ()
verifica_banderaTricolor =
  quickCheck prop_banderaTricolor

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

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

-- La comparación es
--    λ> bandera n = concat [replicate n c | c <- [M,R,A]]
--    λ> length (banderaTricolor1 (bandera (10^6)))
--    3000000
--    (1.51 secs, 1,024,454,768 bytes)
--    λ> length (banderaTricolor1 (bandera (2*10^6)))
--    6000000
--    (2.94 secs, 2,048,454,832 bytes)
--    λ> length (banderaTricolor2 (bandera (2*10^6)))
--    6000000
--    (2.35 secs, 1,232,454,920 bytes)
--    λ> length (banderaTricolor3 (bandera (2*10^6)))
--    6000000
--    (4.28 secs, 2,304,455,360 bytes)
--    λ> length (banderaTricolor4 (bandera (2*10^6)))
--    6000000
--    (3.01 secs, 1,904,454,672 bytes)
--    λ> length (banderaTricolor5 (bandera (2*10^6)))
--    6000000
--    (2.47 secs, 1,248,454,744 bytes)

import Data.List (sort)

import Test.QuickCheck (Arbitrary(arbitrary), elements, quickCheck)

data Color = R | A | M

deriving (Show, Eq, Ord, Enum)

-- 1ª solución

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

banderaTricolor1 :: [Color] -> [Color]

banderaTricolor1 xs =

[x | x <- xs, x == R] ++

[x | x <- xs, x == A] ++

[x | x <- xs, x == M]

-- 2ª solución

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

banderaTricolor2 :: [Color] -> [Color]

banderaTricolor2 xs =

colores R ++ colores A ++ colores M

where colores c = filter (== c) xs

-- 3ª solución

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

banderaTricolor3 :: [Color] -> [Color]

banderaTricolor3 xs =

concat [[x | x <- xs, x == c] | c <- [R,A,M]]

-- 4ª solución

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

banderaTricolor4 :: [Color] -> [Color]

banderaTricolor4 xs = aux xs ([],[],[])

where aux [] (rs,as,ms) = rs ++ as ++ ms

aux (R:ys) (rs,as,ms) = aux ys (R:rs, as, ms)

aux (A:ys) (rs,as,ms) = aux ys ( rs, A:as, ms)

aux (M:ys) (rs,as,ms) = aux ys ( rs, as, M:ms)

-- 5ª solución

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

banderaTricolor5 :: [Color] -> [Color]

banderaTricolor5 = sort

-- Comprobación de equivalencia

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

instance Arbitrary Color where

arbitrary = elements [A,R,M]

-- La propiedad es

prop_banderaTricolor :: [Color] -> Bool

prop_banderaTricolor xs =

all (== banderaTricolor1 xs)

[banderaTricolor2 xs,

banderaTricolor3 xs,

banderaTricolor4 xs,

banderaTricolor5 xs]

verifica_banderaTricolor :: IO ()

verifica_banderaTricolor =

quickCheck prop_banderaTricolor

-- La comprobación es

-- λ> verifica_banderaTricolor

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> bandera n = concat [replicate n c | c <- [M,R,A]]

-- λ> length (banderaTricolor1 (bandera (10^6)))

-- 3000000

-- (1.51 secs, 1,024,454,768 bytes)

-- λ> length (banderaTricolor1 (bandera (2*10^6)))

-- 6000000

-- (2.94 secs, 2,048,454,832 bytes)

-- λ> length (banderaTricolor2 (bandera (2*10^6)))

-- 6000000

-- (2.35 secs, 1,232,454,920 bytes)

-- λ> length (banderaTricolor3 (bandera (2*10^6)))

-- 6000000

-- (4.28 secs, 2,304,455,360 bytes)

-- λ> length (banderaTricolor4 (bandera (2*10^6)))

-- 6000000

-- (3.01 secs, 1,904,454,672 bytes)

-- λ> length (banderaTricolor5 (bandera (2*10^6)))

-- 6000000

-- (2.47 secs, 1,248,454,744 bytes)

El código se encuentra en GitHub.

Ordenación por el máximo

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

Definir la función

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

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

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

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

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

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

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

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

Soluciones

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

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

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

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

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

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

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

verifica_ordenadosPorMaximo :: IO ()
verifica_ordenadosPorMaximo =
  quickCheck prop_ordenadosPorMaximo

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

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

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

import Data.List (sort, sortBy)

import GHC.Exts (sortWith)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

ordenadosPorMaximo1 xss =

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

-- 2ª solución

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

ordenadosPorMaximo2 xss =

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

-- 3ª solución

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

ordenadosPorMaximo3 =

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

-- 4ª solución

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

ordenadosPorMaximo4 = sortWith maximum

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_ordenadosPorMaximo :: [[Int]] -> Bool

prop_ordenadosPorMaximo xss =

all (== ordenadosPorMaximo1 yss)

[ordenadosPorMaximo2 yss,

ordenadosPorMaximo3 yss,

ordenadosPorMaximo4 yss]

where yss = filter (not . null) xss

verifica_ordenadosPorMaximo :: IO ()

verifica_ordenadosPorMaximo =

quickCheck prop_ordenadosPorMaximo

-- La comprobación es

-- λ> verifica_ordenadosPorMaximo

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

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

-- 10000

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

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

-- 10000

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

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

-- 10000

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

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

-- 10000

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

El código se encuentra en GitHub.

Iguales al siguiente

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

Definir la función

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

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

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

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

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

Soluciones

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

verificacion :: IO ()
verificacion = quickCheck prop_igualesAlSiguiente

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

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

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

import Data.List (group)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

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

igualesAlSiguiente1 xs =

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

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

-- xs. Por ejemplo,

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

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

consecutivos1 xs = zip xs (tail xs)

-- 2ª solución

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

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

igualesAlSiguiente2 xs =

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

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

-- xs. Por ejemplo,

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

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

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

consecutivos2 _ = []

-- 3ª solución

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

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

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

| otherwise = igualesAlSiguiente3 (y:zs)

igualesAlSiguiente3 _ = []

-- 4ª solución

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

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

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

-- 5ª solución

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

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

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

-- 6ª solución

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

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

igualesAlSiguiente6 xs = tail =<< group xs

-- 7ª solución

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

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

igualesAlSiguiente7 = (tail =<<) . group

-- 8ª solución

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

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

igualesAlSiguiente8 xs = concatMap tail (group xs)

-- 9ª solución

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

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

igualesAlSiguiente9 = concatMap tail . group

-- 10ª solución

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

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

igualesAlSiguiente10 xs = aux xs (tail xs)

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

| otherwise = aux us vs

aux _ _ = []

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_igualesAlSiguiente :: [Int] -> Bool

prop_igualesAlSiguiente xs =

all (== igualesAlSiguiente1 xs)

[igualesAlSiguiente2 xs,

igualesAlSiguiente3 xs,

igualesAlSiguiente4 xs,

igualesAlSiguiente5 xs,

igualesAlSiguiente6 xs,

igualesAlSiguiente7 xs,

igualesAlSiguiente8 xs,

igualesAlSiguiente9 xs,

igualesAlSiguiente10 xs]

verificacion :: IO ()

verificacion = quickCheck prop_igualesAlSiguiente

-- La comprobación es

-- λ> verificacion

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

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

-- (0.01 secs, 446,752 bytes)

-- λ> length ej

-- 5888896

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

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

-- 588895

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

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

-- 588895

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

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

-- 588895

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

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

-- 588895

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

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

-- 588895

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

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

-- 588895

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

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

-- 588895

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

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

-- 588895

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

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

-- 588895

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

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

-- 588895

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

El código se encuentra en GitHub.

Primos consecutivos con media capicúa

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

Definir la lista

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

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

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

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

λ> take 5 primosConsecutivosConMediaCapicua

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

λ> primosConsecutivosConMediaCapicua !! 500

(5687863,5687867,5687865)

Soluciones

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List (genericTake)

import Data.Numbers.Primes (primes)

-- 1ª solución

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

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

primosConsecutivosConMediaCapicua =

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

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

capicua z]

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

-- primo 7 == True

-- primo 8 == False

primo :: Integer -> Bool

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

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

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

primosImpares :: [Integer]

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

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

capicua :: Integer -> Bool

capicua x = ys == reverse ys

where ys = show x

-- 2ª solución

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

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

primosConsecutivosConMediaCapicua2 =

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

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

capicua z]

primosImpares2 :: [Integer]

primosImpares2 = tail (criba [2..])

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

criba [] = error "Imposible"

-- 3ª solución

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

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

primosConsecutivosConMediaCapicua3 =

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

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

capicua z]

primos3 :: [Integer]

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

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

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

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

criba3 _ [] _ = error "Imposible"

-- 4ª solución

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

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

primosConsecutivosConMediaCapicua4 =

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

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

capicua z]

-- Equivalencia de definiciones

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

-- La propiedad es

prop_primosConsecutivosConMediaCapicua :: Integer -> Bool

prop_primosConsecutivosConMediaCapicua n =

all (== genericTake n primosConsecutivosConMediaCapicua)

[genericTake n primosConsecutivosConMediaCapicua2,

genericTake n primosConsecutivosConMediaCapicua3,

genericTake n primosConsecutivosConMediaCapicua4]

-- La comprobación es

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

-- True

-- Comparación de eficiencia

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

-- La comparación es

-- λ> primosConsecutivosConMediaCapicua !! 30

-- (12919,12923,12921)

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

-- λ> primosConsecutivosConMediaCapicua2 !! 30

-- (12919,12923,12921)

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

-- λ> primosConsecutivosConMediaCapicua3 !! 30

-- (12919,12923,12921)

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

-- λ> primosConsecutivosConMediaCapicua4 !! 30

-- (12919,12923,12921)

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

-- λ> primosConsecutivosConMediaCapicua2 !! 40

-- (29287,29297,29292)

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

-- λ> primosConsecutivosConMediaCapicua3 !! 40

-- (29287,29297,29292)

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

-- λ> primosConsecutivosConMediaCapicua4 !! 40

-- (29287,29297,29292)

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

-- λ> primosConsecutivosConMediaCapicua3 !! 150

-- (605503,605509,605506)

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

-- λ> primosConsecutivosConMediaCapicua4 !! 150

-- (605503,605509,605506)

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

El código se encuentra en GitHub.

Mastermind

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

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

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

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

Definir la función

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

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

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

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

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

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

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

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

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

Soluciones

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

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

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

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

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

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

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

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

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

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

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

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

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

verifica_mastermind :: IO ()
verifica_mastermind = quickCheck prop_mastermind

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

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

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

import qualified Data.Set as S

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

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

mastermind xs ys =

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

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

-- xs e ys. Por ejemplo,

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

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

aciertos xs ys =

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

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

-- coincidencias entre xs e ys. Por ejemplo,

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

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

coincidencias xs ys =

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

y `elem` xs,

n `notElem` aciertos xs ys]

-- 2ª solución

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

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

mastermind2 xs ys =

(length aciertos2, length coincidencias2)

where

aciertos2, coincidencias2 :: [Int]

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

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

-- 3ª solución

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

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

mastermind3 xs ys = aux xs ys

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

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

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

| otherwise = (a,b)

where (a,b) = aux us vs

aux _ _ = (0,0)

-- 4ª solución

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

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

mastermind4 xs ys =

(length aciertos4, length coincidencias4)

where

aciertos4, coincidencias4 :: [Int]

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

xs' = S.fromList xs

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

-- Equivalencia de las definiciones

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

-- La propiedad es

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

prop_mastermind xs ys =

all (== mastermind xs1 ys1)

[mastermind2 xs1 ys1,

mastermind3 xs1 ys1,

mastermind4 xs1 ys1]

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

xs1 = take n xs

ys1 = take n ys

verifica_mastermind :: IO ()

verifica_mastermind = quickCheck prop_mastermind

-- La comprobación es

-- λ> verifica_mastermind

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

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

-- (0,5000)

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

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

-- (0,5000)

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

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

-- (0,5000)

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

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

-- (0,5000)

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

El código se encuentra en GitHub.

Determinación de los elementos minimales

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

Definir la función

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

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

tal que (minimales xss) es la lista de los elementos de xss que no están contenidos en otros elementos de xss. Por ejemplo,

   minimales [[1,3],[2,3,1],[3,2,5]]        ==  [[2,3,1],[3,2,5]]
   minimales [[1,3],[2,3,1],[3,2,5],[3,1]]  ==  [[2,3,1],[3,2,5]]
   map sum (minimales [[1..n] | n <- [1..300]])  ==  [45150]

minimales [[1,3],[2,3,1],[3,2,5]] == [[2,3,1],[3,2,5]]

minimales [[1,3],[2,3,1],[3,2,5],[3,1]] == [[2,3,1],[3,2,5]]

map sum (minimales [[1..n] | n <- [1..300]]) == [45150]

Soluciones

import Data.List (delete, nub)
import Test.QuickCheck (quickCheck)

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

minimales :: Ord a => [[a]] -> [[a]]
minimales xss =
  [xs | xs <- xss,
        null [ys | ys <- xss, subconjuntoPropio xs ys]]

-- (subconjuntoPropio xs ys) se verifica si xs es un subconjunto propio
-- de ys. Por ejemplo,
--    subconjuntoPropio [1,3] [3,1,3]    ==  False
--    subconjuntoPropio [1,3,1] [3,1,2]  ==  True
subconjuntoPropio :: Ord a => [a] -> [a] -> Bool
subconjuntoPropio xs ys = aux (nub xs) (nub ys)
  where
    aux _       []  = False
    aux []      _   = True
    aux (u:us) vs = u `elem` vs && aux us (delete u vs)

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

minimales2 :: Ord a => [[a]] -> [[a]]
minimales2 xss =
  [xs | xs <- xss,
        null [ys | ys <- xss, subconjuntoPropio2 xs ys]]

subconjuntoPropio2 :: Ord a => [a] -> [a] -> Bool
subconjuntoPropio2 xs ys =
  subconjunto xs ys && not (subconjunto ys xs)

-- (subconjunto xs ys) se verifica si xs es un subconjunto de ys. Por
-- ejemplo,
--    subconjunto [1,3] [3,1,3]        ==  True
--    subconjunto [1,3,1,3] [3,1,3]    ==  True
--    subconjunto [1,3,2,3] [3,1,3]    ==  False
--    subconjunto [1,3,1,3] [3,1,3,2]  ==  True
subconjunto :: Ord a => [a] -> [a] -> Bool
subconjunto xs ys =
  all (`elem` ys) xs

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

-- La propiedad es
prop_minimales :: [[Int]] -> Bool
prop_minimales xss =
   minimales xss == minimales2 xss

verifica_minimales :: IO ()
verifica_minimales =
  quickCheck prop_minimales

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

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

-- La comparación es
--    λ> length (minimales [[1..n] | n <- [1..200]])
--    1
--    (2.30 secs, 657,839,560 bytes)
--    λ> length (minimales2 [[1..n] | n <- [1..200]])
--    1
--    (0.84 secs, 101,962,480 bytes)

import Data.List (delete, nub)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

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

minimales xss =

[xs | xs <- xss,

null [ys | ys <- xss, subconjuntoPropio xs ys]]

-- (subconjuntoPropio xs ys) se verifica si xs es un subconjunto propio

-- de ys. Por ejemplo,

-- subconjuntoPropio [1,3] [3,1,3] == False

-- subconjuntoPropio [1,3,1] [3,1,2] == True

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

subconjuntoPropio xs ys = aux (nub xs) (nub ys)

where

aux _ [] = False

aux [] _ = True

aux (u:us) vs = u `elem` vs && aux us (delete u vs)

-- 2ª solución

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

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

minimales2 xss =

[xs | xs <- xss,

null [ys | ys <- xss, subconjuntoPropio2 xs ys]]

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

subconjuntoPropio2 xs ys =

subconjunto xs ys && not (subconjunto ys xs)

-- (subconjunto xs ys) se verifica si xs es un subconjunto de ys. Por

-- ejemplo,

-- subconjunto [1,3] [3,1,3] == True

-- subconjunto [1,3,1,3] [3,1,3] == True

-- subconjunto [1,3,2,3] [3,1,3] == False

-- subconjunto [1,3,1,3] [3,1,3,2] == True

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

subconjunto xs ys =

all (`elem` ys) xs

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_minimales :: [[Int]] -> Bool

prop_minimales xss =

minimales xss == minimales2 xss

verifica_minimales :: IO ()

verifica_minimales =

quickCheck prop_minimales

-- La comprobación es

-- λ> verifica_minimales

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (minimales [[1..n] | n <- [1..200]])

-- 1

-- (2.30 secs, 657,839,560 bytes)

-- λ> length (minimales2 [[1..n] | n <- [1..200]])

-- 1

-- (0.84 secs, 101,962,480 bytes)

El código se encuentra en GitHub.

Suma de los números amigos menores que n

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

Dos números amigos son dos números enteros positivos distintos tales que la suma de los divisores propios de cada uno es igual al otro. Los divisores propios de un número incluyen la unidad pero no al propio número. Por ejemplo, los divisores propios de 220 son 1, 2, 4, 5, 10, 11, 20, 22, 44, 55 y 110. La suma de estos números equivale a 284. A su vez, los divisores propios de 284 son 1, 2, 4, 71 y 142. Su suma equivale a 220. Por tanto, 220 y 284 son amigos.

Definir la función

   sumaAmigosMenores :: Integer -> Integer

1	sumaAmigosMenores :: Integer -> Integer

tal que (sumaAmigosMenores n) es la suma de los números amigos menores que n. Por ejemplo,

   sumaAmigosMenores 2000   == 2898
   sumaAmigosMenores (10^5) == 852810

1 2	sumaAmigosMenores 2000 == 2898 sumaAmigosMenores (10^5) == 852810

Soluciones

import Data.List (genericLength, group, inits, nub, sort, subsequences)
import Data.Numbers.Primes (primeFactors)

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

sumaAmigosMenores1 :: Integer -> Integer
sumaAmigosMenores1 n =
  sum [x+y | (x,y) <- amigosMenores1 n]

-- (amigosMenores1 n) es la lista de los pares de números amigos (con la
-- primera componente menor que la segunda) que son menores que n. Por
-- ejemplo,
--    amigosMenores1 2000  ==  [(220,284),(1184,1210)]
amigosMenores1 :: Integer -> [(Integer,Integer)]
amigosMenores1 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos1

sucesionAmigos1 :: [(Integer,Integer)]
sucesionAmigos1 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios1 x,
           y > x,
           sumaDivisoresPropios1 y == x]

-- (sumaDivisoresPropios1 x) es la suma de los divisores propios de
-- x. Por ejemplo,
--    sumaDivisoresPropios1 220  ==  284
--    sumaDivisoresPropios1 284  ==  220
sumaDivisoresPropios1 :: Integer -> Integer
sumaDivisoresPropios1 = sum . divisoresPropios1

-- (divisoresPropios1 x) es la lista de los divisores propios de x. Por
-- ejemplo,
--    divisoresPropios1 220  ==  [1,2,4,5,10,11,20,22,44,55,110]
--    divisoresPropios1 284  ==  [1,2,4,71,142]
divisoresPropios1 :: Integer -> [Integer]
divisoresPropios1 x = [n | n <- [1..x-1], x `mod` n == 0]

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

sumaAmigosMenores2 :: Integer -> Integer
sumaAmigosMenores2 n =
  sum [x+y | (x,y) <- amigosMenores2 n]

amigosMenores2 :: Integer -> [(Integer,Integer)]
amigosMenores2 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos2

sucesionAmigos2 :: [(Integer,Integer)]
sucesionAmigos2 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios2 x,
           y > x,
           sumaDivisoresPropios2 y == x]

sumaDivisoresPropios2 :: Integer -> Integer
sumaDivisoresPropios2 = sum . divisoresPropios2

divisoresPropios2 :: Integer -> [Integer]
divisoresPropios2 x = filter ((== 0) . mod x) [1..x-1]

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

sumaAmigosMenores3 :: Integer -> Integer
sumaAmigosMenores3 n =
  sum [x+y | (x,y) <- amigosMenores3 n]

amigosMenores3 :: Integer -> [(Integer,Integer)]
amigosMenores3 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos3

sucesionAmigos3 :: [(Integer,Integer)]
sucesionAmigos3 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios3 x,
           y > x,
           sumaDivisoresPropios3 y == x]

sumaDivisoresPropios3 :: Integer -> Integer
sumaDivisoresPropios3 = sum . divisoresPropios3

divisoresPropios3 :: Integer -> [Integer]
divisoresPropios3 =
  init . nub . sort . map product . subsequences . primeFactors

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

sumaAmigosMenores4 :: Integer -> Integer
sumaAmigosMenores4 n =
  sum [x+y | (x,y) <- amigosMenores4 n]

amigosMenores4 :: Integer -> [(Integer,Integer)]
amigosMenores4 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos4

sucesionAmigos4 :: [(Integer,Integer)]
sucesionAmigos4 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios4 x,
           y > x,
           sumaDivisoresPropios4 y == x]

sumaDivisoresPropios4 :: Integer -> Integer
sumaDivisoresPropios4 = sum . divisoresPropios4

divisoresPropios4 :: Integer -> [Integer]
divisoresPropios4 =
  init
  . sort
  . map (product . concat)
  . productoCartesiano
  . map inits
  . group
  . primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo,
--    λ> productoCartesiano [[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]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]

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

sumaAmigosMenores5 :: Integer -> Integer
sumaAmigosMenores5 n =
  sum [x+y | (x,y) <- amigosMenores5 n]

amigosMenores5 :: Integer -> [(Integer,Integer)]
amigosMenores5 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos5

sucesionAmigos5 :: [(Integer,Integer)]
sucesionAmigos5 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios5 x,
           y > x,
           sumaDivisoresPropios5 y == x]

sumaDivisoresPropios5 :: Integer -> Integer
sumaDivisoresPropios5 = sum . divisoresPropios5

divisoresPropios5 :: Integer -> [Integer]
divisoresPropios5 =
  init
  . sort
  . map (product . concat)
  . sequence
  . map inits
  . group
  . primeFactors

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

sumaAmigosMenores6 :: Integer -> Integer
sumaAmigosMenores6 n =
  sum [x+y | (x,y) <- amigosMenores6 n]

amigosMenores6 :: Integer -> [(Integer,Integer)]
amigosMenores6 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos6

sucesionAmigos6 :: [(Integer,Integer)]
sucesionAmigos6 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios6 x,
           y > x,
           sumaDivisoresPropios6 y == x]

sumaDivisoresPropios6 :: Integer -> Integer
sumaDivisoresPropios6 =
  sum
  . init
  . map (product . concat)
  . sequence
  . map inits
  . group
  . primeFactors

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

sumaAmigosMenores7 :: Integer -> Integer
sumaAmigosMenores7 n =
  sum [x+y | (x,y) <- amigosMenores7 n]

amigosMenores7 :: Integer -> [(Integer,Integer)]
amigosMenores7 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos7

sucesionAmigos7 :: [(Integer,Integer)]
sucesionAmigos7 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios7 x,
           y > x,
           sumaDivisoresPropios7 y == x]

-- Si la descomposición de x en factores primos es
--    x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)
-- entonces la suma de los divisores de x es
--    p(1)^(e(1)+1) - 1     p(2)^(e(2)+1) - 1       p(n)^(e(2)+1) - 1
--   ------------------- . ------------------- ... -------------------
--        p(1)-1                p(2)-1                  p(n)-1
-- Ver la demostración en http://bit.ly/2zUXZPc

sumaDivisoresPropios7 :: Integer -> Integer
sumaDivisoresPropios7 x =
  product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x

-- (factorizacion x) es la lista de las bases y exponentes de la
-- descomposición prima de x. Por ejemplo,
--    factorizacion 600  ==  [(2,3),(3,1),(5,2)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs
-- y la longitud de xs. Por ejemplo,
--    primeroYlongitud [3,2,5,7] == (3,4)
primeroYlongitud :: [a] -> (a,Integer)
primeroYlongitud (x:xs) = (x, 1 + genericLength xs)

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

-- La comparación es
--    λ> sumaAmigosMenores1 6000
--    19026
--    (10.37 secs, 5,261,392,352 bytes)
--    λ> sumaAmigosMenores2 6000
--    19026
--    (3.86 secs, 3,161,700,400 bytes)
--    λ> sumaAmigosMenores3 6000
--    19026
--    (0.15 secs, 308,520,248 bytes)
--    λ> sumaAmigosMenores4 6000
--    19026
--    (0.23 secs, 271,421,184 bytes)
--    λ> sumaAmigosMenores5 6000
--    19026
--    (0.13 secs, 230,042,112 bytes)
--    λ> sumaAmigosMenores6 6000
--    19026
--    (0.12 secs, 202,638,880 bytes)
--    λ> sumaAmigosMenores7 6000
--    19026
--    (0.13 secs, 159,022,448 bytes)
--
--    λ> sumaAmigosMenores3 (10^5)
--    852810
--    (4.83 secs, 10,726,377,728 bytes)
--    λ> sumaAmigosMenores4 (10^5)
--    852810
--    (4.79 secs, 7,832,234,120 bytes)
--    λ> sumaAmigosMenores5 (10^5)
--    852810
--    (2.79 secs, 6,837,118,464 bytes)
--    λ> sumaAmigosMenores6 (10^5)
--    852810
--    (2.39 secs, 6,229,730,472 bytes)
--    λ> sumaAmigosMenores7 (10^5)
--    852810
--    (2.65 secs, 5,170,949,168 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

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

import Data.List (genericLength, group, inits, nub, sort, subsequences)

import Data.Numbers.Primes (primeFactors)

-- 1ª solución --

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

sumaAmigosMenores1 :: Integer -> Integer

sumaAmigosMenores1 n =

sum [x+y | (x,y) <- amigosMenores1 n]

-- (amigosMenores1 n) es la lista de los pares de números amigos (con la

-- primera componente menor que la segunda) que son menores que n. Por

-- ejemplo,

-- amigosMenores1 2000 == [(220,284),(1184,1210)]

amigosMenores1 :: Integer -> [(Integer,Integer)]

amigosMenores1 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos1

sucesionAmigos1 :: [(Integer,Integer)]

sucesionAmigos1 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios1 x,

y > x,

sumaDivisoresPropios1 y == x]

-- (sumaDivisoresPropios1 x) es la suma de los divisores propios de

-- x. Por ejemplo,

-- sumaDivisoresPropios1 220 == 284

-- sumaDivisoresPropios1 284 == 220

sumaDivisoresPropios1 :: Integer -> Integer

sumaDivisoresPropios1 = sum . divisoresPropios1

-- (divisoresPropios1 x) es la lista de los divisores propios de x. Por

-- ejemplo,

-- divisoresPropios1 220 == [1,2,4,5,10,11,20,22,44,55,110]

-- divisoresPropios1 284 == [1,2,4,71,142]

divisoresPropios1 :: Integer -> [Integer]

divisoresPropios1 x = [n | n <- [1..x-1], x `mod` n == 0]

-- 2ª solución --

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

sumaAmigosMenores2 :: Integer -> Integer

sumaAmigosMenores2 n =

sum [x+y | (x,y) <- amigosMenores2 n]

amigosMenores2 :: Integer -> [(Integer,Integer)]

amigosMenores2 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos2

sucesionAmigos2 :: [(Integer,Integer)]

sucesionAmigos2 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios2 x,

y > x,

sumaDivisoresPropios2 y == x]

sumaDivisoresPropios2 :: Integer -> Integer

sumaDivisoresPropios2 = sum . divisoresPropios2

divisoresPropios2 :: Integer -> [Integer]

divisoresPropios2 x = filter ((== 0) . mod x) [1..x-1]

-- 3ª solución --

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

sumaAmigosMenores3 :: Integer -> Integer

sumaAmigosMenores3 n =

sum [x+y | (x,y) <- amigosMenores3 n]

amigosMenores3 :: Integer -> [(Integer,Integer)]

amigosMenores3 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos3

sucesionAmigos3 :: [(Integer,Integer)]

sucesionAmigos3 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios3 x,

y > x,

sumaDivisoresPropios3 y == x]

sumaDivisoresPropios3 :: Integer -> Integer

sumaDivisoresPropios3 = sum . divisoresPropios3

divisoresPropios3 :: Integer -> [Integer]

divisoresPropios3 =

init . nub . sort . map product . subsequences . primeFactors

-- 4ª solución --

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

sumaAmigosMenores4 :: Integer -> Integer

sumaAmigosMenores4 n =

sum [x+y | (x,y) <- amigosMenores4 n]

amigosMenores4 :: Integer -> [(Integer,Integer)]

amigosMenores4 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos4

sucesionAmigos4 :: [(Integer,Integer)]

sucesionAmigos4 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios4 x,

y > x,

sumaDivisoresPropios4 y == x]

sumaDivisoresPropios4 :: Integer -> Integer

sumaDivisoresPropios4 = sum . divisoresPropios4

divisoresPropios4 :: Integer -> [Integer]

divisoresPropios4 =

init

. sort

. map (product . concat)

. productoCartesiano

. map inits

. group

. primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

-- λ> productoCartesiano [[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]]

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 5ª solución --

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

sumaAmigosMenores5 :: Integer -> Integer

sumaAmigosMenores5 n =

sum [x+y | (x,y) <- amigosMenores5 n]

amigosMenores5 :: Integer -> [(Integer,Integer)]

amigosMenores5 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos5

sucesionAmigos5 :: [(Integer,Integer)]

sucesionAmigos5 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios5 x,

y > x,

sumaDivisoresPropios5 y == x]

sumaDivisoresPropios5 :: Integer -> Integer

sumaDivisoresPropios5 = sum . divisoresPropios5

divisoresPropios5 :: Integer -> [Integer]

divisoresPropios5 =

init

. sort

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 6ª solución --

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

sumaAmigosMenores6 :: Integer -> Integer

sumaAmigosMenores6 n =

sum [x+y | (x,y) <- amigosMenores6 n]

amigosMenores6 :: Integer -> [(Integer,Integer)]

amigosMenores6 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos6

sucesionAmigos6 :: [(Integer,Integer)]

sucesionAmigos6 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios6 x,

y > x,

sumaDivisoresPropios6 y == x]

sumaDivisoresPropios6 :: Integer -> Integer

sumaDivisoresPropios6 =

sum

. init

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 7ª solución --

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

sumaAmigosMenores7 :: Integer -> Integer

sumaAmigosMenores7 n =

sum [x+y | (x,y) <- amigosMenores7 n]

amigosMenores7 :: Integer -> [(Integer,Integer)]

amigosMenores7 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos7

sucesionAmigos7 :: [(Integer,Integer)]

sucesionAmigos7 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios7 x,

y > x,

sumaDivisoresPropios7 y == x]

-- Si la descomposición de x en factores primos es

-- x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)

-- entonces la suma de los divisores de x es

-- p(1)^(e(1)+1) - 1 p(2)^(e(2)+1) - 1 p(n)^(e(2)+1) - 1

-- ------------------- . ------------------- ... -------------------

-- p(1)-1 p(2)-1 p(n)-1

-- Ver la demostración en http://bit.ly/2zUXZPc

sumaDivisoresPropios7 :: Integer -> Integer

sumaDivisoresPropios7 x =

product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x

-- (factorizacion x) es la lista de las bases y exponentes de la

-- descomposición prima de x. Por ejemplo,

-- factorizacion 600 == [(2,3),(3,1),(5,2)]

factorizacion :: Integer -> [(Integer,Integer)]

factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs

-- y la longitud de xs. Por ejemplo,

-- primeroYlongitud [3,2,5,7] == (3,4)

primeroYlongitud :: [a] -> (a,Integer)

primeroYlongitud (x:xs) = (x, 1 + genericLength xs)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sumaAmigosMenores1 6000

-- 19026

-- (10.37 secs, 5,261,392,352 bytes)

-- λ> sumaAmigosMenores2 6000

-- 19026

-- (3.86 secs, 3,161,700,400 bytes)

-- λ> sumaAmigosMenores3 6000

-- 19026

-- (0.15 secs, 308,520,248 bytes)

-- λ> sumaAmigosMenores4 6000

-- 19026

-- (0.23 secs, 271,421,184 bytes)

-- λ> sumaAmigosMenores5 6000

-- 19026

-- (0.13 secs, 230,042,112 bytes)

-- λ> sumaAmigosMenores6 6000

-- 19026

-- (0.12 secs, 202,638,880 bytes)

-- λ> sumaAmigosMenores7 6000

-- 19026

-- (0.13 secs, 159,022,448 bytes)

-- λ> sumaAmigosMenores3 (10^5)

-- 852810

-- (4.83 secs, 10,726,377,728 bytes)

-- λ> sumaAmigosMenores4 (10^5)

-- 852810

-- (4.79 secs, 7,832,234,120 bytes)

-- λ> sumaAmigosMenores5 (10^5)

-- 852810

-- (2.79 secs, 6,837,118,464 bytes)

-- λ> sumaAmigosMenores6 (10^5)

-- 852810

-- (2.39 secs, 6,229,730,472 bytes)

-- λ> sumaAmigosMenores7 (10^5)

-- 852810

-- (2.65 secs, 5,170,949,168 bytes)

El código se encuentra en GitHub.

Sucesión de números amigos

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

Definir la lista

   sucesionAmigos :: [(Integer,Integer)]

1	sucesionAmigos :: [(Integer,Integer)]

cuyos elementos son los pares de números amigos con la primera componente menor que la segunda. Por ejemplo,

   take 4 sucesionAmigos == [(220,284),(1184,1210),(2620,2924),(5020,5564)]
   sucesionAmigos6 !! 20 == (185368,203432)

1 2	take 4 sucesionAmigos == [(220,284),(1184,1210),(2620,2924),(5020,5564)] sucesionAmigos6 !! 20 == (185368,203432)

Soluciones

import Data.List (genericLength, group, inits, nub, sort, subsequences)
import Data.Numbers.Primes (primeFactors)

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

sucesionAmigos1 :: [(Integer,Integer)]
sucesionAmigos1 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios1 x,
           y > x,
           sumaDivisoresPropios1 y == x]

-- (sumaDivisoresPropios1 x) es la suma de los divisores propios de
-- x. Por ejemplo,
--    sumaDivisoresPropios1 220  ==  284
--    sumaDivisoresPropios1 284  ==  220
sumaDivisoresPropios1 :: Integer -> Integer
sumaDivisoresPropios1 = sum . divisoresPropios1

-- (divisoresPropios1 x) es la lista de los divisores propios de x. Por
-- ejemplo,
--    divisoresPropios1 220  ==  [1,2,4,5,10,11,20,22,44,55,110]
--    divisoresPropios1 284  ==  [1,2,4,71,142]
divisoresPropios1 :: Integer -> [Integer]
divisoresPropios1 x = [n | n <- [1..x-1], x `mod` n == 0]

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

sucesionAmigos2 :: [(Integer,Integer)]
sucesionAmigos2 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios2 x,
           y > x,
           sumaDivisoresPropios2 y == x]

sumaDivisoresPropios2 :: Integer -> Integer
sumaDivisoresPropios2 = sum . divisoresPropios2

divisoresPropios2 :: Integer -> [Integer]
divisoresPropios2 x = filter ((== 0) . mod x) [1..x-1]

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

sucesionAmigos3 :: [(Integer,Integer)]
sucesionAmigos3 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios3 x,
           y > x,
           sumaDivisoresPropios3 y == x]

sumaDivisoresPropios3 :: Integer -> Integer
sumaDivisoresPropios3 = sum . divisoresPropios3

divisoresPropios3 :: Integer -> [Integer]
divisoresPropios3 =
  init . nub . sort . map product . subsequences . primeFactors

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

sucesionAmigos4 :: [(Integer,Integer)]
sucesionAmigos4 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios4 x,
           y > x,
           sumaDivisoresPropios4 y == x]

sumaDivisoresPropios4 :: Integer -> Integer
sumaDivisoresPropios4 = sum . divisoresPropios4

divisoresPropios4 :: Integer -> [Integer]
divisoresPropios4 =
  init
  . sort
  . map (product . concat)
  . productoCartesiano
  . map inits
  . group
  . primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo,
--    λ> productoCartesiano [[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]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]

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

sucesionAmigos5 :: [(Integer,Integer)]
sucesionAmigos5 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios5 x,
           y > x,
           sumaDivisoresPropios5 y == x]

sumaDivisoresPropios5 :: Integer -> Integer
sumaDivisoresPropios5 = sum . divisoresPropios5

divisoresPropios5 :: Integer -> [Integer]
divisoresPropios5 =
  init
  . sort
  . map (product . concat)
  . sequence
  . map inits
  . group
  . primeFactors

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

sucesionAmigos6 :: [(Integer,Integer)]
sucesionAmigos6 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios6 x,
           y > x,
           sumaDivisoresPropios6 y == x]

sumaDivisoresPropios6 :: Integer -> Integer
sumaDivisoresPropios6 =
  sum
  . init
  . map (product . concat)
  . sequence
  . map inits
  . group
  . primeFactors

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

sucesionAmigos7 :: [(Integer,Integer)]
sucesionAmigos7 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios7 x,
           y > x,
           sumaDivisoresPropios7 y == x]

-- Si la descomposición de x en factores primos es
--    x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)
-- entonces la suma de los divisores de x es
--    p(1)^(e(1)+1) - 1     p(2)^(e(2)+1) - 1       p(n)^(e(2)+1) - 1
--   ------------------- . ------------------- ... -------------------
--        p(1)-1                p(2)-1                  p(n)-1
-- Ver la demostración en http://bit.ly/2zUXZPc

sumaDivisoresPropios7 :: Integer -> Integer
sumaDivisoresPropios7 x =
  product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x

-- (factorizacion x) es la lista de las bases y exponentes de la
-- descomposición prima de x. Por ejemplo,
--    factorizacion 600  ==  [(2,3),(3,1),(5,2)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs
-- y la longitud de xs. Por ejemplo,
--    primeroYlongitud [3,2,5,7] == (3,4)
primeroYlongitud :: [a] -> (a,Integer)
primeroYlongitud (x:xs) = (x, 1 + genericLength xs)

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

-- La comparación es
--    λ> take 4 sucesionAmigos1
--    [(220,284),(1184,1210),(2620,2924),(5020,5564)]
--    (6.00 secs, 3,413,777,560 bytes)
--    λ> take 4 sucesionAmigos2
--    [(220,284),(1184,1210),(2620,2924),(5020,5564)]
--    (2.38 secs, 2,052,151,800 bytes)
--    λ> take 4 sucesionAmigos3
--    [(220,284),(1184,1210),(2620,2924),(5020,5564)]
--    (0.14 secs, 235,238,864 bytes)
--    λ> take 4 sucesionAmigos4
--    [(220,284),(1184,1210),(2620,2924),(5020,5564)]
--    (0.20 secs, 208,315,832 bytes)
--    λ> take 4 sucesionAmigos5
--    [(220,284),(1184,1210),(2620,2924),(5020,5564)]
--    (0.09 secs, 176,149,160 bytes)
--    λ> take 4 sucesionAmigos6
--    [(220,284),(1184,1210),(2620,2924),(5020,5564)]
--    (0.07 secs, 154,686,728 bytes)
--    λ> take 4 sucesionAmigos7
--    [(220,284),(1184,1210),(2620,2924),(5020,5564)]
--    (0.12 secs, 120,826,648 bytes)
--
--    λ> sucesionAmigos3 !! 10
--    (67095,71145)
--    (3.52 secs, 6,749,059,064 bytes)
--    λ> sucesionAmigos4 !! 10
--    (67095,71145)
--    (3.11 secs, 4,951,018,904 bytes)
--    λ> sucesionAmigos5 !! 10
--    (67095,71145)
--    (1.69 secs, 4,294,457,320 bytes)
--    λ> sucesionAmigos6 !! 10
--    (67095,71145)
--    (1.43 secs, 3,889,045,760 bytes)
--    λ> sucesionAmigos7 !! 10
--    (67095,71145)
--    (1.63 secs, 3,191,073,224 bytes)
--
--    λ> sucesionAmigos5 !! 12
--    (79750,88730)
--    (2.13 secs, 5,312,053,312 bytes)
--    λ> sucesionAmigos6 !! 12
--    (79750,88730)
--    (1.78 secs, 4,820,560,920 bytes)
--    λ> sucesionAmigos7 !! 12
--    (79750,88730)
--    (2.11 secs, 3,971,113,184 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

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

import Data.List (genericLength, group, inits, nub, sort, subsequences)

import Data.Numbers.Primes (primeFactors)

-- 1ª solución --

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

sucesionAmigos1 :: [(Integer,Integer)]

sucesionAmigos1 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios1 x,

y > x,

sumaDivisoresPropios1 y == x]

-- (sumaDivisoresPropios1 x) es la suma de los divisores propios de

-- x. Por ejemplo,

-- sumaDivisoresPropios1 220 == 284

-- sumaDivisoresPropios1 284 == 220

sumaDivisoresPropios1 :: Integer -> Integer

sumaDivisoresPropios1 = sum . divisoresPropios1

-- (divisoresPropios1 x) es la lista de los divisores propios de x. Por

-- ejemplo,

-- divisoresPropios1 220 == [1,2,4,5,10,11,20,22,44,55,110]

-- divisoresPropios1 284 == [1,2,4,71,142]

divisoresPropios1 :: Integer -> [Integer]

divisoresPropios1 x = [n | n <- [1..x-1], x `mod` n == 0]

-- 2ª solución --

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

sucesionAmigos2 :: [(Integer,Integer)]

sucesionAmigos2 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios2 x,

y > x,

sumaDivisoresPropios2 y == x]

sumaDivisoresPropios2 :: Integer -> Integer

sumaDivisoresPropios2 = sum . divisoresPropios2

divisoresPropios2 :: Integer -> [Integer]

divisoresPropios2 x = filter ((== 0) . mod x) [1..x-1]

-- 3ª solución --

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

sucesionAmigos3 :: [(Integer,Integer)]

sucesionAmigos3 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios3 x,

y > x,

sumaDivisoresPropios3 y == x]

sumaDivisoresPropios3 :: Integer -> Integer

sumaDivisoresPropios3 = sum . divisoresPropios3

divisoresPropios3 :: Integer -> [Integer]

divisoresPropios3 =

init . nub . sort . map product . subsequences . primeFactors

-- 4ª solución --

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

sucesionAmigos4 :: [(Integer,Integer)]

sucesionAmigos4 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios4 x,

y > x,

sumaDivisoresPropios4 y == x]

sumaDivisoresPropios4 :: Integer -> Integer

sumaDivisoresPropios4 = sum . divisoresPropios4

divisoresPropios4 :: Integer -> [Integer]

divisoresPropios4 =

init

. sort

. map (product . concat)

. productoCartesiano

. map inits

. group

. primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

-- λ> productoCartesiano [[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]]

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 5ª solución --

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

sucesionAmigos5 :: [(Integer,Integer)]

sucesionAmigos5 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios5 x,

y > x,

sumaDivisoresPropios5 y == x]

sumaDivisoresPropios5 :: Integer -> Integer

sumaDivisoresPropios5 = sum . divisoresPropios5

divisoresPropios5 :: Integer -> [Integer]

divisoresPropios5 =

init

. sort

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 6ª solución --

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

sucesionAmigos6 :: [(Integer,Integer)]

sucesionAmigos6 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios6 x,

y > x,

sumaDivisoresPropios6 y == x]

sumaDivisoresPropios6 :: Integer -> Integer

sumaDivisoresPropios6 =

sum

. init

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 7ª solución --

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

sucesionAmigos7 :: [(Integer,Integer)]

sucesionAmigos7 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios7 x,

y > x,

sumaDivisoresPropios7 y == x]

-- Si la descomposición de x en factores primos es

-- x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)

-- entonces la suma de los divisores de x es

-- p(1)^(e(1)+1) - 1 p(2)^(e(2)+1) - 1 p(n)^(e(2)+1) - 1

-- ------------------- . ------------------- ... -------------------

-- p(1)-1 p(2)-1 p(n)-1

-- Ver la demostración en http://bit.ly/2zUXZPc

sumaDivisoresPropios7 :: Integer -> Integer

sumaDivisoresPropios7 x =

product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x

-- (factorizacion x) es la lista de las bases y exponentes de la

-- descomposición prima de x. Por ejemplo,

-- factorizacion 600 == [(2,3),(3,1),(5,2)]

factorizacion :: Integer -> [(Integer,Integer)]

factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs

-- y la longitud de xs. Por ejemplo,

-- primeroYlongitud [3,2,5,7] == (3,4)

primeroYlongitud :: [a] -> (a,Integer)

primeroYlongitud (x:xs) = (x, 1 + genericLength xs)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> take 4 sucesionAmigos1

-- [(220,284),(1184,1210),(2620,2924),(5020,5564)]

-- (6.00 secs, 3,413,777,560 bytes)

-- λ> take 4 sucesionAmigos2

-- [(220,284),(1184,1210),(2620,2924),(5020,5564)]

-- (2.38 secs, 2,052,151,800 bytes)

-- λ> take 4 sucesionAmigos3

-- [(220,284),(1184,1210),(2620,2924),(5020,5564)]

-- (0.14 secs, 235,238,864 bytes)

-- λ> take 4 sucesionAmigos4

-- [(220,284),(1184,1210),(2620,2924),(5020,5564)]

-- (0.20 secs, 208,315,832 bytes)

-- λ> take 4 sucesionAmigos5

-- [(220,284),(1184,1210),(2620,2924),(5020,5564)]

-- (0.09 secs, 176,149,160 bytes)

-- λ> take 4 sucesionAmigos6

-- [(220,284),(1184,1210),(2620,2924),(5020,5564)]

-- (0.07 secs, 154,686,728 bytes)

-- λ> take 4 sucesionAmigos7

-- [(220,284),(1184,1210),(2620,2924),(5020,5564)]

-- (0.12 secs, 120,826,648 bytes)

-- λ> sucesionAmigos3 !! 10

-- (67095,71145)

-- (3.52 secs, 6,749,059,064 bytes)

-- λ> sucesionAmigos4 !! 10

-- (67095,71145)

-- (3.11 secs, 4,951,018,904 bytes)

-- λ> sucesionAmigos5 !! 10

-- (67095,71145)

-- (1.69 secs, 4,294,457,320 bytes)

-- λ> sucesionAmigos6 !! 10

-- (67095,71145)

-- (1.43 secs, 3,889,045,760 bytes)

-- λ> sucesionAmigos7 !! 10

-- (67095,71145)

-- (1.63 secs, 3,191,073,224 bytes)

-- λ> sucesionAmigos5 !! 12

-- (79750,88730)

-- (2.13 secs, 5,312,053,312 bytes)

-- λ> sucesionAmigos6 !! 12

-- (79750,88730)

-- (1.78 secs, 4,820,560,920 bytes)

-- λ> sucesionAmigos7 !! 12

-- (79750,88730)

-- (2.11 secs, 3,971,113,184 bytes)

El código se encuentra en GitHub.

Números amigos

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

Definir la función

   amigos :: Integer -> Integer -> Bool

1	amigos :: Integer -> Integer -> Bool

tal que (amigos x y) se verifica si los números x e y son amigos. Por ejemplo,

   amigos 220 284 == True
   amigos 220 23  == False
   amigos 42262694537514864075544955198125 42405817271188606697466971841875 == True

amigos 220 284 == True

amigos 220 23 == False

amigos 42262694537514864075544955198125 42405817271188606697466971841875 == True

Soluciones

import Data.List (genericLength, group, inits, nub, sort, subsequences)
import Data.Numbers.Primes (primeFactors)

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

amigos1 :: Integer -> Integer -> Bool
amigos1 x y = sumaDivisoresPropios1 x == y &&
              sumaDivisoresPropios1 y == x

-- (sumaDivisoresPropios1 x) es la suma de los divisores propios de
-- x. Por ejemplo,
--    sumaDivisoresPropios1 220  ==  284
--    sumaDivisoresPropios1 284  ==  220
sumaDivisoresPropios1 :: Integer -> Integer
sumaDivisoresPropios1 = sum . divisoresPropios1

-- (divisoresPropios1 x) es la lista de los divisores propios de x. Por
-- ejemplo,
--    divisoresPropios1 220  ==  [1,2,4,5,10,11,20,22,44,55,110]
--    divisoresPropios1 284  ==  [1,2,4,71,142]
divisoresPropios1 :: Integer -> [Integer]
divisoresPropios1 x = [n | n <- [1..x-1], x `mod` n == 0]

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

amigos2 :: Integer -> Integer -> Bool
amigos2 x y = sumaDivisoresPropios2 x == y &&
              sumaDivisoresPropios2 y == x

sumaDivisoresPropios2 :: Integer -> Integer
sumaDivisoresPropios2 = sum . divisoresPropios2

divisoresPropios2 :: Integer -> [Integer]
divisoresPropios2 x = filter ((== 0) . mod x) [1..x-1]

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

amigos3 :: Integer -> Integer -> Bool
amigos3 x y = sumaDivisoresPropios3 x == y &&
              sumaDivisoresPropios3 y == x

sumaDivisoresPropios3 :: Integer -> Integer
sumaDivisoresPropios3 = sum . divisoresPropios3

divisoresPropios3 :: Integer -> [Integer]
divisoresPropios3 =
  init . nub . sort . map product . subsequences . primeFactors

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

amigos4 :: Integer -> Integer -> Bool
amigos4 x y = sumaDivisoresPropios4 x == y &&
              sumaDivisoresPropios4 y == x

sumaDivisoresPropios4 :: Integer -> Integer
sumaDivisoresPropios4 = sum . divisoresPropios4

divisoresPropios4 :: Integer -> [Integer]
divisoresPropios4 =
  init
  . sort
  . map (product . concat)
  . productoCartesiano
  . map inits
  . group
  . primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo,
--    λ> productoCartesiano [[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]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]

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

amigos5 :: Integer -> Integer -> Bool
amigos5 x y = sumaDivisoresPropios5 x == y &&
              sumaDivisoresPropios5 y == x

sumaDivisoresPropios5 :: Integer -> Integer
sumaDivisoresPropios5 =
  sum . divisoresPropios5

divisoresPropios5 :: Integer -> [Integer]
divisoresPropios5 =
  init
  . sort
  . map (product . concat)
  . sequence
  . map inits
  . group
  . primeFactors

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

amigos6 :: Integer -> Integer -> Bool
amigos6 x y = sumaDivisoresPropios6 x == y &&
              sumaDivisoresPropios6 y == x

sumaDivisoresPropios6 :: Integer -> Integer
sumaDivisoresPropios6 =
  sum
  . init
  . map (product . concat)
  . sequence
  . map inits
  . group
  . primeFactors

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

amigos7 :: Integer -> Integer -> Bool
amigos7 x y = sumaDivisoresPropios7 x == y &&
              sumaDivisoresPropios7 y == x

-- Si la descomposición de x en factores primos es
--    x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)
-- entonces la suma de los divisores de x es
--    p(1)^(e(1)+1) - 1     p(2)^(e(2)+1) - 1       p(n)^(e(2)+1) - 1
--   ------------------- . ------------------- ... -------------------
--        p(1)-1                p(2)-1                  p(n)-1
-- Ver la demostración en http://bit.ly/2zUXZPc

-- (sumaDivisoresPropios7 x) es la suma de los divisores propios de
-- x. Por ejemplo,
--    sumaDivisoresPropios7 220  ==  284
--    sumaDivisoresPropios7 284  ==  220
sumaDivisoresPropios7 :: Integer -> Integer
sumaDivisoresPropios7 x =
  product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x

-- (factorizacion x) es la lista de las bases y exponentes de la
-- descomposición prima de x. Por ejemplo,
--    factorizacion 600  ==  [(2,3),(3,1),(5,2)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs
-- y la longitud de xs. Por ejemplo,
--    primeroYlongitud [3,2,5,7] == (3,4)
primeroYlongitud :: [a] -> (a,Integer)
primeroYlongitud (x:xs) = (x, 1 + genericLength xs)

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

-- La comparación es
--    λ> amigos1 2803580 3716164
--    True
--    (2.27 secs, 1,304,055,864 bytes)
--    λ> amigos2 2803580 3716164
--    True
--    (0.81 secs, 782,478,584 bytes)
--    λ> amigos3 2803580 3716164
--    True
--    (0.01 secs, 383,888 bytes)
--    λ> amigos4 2803580 3716164
--    True
--    (0.01 secs, 461,376 bytes)
--    λ> amigos5 2803580 3716164
--    True
--    (0.00 secs, 412,560 bytes)
--    λ> amigos6 2803580 3716164
--    True
--    (0.00 secs, 387,816 bytes)
--    λ> amigos7 2803580 3716164
--    True
--    (0.01 secs, 339,008 bytes)
--
--    λ> amigos2 5864660 7489324
--    True
--    (1.74 secs, 1,602,582,592 bytes)
--    λ> amigos3 5864660 7489324
--    True
--    (0.00 secs, 277,056 bytes)
--    λ> amigos4 5864660 7489324
--    True
--    (0.01 secs, 354,872 bytes)
--    λ> amigos5 5864660 7489324
--    True
--    (0.01 secs, 305,792 bytes)
--    λ> amigos6 5864660 7489324
--    True
--    (0.00 secs, 281,528 bytes)
--    λ> amigos7 5864660 7489324
--    True
--    (0.01 secs, 237,176 bytes)
--
--    λ> amigos3 42262694537514864075544955198125 42405817271188606697466971841875
--    True
--    (107.54 secs, 5,594,306,392 bytes)
--    λ> amigos4 42262694537514864075544955198125 42405817271188606697466971841875
--    True
--    (1.03 secs, 942,530,824 bytes)
--    λ> amigos5 42262694537514864075544955198125 42405817271188606697466971841875
--    True
--    (0.51 secs, 591,144,304 bytes)
--    λ> amigos6 42262694537514864075544955198125 42405817271188606697466971841875
--    True
--    (0.26 secs, 379,534,608 bytes)
--    λ> amigos7 42262694537514864075544955198125 42405817271188606697466971841875
--    True
--    (0.05 secs, 25,635,464 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

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

import Data.List (genericLength, group, inits, nub, sort, subsequences)

import Data.Numbers.Primes (primeFactors)

-- 1ª solución --

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

amigos1 :: Integer -> Integer -> Bool

amigos1 x y = sumaDivisoresPropios1 x == y &&

sumaDivisoresPropios1 y == x

-- (sumaDivisoresPropios1 x) es la suma de los divisores propios de

-- x. Por ejemplo,

-- sumaDivisoresPropios1 220 == 284

-- sumaDivisoresPropios1 284 == 220

sumaDivisoresPropios1 :: Integer -> Integer

sumaDivisoresPropios1 = sum . divisoresPropios1

-- (divisoresPropios1 x) es la lista de los divisores propios de x. Por

-- ejemplo,

-- divisoresPropios1 220 == [1,2,4,5,10,11,20,22,44,55,110]

-- divisoresPropios1 284 == [1,2,4,71,142]

divisoresPropios1 :: Integer -> [Integer]

divisoresPropios1 x = [n | n <- [1..x-1], x `mod` n == 0]

-- 2ª solución --

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

amigos2 :: Integer -> Integer -> Bool

amigos2 x y = sumaDivisoresPropios2 x == y &&

sumaDivisoresPropios2 y == x

sumaDivisoresPropios2 :: Integer -> Integer

sumaDivisoresPropios2 = sum . divisoresPropios2

divisoresPropios2 :: Integer -> [Integer]

divisoresPropios2 x = filter ((== 0) . mod x) [1..x-1]

-- 3ª solución --

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

amigos3 :: Integer -> Integer -> Bool

amigos3 x y = sumaDivisoresPropios3 x == y &&

sumaDivisoresPropios3 y == x

sumaDivisoresPropios3 :: Integer -> Integer

sumaDivisoresPropios3 = sum . divisoresPropios3

divisoresPropios3 :: Integer -> [Integer]

divisoresPropios3 =

init . nub . sort . map product . subsequences . primeFactors

-- 4ª solución --

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

amigos4 :: Integer -> Integer -> Bool

amigos4 x y = sumaDivisoresPropios4 x == y &&

sumaDivisoresPropios4 y == x

sumaDivisoresPropios4 :: Integer -> Integer

sumaDivisoresPropios4 = sum . divisoresPropios4

divisoresPropios4 :: Integer -> [Integer]

divisoresPropios4 =

init

. sort

. map (product . concat)

. productoCartesiano

. map inits

. group

. primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

-- λ> productoCartesiano [[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]]

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 5ª solución --

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

amigos5 :: Integer -> Integer -> Bool

amigos5 x y = sumaDivisoresPropios5 x == y &&

sumaDivisoresPropios5 y == x

sumaDivisoresPropios5 :: Integer -> Integer

sumaDivisoresPropios5 =

sum . divisoresPropios5

divisoresPropios5 :: Integer -> [Integer]

divisoresPropios5 =

init

. sort

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 6ª solución --

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

amigos6 :: Integer -> Integer -> Bool

amigos6 x y = sumaDivisoresPropios6 x == y &&

sumaDivisoresPropios6 y == x

sumaDivisoresPropios6 :: Integer -> Integer

sumaDivisoresPropios6 =

sum

. init

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 7ª solución --

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

amigos7 :: Integer -> Integer -> Bool

amigos7 x y = sumaDivisoresPropios7 x == y &&

sumaDivisoresPropios7 y == x

-- Si la descomposición de x en factores primos es

-- x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)

-- entonces la suma de los divisores de x es

-- p(1)^(e(1)+1) - 1 p(2)^(e(2)+1) - 1 p(n)^(e(2)+1) - 1

-- ------------------- . ------------------- ... -------------------

-- p(1)-1 p(2)-1 p(n)-1

-- Ver la demostración en http://bit.ly/2zUXZPc

-- (sumaDivisoresPropios7 x) es la suma de los divisores propios de

-- x. Por ejemplo,

-- sumaDivisoresPropios7 220 == 284

-- sumaDivisoresPropios7 284 == 220

sumaDivisoresPropios7 :: Integer -> Integer

sumaDivisoresPropios7 x =

product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x

-- (factorizacion x) es la lista de las bases y exponentes de la

-- descomposición prima de x. Por ejemplo,

-- factorizacion 600 == [(2,3),(3,1),(5,2)]

factorizacion :: Integer -> [(Integer,Integer)]

factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs

-- y la longitud de xs. Por ejemplo,

-- primeroYlongitud [3,2,5,7] == (3,4)

primeroYlongitud :: [a] -> (a,Integer)

primeroYlongitud (x:xs) = (x, 1 + genericLength xs)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> amigos1 2803580 3716164

-- True

-- (2.27 secs, 1,304,055,864 bytes)

-- λ> amigos2 2803580 3716164

-- True

-- (0.81 secs, 782,478,584 bytes)

-- λ> amigos3 2803580 3716164

-- True

-- (0.01 secs, 383,888 bytes)

-- λ> amigos4 2803580 3716164

-- True

-- (0.01 secs, 461,376 bytes)

-- λ> amigos5 2803580 3716164

-- True

-- (0.00 secs, 412,560 bytes)

-- λ> amigos6 2803580 3716164

-- True

-- (0.00 secs, 387,816 bytes)

-- λ> amigos7 2803580 3716164

-- True

-- (0.01 secs, 339,008 bytes)

-- λ> amigos2 5864660 7489324

-- True

-- (1.74 secs, 1,602,582,592 bytes)

-- λ> amigos3 5864660 7489324

-- True

-- (0.00 secs, 277,056 bytes)

-- λ> amigos4 5864660 7489324

-- True

-- (0.01 secs, 354,872 bytes)

-- λ> amigos5 5864660 7489324

-- True

-- (0.01 secs, 305,792 bytes)

-- λ> amigos6 5864660 7489324

-- True

-- (0.00 secs, 281,528 bytes)

-- λ> amigos7 5864660 7489324

-- True

-- (0.01 secs, 237,176 bytes)

-- λ> amigos3 42262694537514864075544955198125 42405817271188606697466971841875

-- True

-- (107.54 secs, 5,594,306,392 bytes)

-- λ> amigos4 42262694537514864075544955198125 42405817271188606697466971841875

-- True

-- (1.03 secs, 942,530,824 bytes)

-- λ> amigos5 42262694537514864075544955198125 42405817271188606697466971841875

-- True

-- (0.51 secs, 591,144,304 bytes)

-- λ> amigos6 42262694537514864075544955198125 42405817271188606697466971841875

-- True

-- (0.26 secs, 379,534,608 bytes)

-- λ> amigos7 42262694537514864075544955198125 42405817271188606697466971841875

-- True

-- (0.05 secs, 25,635,464 bytes)

El código se encuentra en GitHub

Máxima suma de caminos en un triángulo

PorJosé A. Alonso 15-febrero-202223-febrero-2022

Los triángulos se pueden representar mediante listas de listas. Por ejemplo, el triángulo

7 4

2 4 6

8 5 9 3

se reperesenta por

   [[3],[7,4],[2,4,6],[8,5,9,3]]

1	[[3],[7,4],[2,4,6],[8,5,9,3]]

Definir la función

   maximaSuma :: [[Integer]] -> Integer

1	maximaSuma :: [[Integer]] -> Integer

tal que (maximaSuma xss) es el máximo de las sumas de los elementos de los caminos en el triángulo xss donde los caminos comienzan en el elemento de la primera fila, en cada paso se mueve a uno de sus dos elementos adyacentes en la fila siguiente y terminan en la última fila. Por ejemplo,

   maximaSuma [[3],[7,4]]                    ==  10
   maximaSuma [[3],[7,4],[2,4,6]]            ==  14
   maximaSuma [[3],[7,4],[2,4,6],[8,5,9,3]]  ==  23
   maximaSuma [[n..n+n] | n <- [0..100]]     ==  10100
   maximaSuma [[n..n+n] | n <- [0..1000]]    ==  1001000
   maximaSuma [[n..n+n] | n <- [0..2000]]    ==  4002000
   maximaSuma [[n..n+n] | n <- [0..3000]]    ==  9003000
   maximaSuma [[n..n+n] | n <- [0..4000]]    ==  16004000

maximaSuma [[3],[7,4]] == 10

maximaSuma [[3],[7,4],[2,4,6]] == 14

maximaSuma [[3],[7,4],[2,4,6],[8,5,9,3]] == 23

maximaSuma [[n..n+n] | n <- [0..100]] == 10100

maximaSuma [[n..n+n] | n <- [0..1000]] == 1001000

maximaSuma [[n..n+n] | n <- [0..2000]] == 4002000

maximaSuma [[n..n+n] | n <- [0..3000]] == 9003000

maximaSuma [[n..n+n] | n <- [0..4000]] == 16004000

Soluciones

import Data.List (tails)

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

maximaSuma1 :: [[Integer]] -> Integer
maximaSuma1 xss =
  maximum [sum ys | ys <- caminos xss]

caminos :: [[Integer]] -> [[Integer]]
caminos []    = [[]]
caminos [[x]] = [[x]]
caminos ([x]:[y1,y2]:zs) =
  [x:y1:us | (_:us) <- caminos ([y1] : map init zs)] ++
  [x:y2:vs | (_:vs) <- caminos ([y2] : map tail zs)]

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

maximaSuma2 :: [[Integer]] -> Integer
maximaSuma2 xss = maximum (map sum (caminos xss))

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

maximaSuma3 :: [[Integer]] -> Integer
maximaSuma3 = maximum . map sum . caminos

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

maximaSuma4 :: [[Integer]] -> Integer
maximaSuma4 []    = 0
maximaSuma4 [[x]] = x
maximaSuma4 ([x]:[y1,y2]:zs) =
  x + max (maximaSuma4 ([y1] : map init zs))
          (maximaSuma4 ([y2] : map tail zs))

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

maximaSuma5 :: [[Integer]] -> Integer
maximaSuma5 xss = head (foldr1 g xss)
  where
    f x y z = x + max y z
    g xs ys = zipWith3 f xs ys (tail ys)

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

maximaSuma6 :: [[Integer]] -> Integer
maximaSuma6 xss = head (foldr1 aux xss)
  where aux a b = zipWith (+) a (zipWith max b (tail b))

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

maximaSuma7 :: [[Integer]] -> Integer
maximaSuma7 xss = head (foldr (flip f) (last xss) (init xss))
  where f = zipWith ((+) . maximum . take 2) . tails

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

maximaSuma8 :: [[Integer]] -> Integer
maximaSuma8 = head . foldr1 aux
  where
    aux [] _              = []
    aux (x:xs) (y0:y1:ys) = x + max y0 y1 : aux xs (y1:ys)

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

-- Para la comparaciones se usará la siguiente función que construye un
-- triángulo de la altura dada. Por ejemplo,
--    triangulo 2  ==  [[0],[1,2]]
--    triangulo 3  ==  [[0],[1,2],[2,3,4]]
--    triangulo 4  ==  [[0],[1,2],[2,3,4],[3,4,5,6]]
triangulo :: Integer -> [[Integer]]
triangulo n = [[k..k+k] | k <- [0..n-1]]

-- La comparación es
--    (1.97 secs, 876,483,056 bytes)
--    λ> maximaSuma1 (triangulo 19)
--    342
--    (2.37 secs, 1,833,637,824 bytes)
--    λ> maximaSuma2 (triangulo 19)
--    342
--    (2.55 secs, 1,804,276,472 bytes)
--    λ> maximaSuma3 (triangulo 19)
--    342
--    (2.57 secs, 1,804,275,320 bytes)
--    λ> maximaSuma4 (triangulo 19)
--    342
--    (0.28 secs, 245,469,384 bytes)
--    λ> maximaSuma5 (triangulo 19)
--    342
--    (0.01 secs, 153,272 bytes)
--    λ> maximaSuma6 (triangulo 19)
--    342
--    (0.01 secs, 161,360 bytes)
--    λ> maximaSuma7 (triangulo 19)
--    342
--    (0.01 secs, 187,456 bytes)
--    λ> maximaSuma8 (triangulo 19)
--    342
--    (0.01 secs, 191,160 bytes)
--
--    λ> maximaSuma4 (triangulo 22)
--    462
--    (2.30 secs, 1,963,037,888 bytes)
--    λ> maximaSuma5 (triangulo 22)
--    462
--    (0.00 secs, 173,512 bytes)
--    λ> maximaSuma6 (triangulo 22)
--    462
--    (0.01 secs, 182,904 bytes)
--    λ> maximaSuma7 (triangulo 22)
--    462
--    (0.01 secs, 216,560 bytes)
--    λ> maximaSuma8 (triangulo 22)
--    462
--    (0.01 secs, 224,160 bytes)
--
--    λ> maximaSuma5 (triangulo 3000)
--    8997000
--    (2.25 secs, 2,059,784,792 bytes)
--    λ> maximaSuma6 (triangulo 3000)
--    8997000
--    (2.15 secs, 2,404,239,896 bytes)
--    λ> maximaSuma7 (triangulo 3000)
--    8997000
--    (1.53 secs, 2,612,659,504 bytes)
--    λ> maximaSuma8 (triangulo 3000)
--    8997000
--    (3.47 secs, 3,520,910,256 bytes)
--
--    λ> maximaSuma7 (triangulo 4000)
--    15996000
--    (3.12 secs, 4,634,841,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

import Data.List (tails)

-- 1ª solución

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

maximaSuma1 :: [[Integer]] -> Integer

maximaSuma1 xss =

maximum [sum ys | ys <- caminos xss]

caminos :: [[Integer]] -> [[Integer]]

caminos [] = [[]]

caminos [[x]] = [[x]]

caminos ([x]:[y1,y2]:zs) =

[x:y1:us | (_:us) <- caminos ([y1] : map init zs)] ++

[x:y2:vs | (_:vs) <- caminos ([y2] : map tail zs)]

-- 2ª solución

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

maximaSuma2 :: [[Integer]] -> Integer

maximaSuma2 xss = maximum (map sum (caminos xss))

-- 3ª solución

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

maximaSuma3 :: [[Integer]] -> Integer

maximaSuma3 = maximum . map sum . caminos

-- 4ª solución

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

maximaSuma4 :: [[Integer]] -> Integer

maximaSuma4 [] = 0

maximaSuma4 [[x]] = x

maximaSuma4 ([x]:[y1,y2]:zs) =

x + max (maximaSuma4 ([y1] : map init zs))

(maximaSuma4 ([y2] : map tail zs))

-- 5ª solución

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

maximaSuma5 :: [[Integer]] -> Integer

maximaSuma5 xss = head (foldr1 g xss)

where

f x y z = x + max y z

g xs ys = zipWith3 f xs ys (tail ys)

-- 6ª solución

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

maximaSuma6 :: [[Integer]] -> Integer

maximaSuma6 xss = head (foldr1 aux xss)

where aux a b = zipWith (+) a (zipWith max b (tail b))

-- 7ª solución

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

maximaSuma7 :: [[Integer]] -> Integer

maximaSuma7 xss = head (foldr (flip f) (last xss) (init xss))

where f = zipWith ((+) . maximum . take 2) . tails

-- 8ª solución

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

maximaSuma8 :: [[Integer]] -> Integer

maximaSuma8 = head . foldr1 aux

where

aux [] _ = []

aux (x:xs) (y0:y1:ys) = x + max y0 y1 : aux xs (y1:ys)

-- Comparación de eficiencia

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

-- Para la comparaciones se usará la siguiente función que construye un

-- triángulo de la altura dada. Por ejemplo,

-- triangulo 2 == [[0],[1,2]]

-- triangulo 3 == [[0],[1,2],[2,3,4]]

-- triangulo 4 == [[0],[1,2],[2,3,4],[3,4,5,6]]

triangulo :: Integer -> [[Integer]]

triangulo n = [[k..k+k] | k <- [0..n-1]]

-- La comparación es

-- (1.97 secs, 876,483,056 bytes)

-- λ> maximaSuma1 (triangulo 19)

-- 342

-- (2.37 secs, 1,833,637,824 bytes)

-- λ> maximaSuma2 (triangulo 19)

-- 342

-- (2.55 secs, 1,804,276,472 bytes)

-- λ> maximaSuma3 (triangulo 19)

-- 342

-- (2.57 secs, 1,804,275,320 bytes)

-- λ> maximaSuma4 (triangulo 19)

-- 342

-- (0.28 secs, 245,469,384 bytes)

-- λ> maximaSuma5 (triangulo 19)

-- 342

-- (0.01 secs, 153,272 bytes)

-- λ> maximaSuma6 (triangulo 19)

-- 342

-- (0.01 secs, 161,360 bytes)

-- λ> maximaSuma7 (triangulo 19)

-- 342

-- (0.01 secs, 187,456 bytes)

-- λ> maximaSuma8 (triangulo 19)

-- 342

-- (0.01 secs, 191,160 bytes)

-- λ> maximaSuma4 (triangulo 22)

-- 462

-- (2.30 secs, 1,963,037,888 bytes)

-- λ> maximaSuma5 (triangulo 22)

-- 462

-- (0.00 secs, 173,512 bytes)

-- λ> maximaSuma6 (triangulo 22)

-- 462

-- (0.01 secs, 182,904 bytes)

-- λ> maximaSuma7 (triangulo 22)

-- 462

-- (0.01 secs, 216,560 bytes)

-- λ> maximaSuma8 (triangulo 22)

-- 462

-- (0.01 secs, 224,160 bytes)

-- λ> maximaSuma5 (triangulo 3000)

-- 8997000

-- (2.25 secs, 2,059,784,792 bytes)

-- λ> maximaSuma6 (triangulo 3000)

-- 8997000

-- (2.15 secs, 2,404,239,896 bytes)

-- λ> maximaSuma7 (triangulo 3000)

-- 8997000

-- (1.53 secs, 2,612,659,504 bytes)

-- λ> maximaSuma8 (triangulo 3000)

-- 8997000

-- (3.47 secs, 3,520,910,256 bytes)

-- λ> maximaSuma7 (triangulo 4000)

-- 15996000

-- (3.12 secs, 4,634,841,200 bytes)

El código se encuentra en GitHub.

Caminos en un triángulo

PorJosé A. Alonso 14-febrero-202223-febrero-2022

Los triángulos se pueden representar mediante listas de listas. Por ejemplo, el triángulo

7 4

2 4 6

8 5 9 3

se representa por

   [[3],[7,4],[2,4,6],[8,5,9,3]]

1	[[3],[7,4],[2,4,6],[8,5,9,3]]

Definir la función

   caminos :: [[a]] -> [[a]]

1	caminos :: [[a]] -> [[a]]

tal que (caminos xss) es la lista de los caminos en el triángulo xss donde los caminos comienzan en el elemento de la primera fila, en cada paso se mueve a uno de sus dos elementos adyacentes en la fila siguiente y terminan en la última fila. Por ejemplo,

   λ> caminos [[3],[7,4]]
   [[3,7],[3,4]]
   λ> caminos [[3],[7,4],[2,4,6]]
   [[3,7,2],[3,7,4],[3,4,4],[3,4,6]]
   λ> caminos [[3],[7,4],[2,4,6],[8,5,9,3]]
   [[3,7,2,8],[3,7,2,5],[3,7,4,5],[3,7,4,9],[3,4,4,5],[3,4,4,9],[3,4,6,9],[3,4,6,3]]

λ> caminos [[3],[7,4]]

[[3,7],[3,4]]

λ> caminos [[3],[7,4],[2,4,6]]

[[3,7,2],[3,7,4],[3,4,4],[3,4,6]]

λ> caminos [[3],[7,4],[2,4,6],[8,5,9,3]]

[[3,7,2,8],[3,7,2,5],[3,7,4,5],[3,7,4,9],[3,4,4,5],[3,4,4,9],[3,4,6,9],[3,4,6,3]]

Soluciones

caminos :: [[a]] -> [[a]]
caminos []    = [[]]
caminos [[x]] = [[x]]
caminos ([x]:[y1,y2]:zs) =
  [x:y1:us | (_:us) <- caminos ([y1] : map init zs)] ++
  [x:y2:vs | (_:vs) <- caminos ([y2] : map tail zs)]

caminos :: [[a]] -> [[a]]

caminos [] = [[]]

caminos [[x]] = [[x]]

caminos ([x]:[y1,y2]:zs) =

[x:y1:us | (_:us) <- caminos ([y1] : map init zs)] ++

[x:y2:vs | (_:vs) <- caminos ([y2] : map tail zs)]

El código se encuentra en GitHub.

Mayor órbita de la sucesión de Collatz

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

Se considera la siguiente operación, aplicable a cualquier número entero positivo:

Si el número es par, se divide entre 2.
Si el número es impar, se multiplica por 3 y se suma 1.

Dado un número cualquiera, podemos calcular su órbita; es decir, las imágenes sucesivas al iterar la función. Por ejemplo, la órbita de 13 es

   13, 40, 20, 10, 5, 16, 8, 4, 2, 1, 4, 2, 1,...

1	13, 40, 20, 10, 5, 16, 8, 4, 2, 1, 4, 2, 1,...

Si observamos este ejemplo, la órbita de 13 es periódica, es decir, se repite indefinidamente a partir de un momento dado). La conjetura de Collatz dice que siempre alcanzaremos el 1 para cualquier número con el que comencemos. Por ejemplo,

Empezando en n = 6 se obtiene 6, 3, 10, 5, 16, 8, 4, 2, 1.
Empezando en n = 11 se obtiene: 11, 34, 17, 52, 26, 13, 40, 20, 10, 5, 16, 8, 4, 2, 1.
Empezando en n = 27, la sucesión tiene 112 pasos, llegando hasta 9232 antes de descender a 1: 27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 364, 182, 91, 274, 137, 412, 206, 103, 310, 155, 466, 233, 700, 350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 167, 502, 251, 754, 377, 1132, 566, 283, 850, 425, 1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429, 7288, 3644, 1822, 911, 2734, 1367, 4102, 2051, 6154, 3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 433, 1300, 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 70, 35, 106, 53, 160, 80, 40, 20, 10, 5, 16, 8, 4, 2, 1.

Definir la función

   mayoresGeneradores :: Integer -> [Integer]

1	mayoresGeneradores :: Integer -> [Integer]

tal que (mayoresGeneradores n) es la lista de los números menores o iguales que n cuyas órbitas de Collatz son las de mayor longitud. Por ejemplo,

   mayoresGeneradores 20      ==  [18,19]
   mayoresGeneradores (10^6)  ==  [837799]

1 2	mayoresGeneradores 20 == [18,19] mayoresGeneradores (10^6) == [837799]

Soluciones

import qualified Data.MemoCombinators as Memo (integral)
import Data.List (genericLength, genericTake, maximumBy)
import Test.QuickCheck (Positive(..), quickCheck)

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

mayoresGeneradores :: Integer -> [Integer]
mayoresGeneradores n =
  [x | (x,y) <- ps, y == m]
  where ps = genericTake n longitudesOrbitas
        m  = maximum (map snd ps)

-- longitudesOrbita es la lista de los números junto a las longitudes de
-- las órbitas de Collatz que generan. Por ejemplo,
--    λ> take 10 longitudesOrbitas
--    [(1,1),(2,2),(3,8),(4,3),(5,6),(6,9),(7,17),(8,4),(9,20),(10,7)]
longitudesOrbitas :: [(Integer, Integer)]
longitudesOrbitas =
  [(n, genericLength (collatz n)) | n <- [1..]]

-- (siguiente n) es el siguiente de n en la sucesión de Collatz. Por
-- ejemplo,
--    siguiente 13  ==  40
--    siguiente 40  ==  20
siguiente :: Integer -> Integer
siguiente n | even n    = n `div` 2
            | otherwise = 3*n+1

-- (collatz1 n) es la órbita de Collatz de n hasta alcanzar el
-- 1. Por ejemplo,
--    collatz 13  ==  [13,40,20,10,5,16,8,4,2,1]

-- 1ª definición de collatz
collatz1 :: Integer -> [Integer]
collatz1 1 = [1]
collatz1 n = n : collatz1 (siguiente n)

-- 2ª definición de collatz
collatz2 :: Integer -> [Integer]
collatz2 n = takeWhile (/=1) (iterate siguiente n) ++ [1]

-- Usaremos la 2ª definición de collatz
collatz :: Integer -> [Integer]
collatz = collatz2

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

mayoresGeneradores2 :: Integer -> [Integer]
mayoresGeneradores2 n =
  [x | (x,y) <- ps, y == m]
  where ps = [(x, longitudOrbita x) | x <- [1..n]]
        m  = maximum (map snd ps)

-- (longitudOrbita x) es la longitud de la órbita de x. Por ejemplo,
--    longitudOrbita 13  ==  10
longitudOrbita :: Integer -> Integer
longitudOrbita 1 = 1
longitudOrbita x = 1 + longitudOrbita (siguiente x)

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

mayoresGeneradores3 :: Integer -> [Integer]
mayoresGeneradores3 n =
  [x | (x,y) <- ps, y == m]
  where ps = [(x, longitudOrbita2 x) | x <- [1..n]]
        m  = maximum (map snd ps)

longitudOrbita2 :: Integer -> Integer
longitudOrbita2 = Memo.integral longitudOrbita2'
  where
    longitudOrbita2' 1 = 1
    longitudOrbita2' x = 1 + longitudOrbita2 (siguiente x)


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

-- La propiedad es
prop_mayoresGeneradores :: (Positive Integer) -> Bool
prop_mayoresGeneradores (Positive n) =
  all (== (mayoresGeneradores n))
      [mayoresGeneradores2 n,
       mayoresGeneradores3 n]

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

-- Comprobación de eficiencia
-- ==========================

-- La comprobación es
--    λ> mayoresGeneradores (10^5)
--    [77031]
--    (5.43 secs, 6,232,320,064 bytes)
--    λ> mayoresGeneradores2 (10^5)
--    [77031]
--    (7.68 secs, 5,238,991,616 bytes)
--    λ> mayoresGeneradores3 (10^5)
--    [77031]
--    (0.88 secs, 571,788,736 bytes)

100

101

102

103

104

import qualified Data.MemoCombinators as Memo (integral)

import Data.List (genericLength, genericTake, maximumBy)

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

-- 1ª solución

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

mayoresGeneradores :: Integer -> [Integer]

mayoresGeneradores n =

[x | (x,y) <- ps, y == m]

where ps = genericTake n longitudesOrbitas

m = maximum (map snd ps)

-- longitudesOrbita es la lista de los números junto a las longitudes de

-- las órbitas de Collatz que generan. Por ejemplo,

-- λ> take 10 longitudesOrbitas

-- [(1,1),(2,2),(3,8),(4,3),(5,6),(6,9),(7,17),(8,4),(9,20),(10,7)]

longitudesOrbitas :: [(Integer, Integer)]

longitudesOrbitas =

[(n, genericLength (collatz n)) | n <- [1..]]

-- (siguiente n) es el siguiente de n en la sucesión de Collatz. Por

-- ejemplo,

-- siguiente 13 == 40

-- siguiente 40 == 20

siguiente :: Integer -> Integer

siguiente n | even n = n `div` 2

| otherwise = 3*n+1

-- (collatz1 n) es la órbita de Collatz de n hasta alcanzar el

-- 1. Por ejemplo,

-- collatz 13 == [13,40,20,10,5,16,8,4,2,1]

-- 1ª definición de collatz

collatz1 :: Integer -> [Integer]

collatz1 1 = [1]

collatz1 n = n : collatz1 (siguiente n)

-- 2ª definición de collatz

collatz2 :: Integer -> [Integer]

collatz2 n = takeWhile (/=1) (iterate siguiente n) ++ [1]

-- Usaremos la 2ª definición de collatz

collatz :: Integer -> [Integer]

collatz = collatz2

-- 2ª solución

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

mayoresGeneradores2 :: Integer -> [Integer]

mayoresGeneradores2 n =

[x | (x,y) <- ps, y == m]

where ps = [(x, longitudOrbita x) | x <- [1..n]]

m = maximum (map snd ps)

-- (longitudOrbita x) es la longitud de la órbita de x. Por ejemplo,

-- longitudOrbita 13 == 10

longitudOrbita :: Integer -> Integer

longitudOrbita 1 = 1

longitudOrbita x = 1 + longitudOrbita (siguiente x)

-- 3ª solución

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

mayoresGeneradores3 :: Integer -> [Integer]

mayoresGeneradores3 n =

[x | (x,y) <- ps, y == m]

where ps = [(x, longitudOrbita2 x) | x <- [1..n]]

m = maximum (map snd ps)

longitudOrbita2 :: Integer -> Integer

longitudOrbita2 = Memo.integral longitudOrbita2'

where

longitudOrbita2' 1 = 1

longitudOrbita2' x = 1 + longitudOrbita2 (siguiente x)

-- Equivalencia de definiciones

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

-- La propiedad es

prop_mayoresGeneradores :: (Positive Integer) -> Bool

prop_mayoresGeneradores (Positive n) =

all (== (mayoresGeneradores n))

[mayoresGeneradores2 n,

mayoresGeneradores3 n]

-- La comprobación es

-- λ> quickCheck prop_mayoresGeneradores

-- +++ OK, passed 100 tests.

-- Comprobación de eficiencia

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

-- La comprobación es

-- λ> mayoresGeneradores (10^5)

-- [77031]

-- (5.43 secs, 6,232,320,064 bytes)

-- λ> mayoresGeneradores2 (10^5)

-- [77031]

-- (7.68 secs, 5,238,991,616 bytes)

-- λ> mayoresGeneradores3 (10^5)

-- [77031]

-- (0.88 secs, 571,788,736 bytes)

El código se encuentra en GitHub.

Ternas pitagóricas con suma dada

PorJosé A. Alonso 10-febrero-202213-octubre-2022

Una terna pitagórica es una terna de números naturales (a,b,c) tal que a<b<c y a^2+b^2=c^2. Por ejemplo (3,4,5) es una terna pitagórica.

Definir la función

   ternasPitagoricas :: Integer -> [(Integer,Integer,Integer)]

1	ternasPitagoricas :: Integer -> [(Integer,Integer,Integer)]

tal que (ternasPitagoricas x) es la lista de las ternas pitagóricas cuya suma es x. Por ejemplo,

   ternasPitagoricas 12     == [(3,4,5)]
   ternasPitagoricas 60     == [(10,24,26),(15,20,25)]
   ternasPitagoricas (10^6) == [(218750,360000,421250),(200000,375000,425000)]

ternasPitagoricas 12 == [(3,4,5)]

ternasPitagoricas 60 == [(10,24,26),(15,20,25)]

ternasPitagoricas (10^6) == [(218750,360000,421250),(200000,375000,425000)]

Soluciones

import Data.List (nub,sort)
import Test.QuickCheck

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

ternasPitagoricas1 :: Integer -> [(Integer,Integer,Integer)]
ternasPitagoricas1 x =
  [(a,b,c) | a <- [0..x],
             b <- [a+1..x],
             c <- [b+1..x],
             a^2 + b^2 == c^2,
             a+b+c == x]

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

ternasPitagoricas2 :: Integer -> [(Integer,Integer,Integer)]
ternasPitagoricas2 x =
  [(a,b,c) | a <- [1..x],
             b <- [a+1..x-a],
             let c = x-a-b,
             a^2+b^2 == c^2]

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

-- Todas las ternas pitagóricas primitivas (a,b,c) pueden representarse
-- por
--    a = m^2 - n^2, b = 2*m*n, c = m^2 + n^2,
-- con 1 <= n < m. (Ver en https://bit.ly/35UNY6L ).

ternasPitagoricas3 :: Integer -> [(Integer,Integer,Integer)]
ternasPitagoricas3 x =
  nub [(d*a,d*b,d*c) | d <- [1..x],
                       x `mod` d == 0,
                      (a,b,c) <- aux (x `div` d)]
  where
    aux y = [(a,b,c) | m <- [2..limite],
                       n <- [1..m-1],
                       let [a,b] = sort [m^2 - n^2, 2*m*n],
                       let c = m^2 + n^2,
                       a+b+c == y]
      where limite = ceiling (sqrt (fromIntegral y))

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

-- La propiedad es
prop_ternasPitagoricas :: Positive Integer -> Bool
prop_ternasPitagoricas (Positive x) =
  all (== (ternasPitagoricas1 x))
      [ternasPitagoricas2 x,
       ternasPitagoricas3 x]

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

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

-- La comparación es
--    λ> ternasPitagoricas1 200
--    [(40,75,85)]
--    (1.90 secs, 2,404,800,856 bytes)
--    λ> ternasPitagoricas2 200
--    [(40,75,85)]
--    (0.06 secs, 19,334,232 bytes)
--    λ> ternasPitagoricas3 200
--    [(40,75,85)]
--    (0.01 secs, 994,224 bytes)
--
--    λ> ternasPitagoricas2 3000
--    [(500,1200,1300),(600,1125,1275),(750,1000,1250)]
--    (4.41 secs, 4,354,148,136 bytes)
--    λ> ternasPitagoricas3 3000
--    [(500,1200,1300),(600,1125,1275),(750,1000,1250)]
--    (0.05 secs, 17,110,360 bytes)

import Data.List (nub,sort)

import Test.QuickCheck

-- 1ª solución --

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

ternasPitagoricas1 :: Integer -> [(Integer,Integer,Integer)]

ternasPitagoricas1 x =

[(a,b,c) | a <- [0..x],

b <- [a+1..x],

c <- [b+1..x],

a^2 + b^2 == c^2,

a+b+c == x]

-- 2ª solución --

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

ternasPitagoricas2 :: Integer -> [(Integer,Integer,Integer)]

ternasPitagoricas2 x =

[(a,b,c) | a <- [1..x],

b <- [a+1..x-a],

let c = x-a-b,

a^2+b^2 == c^2]

-- 3ª solución --

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

-- Todas las ternas pitagóricas primitivas (a,b,c) pueden representarse

-- por

-- a = m^2 - n^2, b = 2*m*n, c = m^2 + n^2,

-- con 1 <= n < m. (Ver en https://bit.ly/35UNY6L ).

ternasPitagoricas3 :: Integer -> [(Integer,Integer,Integer)]

ternasPitagoricas3 x =

nub [(d*a,d*b,d*c) | d <- [1..x],

x `mod` d == 0,

(a,b,c) <- aux (x `div` d)]

where

aux y = [(a,b,c) | m <- [2..limite],

n <- [1..m-1],

let [a,b] = sort [m^2 - n^2, 2*m*n],

let c = m^2 + n^2,

a+b+c == y]

where limite = ceiling (sqrt (fromIntegral y))

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_ternasPitagoricas :: Positive Integer -> Bool

prop_ternasPitagoricas (Positive x) =

all (== (ternasPitagoricas1 x))

[ternasPitagoricas2 x,

ternasPitagoricas3 x]

-- La comprobación es

-- λ> quickCheck prop_ternasPitagoricas

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> ternasPitagoricas1 200

-- [(40,75,85)]

-- (1.90 secs, 2,404,800,856 bytes)

-- λ> ternasPitagoricas2 200

-- [(40,75,85)]

-- (0.06 secs, 19,334,232 bytes)

-- λ> ternasPitagoricas3 200

-- [(40,75,85)]

-- (0.01 secs, 994,224 bytes)

-- λ> ternasPitagoricas2 3000

-- [(500,1200,1300),(600,1125,1275),(750,1000,1250)]

-- (4.41 secs, 4,354,148,136 bytes)

-- λ> ternasPitagoricas3 3000

-- [(500,1200,1300),(600,1125,1275),(750,1000,1250)]

-- (0.05 secs, 17,110,360 bytes)

El código se encuentra en GitHub.

Suma de múltiplos de 3 o de 5

PorJosé A. Alonso 9-febrero-202223-febrero-2022

Los números naturales menores que 10 que son múltiplos de 3 ó 5 son 3, 5, 6 y 9. La suma de estos múltiplos es 23.

Definir la función

   sumaMultiplos :: Integer -> Integer

1	sumaMultiplos :: Integer -> Integer

tal que (sumaMultiplos n) es la suma de todos los múltiplos de 3 ó 5 menores que n. Por ejemplo,

   sumaMultiplos 10      ==  23
   sumaMultiplos (10^2)  ==  2318
   sumaMultiplos (10^3)  ==  233168
   sumaMultiplos (10^4)  ==  23331668
   sumaMultiplos (10^5)  ==  2333316668
   sumaMultiplos (10^6)  ==  233333166668
   sumaMultiplos (10^7)  ==  23333331666668

sumaMultiplos 10 == 23

sumaMultiplos (10^2) == 2318

sumaMultiplos (10^3) == 233168

sumaMultiplos (10^4) == 23331668

sumaMultiplos (10^5) == 2333316668

sumaMultiplos (10^6) == 233333166668

sumaMultiplos (10^7) == 23333331666668

Soluciones

import Data.List (nub, union)
import Test.QuickCheck (Positive(..), quickCheck)

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

sumaMultiplos1 :: Integer -> Integer
sumaMultiplos1 n = sum [x | x <- [1..n-1], multiplo x 3 || multiplo x 5]

-- (multiplo x y) se verifica si x es múltiplo de y. Por ejemplo,
--    multiplo 6 3  ==  True
--    multiplo 6 4  ==  False
multiplo :: Integer -> Integer -> Bool
multiplo x y = mod x y == 0

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

sumaMultiplos2 :: Integer -> Integer
sumaMultiplos2 n = sum [x | x <- [1..n-1], gcd x 15 > 1]

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

sumaMultiplos3 :: Integer -> Integer
sumaMultiplos3 n = sum [3,6..n-1] + sum [5,10..n-1] - sum [15,30..n-1]

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

sumaMultiplos4 :: Integer -> Integer
sumaMultiplos4 n = sum (nub ([3,6..n-1] ++ [5,10..n-1]))

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

sumaMultiplos5 :: Integer -> Integer
sumaMultiplos5 n = sum ([3,6..n-1] `union` [5,10..n-1])

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

sumaMultiplos6 :: Integer -> Integer
sumaMultiplos6 n = suma 3 n + suma 5 n - suma 15 n

-- (suma d x) es la suma de los múltiplos de d menores que x. Por
-- ejemplo,
--    suma 3 10  ==  18
--    suma 5 10  ==  5
suma :: Integer -> Integer -> Integer
suma d x = (a+b)*n `div` 2
    where a = d
          b = d * ((x-1) `div` d)
          n = 1 + (b-a) `div` d

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

-- La propiedad es
prop_sumaMultiplos :: Positive Integer -> Bool
prop_sumaMultiplos (Positive n) =
  all (== (sumaMultiplos1 n))
      [f n | f <- [sumaMultiplos1,
                   sumaMultiplos2,
                   sumaMultiplos3,
                   sumaMultiplos4,
                   sumaMultiplos5,
                   sumaMultiplos6]]

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

-- La comparación es
--    λ> sumaMultiplos1 (5*10^4)
--    583291668
--    (0.05 secs, 21,446,456 bytes)
--    λ> sumaMultiplos2 (5*10^4)
--    583291668
--    (0.05 secs, 26,804,944 bytes)
--    λ> sumaMultiplos3 (5*10^4)
--    583291668
--    (0.01 secs, 5,136,728 bytes)
--    λ> sumaMultiplos4 (5*10^4)
--    583291668
--    (3.05 secs, 7,474,304 bytes)
--    λ> sumaMultiplos5 (5*10^4)
--    583291668
--    (5.14 secs, 12,787,717,152 bytes)
--    λ> sumaMultiplos6 (5*10^4)
--    583291668
--    (0.01 secs, 108,448 bytes)
--
--    λ> sumaMultiplos1 (3*10^6)
--    2099998500000
--    (2.14 secs, 1,281,805,696 bytes)
--    λ> sumaMultiplos2 (3*10^6)
--    2099998500000
--    (1.86 secs, 1,603,407,272 bytes)
--    λ> sumaMultiplos3 (3*10^6)
--    2099998500000
--    (0.39 secs, 304,681,080 bytes)
--    λ> sumaMultiplos6 (3*10^6)
--    2099998500000
--    (0.01 secs, 112,544 bytes)
--
--    λ> sumaMultiplos3 (10^7)
--    23333331666668
--    (1.69 secs, 1,015,468,352 bytes)
--    λ> sumaMultiplos6 (10^7)
--    23333331666668
--    (0.01 secs, 112,336 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

import Data.List (nub, union)

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

-- 1ª solución

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

sumaMultiplos1 :: Integer -> Integer

sumaMultiplos1 n = sum [x | x <- [1..n-1], multiplo x 3 || multiplo x 5]

-- (multiplo x y) se verifica si x es múltiplo de y. Por ejemplo,

-- multiplo 6 3 == True

-- multiplo 6 4 == False

multiplo :: Integer -> Integer -> Bool

multiplo x y = mod x y == 0

-- 2ª solución --

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

sumaMultiplos2 :: Integer -> Integer

sumaMultiplos2 n = sum [x | x <- [1..n-1], gcd x 15 > 1]

-- 3ª solución --

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

sumaMultiplos3 :: Integer -> Integer

sumaMultiplos3 n = sum [3,6..n-1] + sum [5,10..n-1] - sum [15,30..n-1]

-- 4ª solución --

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

sumaMultiplos4 :: Integer -> Integer

sumaMultiplos4 n = sum (nub ([3,6..n-1] ++ [5,10..n-1]))

-- 5ª solución --

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

sumaMultiplos5 :: Integer -> Integer

sumaMultiplos5 n = sum ([3,6..n-1] `union` [5,10..n-1])

-- 6ª solución --

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

sumaMultiplos6 :: Integer -> Integer

sumaMultiplos6 n = suma 3 n + suma 5 n - suma 15 n

-- (suma d x) es la suma de los múltiplos de d menores que x. Por

-- ejemplo,

-- suma 3 10 == 18

-- suma 5 10 == 5

suma :: Integer -> Integer -> Integer

suma d x = (a+b)*n `div` 2

where a = d

b = d * ((x-1) `div` d)

n = 1 + (b-a) `div` d

-- Equivalencia de definiciones

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

-- La propiedad es

prop_sumaMultiplos :: Positive Integer -> Bool

prop_sumaMultiplos (Positive n) =

all (== (sumaMultiplos1 n))

[f n | f <- [sumaMultiplos1,

sumaMultiplos2,

sumaMultiplos3,

sumaMultiplos4,

sumaMultiplos5,

sumaMultiplos6]]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sumaMultiplos1 (5*10^4)

-- 583291668

-- (0.05 secs, 21,446,456 bytes)

-- λ> sumaMultiplos2 (5*10^4)

-- 583291668

-- (0.05 secs, 26,804,944 bytes)

-- λ> sumaMultiplos3 (5*10^4)

-- 583291668

-- (0.01 secs, 5,136,728 bytes)

-- λ> sumaMultiplos4 (5*10^4)

-- 583291668

-- (3.05 secs, 7,474,304 bytes)

-- λ> sumaMultiplos5 (5*10^4)

-- 583291668

-- (5.14 secs, 12,787,717,152 bytes)

-- λ> sumaMultiplos6 (5*10^4)

-- 583291668

-- (0.01 secs, 108,448 bytes)

-- λ> sumaMultiplos1 (3*10^6)

-- 2099998500000

-- (2.14 secs, 1,281,805,696 bytes)

-- λ> sumaMultiplos2 (3*10^6)

-- 2099998500000

-- (1.86 secs, 1,603,407,272 bytes)

-- λ> sumaMultiplos3 (3*10^6)

-- 2099998500000

-- (0.39 secs, 304,681,080 bytes)

-- λ> sumaMultiplos6 (3*10^6)

-- 2099998500000

-- (0.01 secs, 112,544 bytes)

-- λ> sumaMultiplos3 (10^7)

-- 23333331666668

-- (1.69 secs, 1,015,468,352 bytes)

-- λ> sumaMultiplos6 (10^7)

-- 23333331666668

-- (0.01 secs, 112,336 bytes)

El código se encuentra en GitHub.

Exponente en la factorización

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

Definir la función

   exponente :: Integer -> Integer -> Int

1	exponente :: Integer -> Integer -> Int

tal que (exponente x n) es el exponente de x en la factorizacón prima de n (se supone que x > 1 y n > 0). Por ejemplo,

   exponente 2 24  ==  3
   exponente 3 24  ==  1
   exponente 6 24  ==  0
   exponente 7 24  ==  0

exponente 2 24 == 3

exponente 3 24 == 1

exponente 6 24 == 0

exponente 7 24 == 0

Soluciones

import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck

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

exponente1 :: Integer -> Integer -> Int
exponente1 x n
  | esPrimo x = aux n
  | otherwise = 0
  where aux m | m `mod` x == 0 = 1 + aux (m `div` x)
              | otherwise      = 0

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

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

exponente2 :: Integer -> Integer -> Int
exponente2 x n
  | esPrimo x = length (takeWhile (`divisible` x) (iterate (`div` x) n))
  | otherwise = 0

-- (divisible n x) se verifica si ne divisible por x. Por ejemplo,
--    divisible 6 2  ==  True
--    divisible 7 2  ==  False
divisible :: Integer -> Integer -> Bool
divisible n x = n `mod` x == 0

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

exponente3 :: Integer -> Integer -> Int
exponente3 x n =
  length (filter (==x) (primeFactors n))

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

-- La propiedad es
prop_exponente :: Integer -> Integer -> Property
prop_exponente x n =
  x > 1 && n > 0 ==>
  exponente1 x n == exponente2 x n &&
  exponente1 x n == exponente3 x n

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

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

-- 1ª solución

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

exponente1 :: Integer -> Integer -> Int

exponente1 x n

| esPrimo x = aux n

| otherwise = 0

where aux m | m `mod` x == 0 = 1 + aux (m `div` x)

| otherwise = 0

-- (esPrimo x) se verifica si x es un número primo. Por ejemplo,

-- esPrimo 7 == True

-- esPrimo 8 == False

esPrimo :: Integer -> Bool

esPrimo x =

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

-- 2ª solución

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

exponente2 :: Integer -> Integer -> Int

exponente2 x n

| esPrimo x = length (takeWhile (`divisible` x) (iterate (`div` x) n))

| otherwise = 0

-- (divisible n x) se verifica si ne divisible por x. Por ejemplo,

-- divisible 6 2 == True

-- divisible 7 2 == False

divisible :: Integer -> Integer -> Bool

divisible n x = n `mod` x == 0

-- 3ª solución

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

exponente3 :: Integer -> Integer -> Int

exponente3 x n =

length (filter (==x) (primeFactors n))

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_exponente :: Integer -> Integer -> Property

prop_exponente x n =

x > 1 && n > 0 ==>

exponente1 x n == exponente2 x n &&

exponente1 x n == exponente3 x n

-- La comprobación es

-- λ> quickCheck prop_exponente

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

Número de ocurrencias de elementos

PorJosé A. Alonso 7-febrero-202223-febrero-2022

Definir la función

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

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

tal que (ocurrencias xs) es el conjunto de los elementos de xs junto con sus números de ocurrencias. Por ejemplo,

   ocurrenciasElementos1 [3,2,3,1,2,3,5,3] == [(3,4),(2,2),(1,1),(5,1)]
   ocurrenciasElementos1 "tictac"          == [('t',2),('i',1),('c',2),('a',1)]

1 2	ocurrenciasElementos1 [3,2,3,1,2,3,5,3] == [(3,4),(2,2),(1,1),(5,1)] ocurrenciasElementos1 "tictac" == [('t',2),('i',1),('c',2),('a',1)]

Soluciones

import Data.List (group, nub, sort)
import Data.Maybe (fromJust)
import qualified Data.Map as M
import Test.QuickCheck

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

ocurrenciasElementos1 :: Ord a => [a] -> [(a,Int)]
ocurrenciasElementos1 xs =
  [(x,ocurrencias x xs) | x <- nub xs]

-- (ocurrencias x xs) es el número de ocurrencias de x en xs. Por
-- ejemplo,
--    ocurrencias 'a' "Salamanca"  ==  4
ocurrencias :: Ord a => a -> [a] -> Int
ocurrencias x xs = length (filter (==x) xs)

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

ocurrenciasElementos2 :: Ord a => [a] -> [(a,Int)]
ocurrenciasElementos2 xs = map ocurrencias (nub xs)
  where ocurrencias x = (x,fromJust (lookup x (frecuencias xs)))

-- (frecuencias xs) es la lista ordenada de los elementos de xs juntos
-- con sus números de ocurrencias. Por ejemplo,
--    frecuencias [3,2,3,1,2,3,5,3]  ==  [(1,1),(2,2),(3,4),(5,1)]
frecuencias :: Ord a => [a] -> [(a, Int)]
frecuencias xs = [(head ys, length ys) | ys <- group (sort xs)]

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

ocurrenciasElementos3 :: Ord a => [a] -> [(a,Int)]
ocurrenciasElementos3 xs = map ocurrencias (nub xs)
  where diccionario   = dicFrecuencias xs
        ocurrencias x = (x, diccionario M.! x)

-- (dicFrecuencias xs) es el diccionario de los elementos de xs juntos
-- con sus números de ocurrencias. Por ejemplo,
--    λ> dicFrecuencias [3,2,3,1,2,3,5,3]
--    fromList [(1,1),(2,2),(3,4),(5,1)]
dicFrecuencias :: Ord a => [a] -> M.Map a Int
dicFrecuencias xs = M.fromListWith (+) (zip xs (repeat 1))

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

ocurrenciasElementos4 :: Ord a => [a] -> [(a,Int)]
ocurrenciasElementos4 = foldl aux []
  where
    aux [] y                     = [(y,1)]
    aux ((x,k):xs) y | x == y    = (x, k + 1) : xs
                     | otherwise = (x, k) : aux xs y

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

-- La propiedad es
prop_ocurrenciasElementos :: [Integer] -> Bool
prop_ocurrenciasElementos xs =
  all (== (ocurrenciasElementos1 xs))
      [f xs | f <- [ocurrenciasElementos2,
                    ocurrenciasElementos3,
                    ocurrenciasElementos4]]

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

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

-- La comparación es
--    λ> last (ocurrenciasElementos1 (show (product [1..10^5])))
--    ('5',42935)
--    (7.93 secs, 11,325,169,512 bytes)
--    λ> last (ocurrenciasElementos2 (show (product [1..10^5])))
--    ('5',42935)
--    (8.46 secs, 11,750,911,592 bytes)
--    λ> last (ocurrenciasElementos3 (show (product [1..10^5])))
--    ('5',42935)
--    (8.29 secs, 11,447,015,896 bytes)
--    λ> last (ocurrenciasElementos4 (show (product [1..10^5])))
--    ('5',42935)
--    (9.97 secs, 12,129,527,912 bytes)

import Data.List (group, nub, sort)

import Data.Maybe (fromJust)

import qualified Data.Map as M

import Test.QuickCheck

-- 1ª solución

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

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

ocurrenciasElementos1 xs =

[(x,ocurrencias x xs) | x <- nub xs]

-- (ocurrencias x xs) es el número de ocurrencias de x en xs. Por

-- ejemplo,

-- ocurrencias 'a' "Salamanca" == 4

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

ocurrencias x xs = length (filter (==x) xs)

-- 2ª solución

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

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

ocurrenciasElementos2 xs = map ocurrencias (nub xs)

where ocurrencias x = (x,fromJust (lookup x (frecuencias xs)))

-- (frecuencias xs) es la lista ordenada de los elementos de xs juntos

-- con sus números de ocurrencias. Por ejemplo,

-- frecuencias [3,2,3,1,2,3,5,3] == [(1,1),(2,2),(3,4),(5,1)]

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

frecuencias xs = [(head ys, length ys) | ys <- group (sort xs)]

-- 3ª solución

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

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

ocurrenciasElementos3 xs = map ocurrencias (nub xs)

where diccionario = dicFrecuencias xs

ocurrencias x = (x, diccionario M.! x)

-- (dicFrecuencias xs) es el diccionario de los elementos de xs juntos

-- con sus números de ocurrencias. Por ejemplo,

-- λ> dicFrecuencias [3,2,3,1,2,3,5,3]

-- fromList [(1,1),(2,2),(3,4),(5,1)]

dicFrecuencias :: Ord a => [a] -> M.Map a Int

dicFrecuencias xs = M.fromListWith (+) (zip xs (repeat 1))

-- 4ª solución

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

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

ocurrenciasElementos4 = foldl aux []

where

aux [] y = [(y,1)]

aux ((x,k):xs) y | x == y = (x, k + 1) : xs

| otherwise = (x, k) : aux xs y

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_ocurrenciasElementos :: [Integer] -> Bool

prop_ocurrenciasElementos xs =

all (== (ocurrenciasElementos1 xs))

[f xs | f <- [ocurrenciasElementos2,

ocurrenciasElementos3,

ocurrenciasElementos4]]

-- La comprobación es

-- λ> quickCheck prop_ocurrenciasElementos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (ocurrenciasElementos1 (show (product [1..10^5])))

-- ('5',42935)

-- (7.93 secs, 11,325,169,512 bytes)

-- λ> last (ocurrenciasElementos2 (show (product [1..10^5])))

-- ('5',42935)

-- (8.46 secs, 11,750,911,592 bytes)

-- λ> last (ocurrenciasElementos3 (show (product [1..10^5])))

-- ('5',42935)

-- (8.29 secs, 11,447,015,896 bytes)

-- λ> last (ocurrenciasElementos4 (show (product [1..10^5])))

-- ('5',42935)

-- (9.97 secs, 12,129,527,912 bytes)

El código se encuentra en GitHub.

Reconocimiento de potencias de 4

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

Definir la función

   esPotenciaDe4 :: Integral a => a -> Bool

1	esPotenciaDe4 :: Integral a => a -> Bool

tal que (esPotenciaDe4 n) se verifica si n es una potencia de 4. Por ejemplo,

   esPotenciaDe4 16                ==  True
   esPotenciaDe4 17                ==  False
   esPotenciaDe4 (4^(4*10^5))      ==  True
   esPotenciaDe4 (1 + 4^(4*10^5))  ==  False

esPotenciaDe4 16 == True

esPotenciaDe4 17 == False

esPotenciaDe4 (4^(4*10^5)) == True

esPotenciaDe4 (1 + 4^(4*10^5)) == False

Soluciones

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

esPotenciaDe4_1 :: Integral a => a -> Bool
esPotenciaDe4_1 0 = False
esPotenciaDe4_1 1 = True
esPotenciaDe4_1 n = n `mod` 4 == 0 && esPotenciaDe4_1 (n `div` 4)

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

esPotenciaDe4_2 :: Integral a => a -> Bool
esPotenciaDe4_2 n = n `pertenece` potenciasDe4

-- potenciassDe4 es la lista de las potencias de 4. Por ejemplo,
--    take 5 potenciasDe4  ==  [1,4,16,64,256]
potenciasDe4 :: Integral a => [a]
potenciasDe4 = [4^x | x <- [0..]]

-- (pertenece x ys) se verifica si x pertenece a la lista ordenada
-- (posiblemente infinita xs). Por ejemplo,
--    pertenece 8 [2,4..]  ==  True
--    pertenece 9 [2,4..]  ==  False
pertenece :: Integral a => a -> [a] -> Bool
pertenece x ys = x == head (dropWhile (<x) ys)

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

esPotenciaDe4_3 :: Integral a => a -> Bool
esPotenciaDe4_3 n = n `pertenece` potenciasDe4_2

-- potenciassDe4 es la lista de las potencias de 4. Por ejemplo,
--    take 5 potenciasDe4  ==  [1,4,16,64,256]
potenciasDe4_2 :: Integral a => [a]
potenciasDe4_2 = iterate (*4) 1

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

esPotenciaDe4_4 :: Integral n => n -> Bool
esPotenciaDe4_4 n =
  n == head (dropWhile (<n) (iterate (*4) 1))

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

esPotenciaDe4_5 :: Integral n => n -> Bool
esPotenciaDe4_5 n =
  n == until (>=n) (*4) 1

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

-- La comparación es
--    λ> esPotenciaDe4_1 (4^(4*10^4))
--    True
--    (0.18 secs, 233,903,248 bytes)
--    λ> esPotenciaDe4_2 (4^(4*10^4))
--    True
--    (2.01 secs, 756,125,712 bytes)
--    λ> esPotenciaDe4_3 (4^(4*10^4))
--    True
--    (0.05 secs, 212,019,464 bytes)
--    λ> esPotenciaDe4_4 (4^(4*10^4))
--    True
--    (0.05 secs, 212,019,368 bytes)
--    λ> esPotenciaDe4_5 (4^(4*10^4))
--    True
--    (0.07 secs, 209,779,888 bytes)
--
--    λ> esPotenciaDe4_3 (4^(2*10^5))
--    True
--    (0.64 secs, 5,184,667,280 bytes)
--    λ> esPotenciaDe4_4 (4^(2*10^5))
--    True
--    (0.64 secs, 5,184,667,200 bytes)
--    λ> esPotenciaDe4_5 (4^(2*10^5))
--    True
--    (0.63 secs, 5,173,467,656 bytes)
--
--    λ> esPotenciaDe4_3 (4^(4*10^5))
--    True
--    (2.27 secs, 20,681,727,464 bytes)
--    λ> esPotenciaDe4_4 (4^(4*10^5))
--    True
--    (2.30 secs, 20,681,727,320 bytes)
--    λ> esPotenciaDe4_5 (4^(4*10^5))
--    True
--    (2.28 secs, 20,659,327,352 bytes)

-- 1ª solución

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

esPotenciaDe4_1 :: Integral a => a -> Bool

esPotenciaDe4_1 0 = False

esPotenciaDe4_1 1 = True

esPotenciaDe4_1 n = n `mod` 4 == 0 && esPotenciaDe4_1 (n `div` 4)

-- 2ª solución

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

esPotenciaDe4_2 :: Integral a => a -> Bool

esPotenciaDe4_2 n = n `pertenece` potenciasDe4

-- potenciassDe4 es la lista de las potencias de 4. Por ejemplo,

-- take 5 potenciasDe4 == [1,4,16,64,256]

potenciasDe4 :: Integral a => [a]

potenciasDe4 = [4^x | x <- [0..]]

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

-- (posiblemente infinita xs). Por ejemplo,

-- pertenece 8 [2,4..] == True

-- pertenece 9 [2,4..] == False

pertenece :: Integral a => a -> [a] -> Bool

pertenece x ys = x == head (dropWhile (<x) ys)

-- 3ª solución

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

esPotenciaDe4_3 :: Integral a => a -> Bool

esPotenciaDe4_3 n = n `pertenece` potenciasDe4_2

-- potenciassDe4 es la lista de las potencias de 4. Por ejemplo,

-- take 5 potenciasDe4 == [1,4,16,64,256]

potenciasDe4_2 :: Integral a => [a]

potenciasDe4_2 = iterate (*4) 1

-- 4ª solución

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

esPotenciaDe4_4 :: Integral n => n -> Bool

esPotenciaDe4_4 n =

n == head (dropWhile (<n) (iterate (*4) 1))

-- 5ª solución

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

esPotenciaDe4_5 :: Integral n => n -> Bool

esPotenciaDe4_5 n =

n == until (>=n) (*4) 1

-- Comparación de eficiencia

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

-- La comparación es

-- λ> esPotenciaDe4_1 (4^(4*10^4))

-- True

-- (0.18 secs, 233,903,248 bytes)

-- λ> esPotenciaDe4_2 (4^(4*10^4))

-- True

-- (2.01 secs, 756,125,712 bytes)

-- λ> esPotenciaDe4_3 (4^(4*10^4))

-- True

-- (0.05 secs, 212,019,464 bytes)

-- λ> esPotenciaDe4_4 (4^(4*10^4))

-- True

-- (0.05 secs, 212,019,368 bytes)

-- λ> esPotenciaDe4_5 (4^(4*10^4))

-- True

-- (0.07 secs, 209,779,888 bytes)

-- λ> esPotenciaDe4_3 (4^(2*10^5))

-- True

-- (0.64 secs, 5,184,667,280 bytes)

-- λ> esPotenciaDe4_4 (4^(2*10^5))

-- True

-- (0.64 secs, 5,184,667,200 bytes)

-- λ> esPotenciaDe4_5 (4^(2*10^5))

-- True

-- (0.63 secs, 5,173,467,656 bytes)

-- λ> esPotenciaDe4_3 (4^(4*10^5))

-- True

-- (2.27 secs, 20,681,727,464 bytes)

-- λ> esPotenciaDe4_4 (4^(4*10^5))

-- True

-- (2.30 secs, 20,681,727,320 bytes)

-- λ> esPotenciaDe4_5 (4^(4*10^5))

-- True

-- (2.28 secs, 20,659,327,352 bytes)

El código se encuentra en GitHub.

Producto de los elementos de la diagonal principal

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

Las matrices se pueden representar como lista de listas de la misma longitud, donde cada uno de sus elementos representa una fila de la matriz.

Definir la función

   productoDiagonalPrincipal :: Num a => [[a]] -> a

1	productoDiagonalPrincipal :: Num a => [[a]] -> a

tal que (productoDiagonalPrincipal xss) es el producto de los elementos de la diagonal principal de la matriz cuadrada xss. Por ejemplo,

   productoDiagonal1 [[3,5,2],[4,7,1],[6,9,8]]  ==  168
   productoDiagonal1 (replicate 5 [1..5])       ==  120
   length (show (productoDiagonal3 (replicate 30000 [1..30000])))  ==  121288

productoDiagonal1 [[3,5,2],[4,7,1],[6,9,8]] == 168

productoDiagonal1 (replicate 5 [1..5]) == 120

length (show (productoDiagonal3 (replicate 30000 [1..30000]))) == 121288

Soluciones

import Data.List (genericReplicate)

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

productoDiagonal1 :: Num a => [[a]] -> a
productoDiagonal1 xss = product (diagonal1 xss)

-- (diagonal1 xss) es la diagonal de la matriz xss. Por ejemplo,
--    diagonal1 [[3,5,2],[4,7,1],[6,9,0]]  ==  [3,7,0]
--    diagonal1 [[3,5],[4,7],[6,9]]        ==  [3,7]
--    diagonal1 [[3,5,2],[4,7,1]]          ==  [3,7]
diagonal1 :: [[a]] -> [a]
diagonal1 ((x:_):xss) = x : diagonal1 (map tail xss)
diagonal1 _           = []

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

productoDiagonal2 :: Num a => [[a]] -> a
productoDiagonal2 = product . diagonal1

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

productoDiagonal3 :: Num a => [[a]] -> a
productoDiagonal3 = product . diagonal3

diagonal3 :: [[a]] -> [a]
diagonal3 xss = [xs !! k | (xs,k) <- zip xss [0..n]]
  where n = length (head xss) - 1

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

productoDiagonal4 :: Num a => [[a]] -> a
productoDiagonal4 []          = 1
productoDiagonal4 [[]]        = 1
productoDiagonal4 ((x:_):xss) = x * productoDiagonal4 (map tail xss)

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

productoDiagonal5 :: Num a => [[a]] -> a
productoDiagonal5 xss = product (zipWith (!!) xss [0..k])
  where m = length xss
        n = length (head xss)
        k = min m n - 1

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

ejemplo :: Integer -> [[Integer]]
ejemplo n = genericReplicate n [1..n]

-- La comparación es
--    λ> length (show (productoDiagonal1 (ejemplo 7000)))
--    23878
--    (1.23 secs, 3,396,129,424 bytes)
--    λ> length (show (productoDiagonal2 (ejemplo 7000)))
--    23878
--    (0.94 secs, 3,396,127,680 bytes)
--    λ> length (show (productoDiagonal3 (ejemplo 7000)))
--    23878
--    (0.09 secs, 44,841,864 bytes)
--    λ> length (show (productoDiagonal4 (ejemplo 7000)))
--    23878
--    (0.96 secs, 3,614,137,840 bytes)
--    λ> length (show (productoDiagonal5 (ejemplo 7000)))
--    23878
--    (0.07 secs, 44,168,984 bytes)
--
--    λ> length (show (productoDiagonal3 (ejemplo 70000)))
--    308760
--    (8.26 secs, 5,359,752,408 bytes)
--    λ> length (show (productoDiagonal5 (ejemplo 70000)))
--    308760
--    (9.34 secs, 5,353,035,656 bytes)

import Data.List (genericReplicate)

-- 1ª solución

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

productoDiagonal1 :: Num a => [[a]] -> a

productoDiagonal1 xss = product (diagonal1 xss)

-- (diagonal1 xss) es la diagonal de la matriz xss. Por ejemplo,

-- diagonal1 [[3,5,2],[4,7,1],[6,9,0]] == [3,7,0]

-- diagonal1 [[3,5],[4,7],[6,9]] == [3,7]

-- diagonal1 [[3,5,2],[4,7,1]] == [3,7]

diagonal1 :: [[a]] -> [a]

diagonal1 ((x:_):xss) = x : diagonal1 (map tail xss)

diagonal1 _ = []

-- 2ª solución

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

productoDiagonal2 :: Num a => [[a]] -> a

productoDiagonal2 = product . diagonal1

-- 3ª solución

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

productoDiagonal3 :: Num a => [[a]] -> a

productoDiagonal3 = product . diagonal3

diagonal3 :: [[a]] -> [a]

diagonal3 xss = [xs !! k | (xs,k) <- zip xss [0..n]]

where n = length (head xss) - 1

-- 4ª solución

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

productoDiagonal4 :: Num a => [[a]] -> a

productoDiagonal4 [] = 1

productoDiagonal4 [[]] = 1

productoDiagonal4 ((x:_):xss) = x * productoDiagonal4 (map tail xss)

-- 5ª solución

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

productoDiagonal5 :: Num a => [[a]] -> a

productoDiagonal5 xss = product (zipWith (!!) xss [0..k])

where m = length xss

n = length (head xss)

k = min m n - 1

-- Comparación de eficiencia

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

ejemplo :: Integer -> [[Integer]]

ejemplo n = genericReplicate n [1..n]

-- La comparación es

-- λ> length (show (productoDiagonal1 (ejemplo 7000)))

-- 23878

-- (1.23 secs, 3,396,129,424 bytes)

-- λ> length (show (productoDiagonal2 (ejemplo 7000)))

-- 23878

-- (0.94 secs, 3,396,127,680 bytes)

-- λ> length (show (productoDiagonal3 (ejemplo 7000)))

-- 23878

-- (0.09 secs, 44,841,864 bytes)

-- λ> length (show (productoDiagonal4 (ejemplo 7000)))

-- 23878

-- (0.96 secs, 3,614,137,840 bytes)

-- λ> length (show (productoDiagonal5 (ejemplo 7000)))

-- 23878

-- (0.07 secs, 44,168,984 bytes)

-- λ> length (show (productoDiagonal3 (ejemplo 70000)))

-- 308760

-- (8.26 secs, 5,359,752,408 bytes)

-- λ> length (show (productoDiagonal5 (ejemplo 70000)))

-- 308760

-- (9.34 secs, 5,353,035,656 bytes)

El código se encuentra en GitHub.

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico