Inicial – Página 2

Matriz de mínimas distancias

PorJosé A. Alonso 22-abril-202029-abril-2020

Definir las funciones

   minimasDistancias             :: Matrix Int -> Matrix Int
   sumaMinimaDistanciasIdentidad :: Int -> Int

1 2	minimasDistancias :: Matrix Int -> Matrix Int sumaMinimaDistanciasIdentidad :: Int -> Int

tales que

(mininasDistancias a) es la matriz de las mínimas distancias de cada elemento de a hasta alcanzar un 1 donde un paso es un movimiento hacia la izquierda, derecha, arriba o abajo. Por ejemplo,

     λ> minimasDistancias (fromLists [[0,1,1],[0,0,1]])
     ( 1 0 0 )
     ( 2 1 0 )
     λ> minimasDistancias (fromLists [[0,0,1],[1,0,0]])
     ( 1 1 0 )
     ( 0 1 1 )
     λ> minimasDistancias (identity 5)
     ( 0 1 2 3 4 )
     ( 1 0 1 2 3 )
     ( 2 1 0 1 2 )
     ( 3 2 1 0 1 )
     ( 4 3 2 1 0 )

λ> minimasDistancias (fromLists [[0,1,1],[0,0,1]])

( 1 0 0 )

( 2 1 0 )

λ> minimasDistancias (fromLists [[0,0,1],[1,0,0]])

( 1 1 0 )

( 0 1 1 )

λ> minimasDistancias (identity 5)

( 0 1 2 3 4 )

( 1 0 1 2 3 )

( 2 1 0 1 2 )

( 3 2 1 0 1 )

( 4 3 2 1 0 )

(sumaMinimaDistanciasIdentidad n) es la suma de los elementos de la matriz de las mínimas distancias correspondiente a la matriz identidad de orden n. Por ejemplo,

     sumaMinimaDistanciasIdentidad 5       ==  40
     sumaMinimaDistanciasIdentidad (10^2)  ==  333300
     sumaMinimaDistanciasIdentidad (10^4)  ==  333333330000
     sumaMinimaDistanciasIdentidad (10^6)  ==  333333333333000000

sumaMinimaDistanciasIdentidad 5 == 40

sumaMinimaDistanciasIdentidad (10^2) == 333300

sumaMinimaDistanciasIdentidad (10^4) == 333333330000

sumaMinimaDistanciasIdentidad (10^6) == 333333333333000000

Soluciones

import Data.Matrix     
import Data.Maybe      
import Test.QuickCheck 

-- 1ª definición de minimasDistancias
-- ==================================

minimasDistancias :: Matrix Int -> Matrix Int
minimasDistancias a = 
  matrix (nrows a) (ncols a) (\(i,j) -> minimaDistancia (i,j) a) 
 
minimaDistancia :: (Int,Int) -> Matrix Int -> Int
minimaDistancia (a,b) p =
  minimum [distancia (a,b) (c,d) | (c,d) <- unos p]
 
unos :: Matrix Int -> [(Int,Int)]
unos p = [(i,j) | i <- [1..nrows p]
                , j <- [1..ncols p]
                , p ! (i,j) == 1]
 
distancia :: (Int,Int) -> (Int,Int) -> Int
distancia (a,b) (c,d) = abs (c - a) + abs (d - b)

-- 2ª definición de minimasDistancias
-- ==================================

minimasDistancias2 :: Matrix Int -> Matrix Int
minimasDistancias2 a = fmap fromJust (aux (matrizInicial a))
  where aux b | Nothing `elem` c = aux c
              | otherwise        = c
          where c = propagacion b

-- (matrizInicial a) es la matriz que tiene (Just 0) en los elementos de
-- a iguales a 1 y Nothing en los restantes. Por ejemplo,
--    λ> matrizInicial (fromLists [[0,0,1],[1,0,0]])
--    ( Nothing Nothing  Just 0 )
--    (  Just 0 Nothing Nothing )
matrizInicial :: Matrix Int -> Matrix (Maybe Int)
matrizInicial a = matrix m n f
  where m = nrows a
        n = ncols a
        f (i,j) | a ! (i,j) == 1 = Just 0
                | otherwise      = Nothing

-- (propagacion a) es la matriz obtenida cambiando los elementos Nothing
-- de a por el siguiente del mínimo de los valores de sus vecinos. Por
-- ejemplo,
--    λ> propagacion (fromLists [[0,1,1],[0,0,1]])
--    (  Just 1  Just 0  Just 0 )
--    ( Nothing  Just 1  Just 0 )
--    
--    λ> propagacion it
--    ( Just 1 Just 0 Just 0 )
--    ( Just 2 Just 1 Just 0 )
propagacion :: Matrix (Maybe Int) -> Matrix (Maybe Int)
propagacion a = matrix m n f
  where
    m = nrows a
    n = ncols a
    f (i,j) | isJust x  = x
            | otherwise = siguiente (minimo (valoresVecinos a (i,j)))
      where x = a ! (i,j)

-- (valoresVecinos a p) es la lista de los valores de los vecinos la
-- posición p en la matriz a. Por ejemplo,             
--    λ> a = fromList 3 4 [1..]
--    λ> a
--    (  1  2  3  4 )
--    (  5  6  7  8 )
--    (  9 10 11 12 )
--    
--    λ> valoresVecinos a (1,1)
--    [5,2]
--    λ> valoresVecinos a (2,3)
--    [3,11,6,8]
--    λ> valoresVecinos a (2,4)
--    [4,12,7]
valoresVecinos :: Matrix a -> (Int,Int) -> [a]
valoresVecinos a (i,j) = [a ! (k,l) | (k,l) <- vecinos m n (i,j)]
  where m = nrows a
        n = ncols a

-- (vecinos m n p) es la lista de las posiciones vecinas de la posición
-- p en la matriz a; es decir, los que se encuentran a su izquierda,
-- derecha, arriba o abajo. por ejemplo,
--    vecinos 3 4 (1,1)  ==  [(2,1),(1,2)]
--    vecinos 3 4 (2,3)  ==  [(1,3),(3,3),(2,2),(2,4)]
--    vecinos 3 4 (2,4)  ==  [(1,4),(3,4),(2,3)]
vecinos :: Int -> Int -> (Int,Int) -> [(Int,Int)]
vecinos m n (i,j) = [(i - 1,j)     | i > 1] ++
                    [(i + 1,j)     | i < m] ++
                    [(i,    j - 1) | j > 1] ++
                    [(i,    j + 1) | j < n]

-- (minimo xs) es el mínimo de la lista de valores opcionales xs
-- (considerando Nothing como el mayor elemento). Por ejemplo,
--    minimo [Just 3, Nothing, Just 2]  ==  Just 2
minimo :: [Maybe Int] -> Maybe Int
minimo = foldr1 minimo2

-- (minimo2 x y) es el mínimo de los valores opcionales x e y
-- (considerando Nothing como el mayor elemento). Por ejemplo,
--    minimo2 (Just 3) (Just 2)  ==  Just 2
--    minimo2 (Just 1) (Just 2)  ==  Just 1
--    minimo2 (Just 1) Nothing   ==  Just 1
--    minimo2 Nothing (Just 2)   ==  Just 2
--    minimo2 Nothing Nothing    ==  Nothing
minimo2 :: Maybe Int -> Maybe Int -> Maybe Int
minimo2 (Just x) (Just y) = Just (min x y)
minimo2 Nothing  (Just y) = Just y
minimo2 (Just x) Nothing  = Just x
minimo2 Nothing  Nothing  = Nothing

-- (siguiente x) es el siguiente elemento del opcional x (considerando
-- Nothing como el infinito). Por ejemplo, 
--    siguiente (Just 3)  ==  Just 4
--    siguiente Nothing  ==  Nothing
siguiente :: Maybe Int -> Maybe Int
siguiente (Just x) = Just (1 + x)
siguiente Nothing  = Nothing

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

-- La comparación es
--    λ> maximum (minimasDistancias (identity 40))
--    39
--    (3.85 secs, 654,473,496 bytes)
--    λ> maximum (minimasDistancias2 (identity 40))
--    39
--    (0.50 secs, 75,079,912 bytes)

-- 1ª definición de sumaMinimaDistanciasIdentidad
-- ==============================================

sumaMinimaDistanciasIdentidad :: Int -> Int
sumaMinimaDistanciasIdentidad n =
  sum (minimasDistancias (identity n))

-- 2ª definición de sumaMinimaDistanciasIdentidad
-- ==============================================

sumaMinimaDistanciasIdentidad2 :: Int -> Int
sumaMinimaDistanciasIdentidad2 n =
  n*(n^2-1) `div` 3

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

-- La propiedad es
prop_MinimaDistanciasIdentidad :: Positive Int -> Bool
prop_MinimaDistanciasIdentidad (Positive n) =
  sumaMinimaDistanciasIdentidad n == sumaMinimaDistanciasIdentidad2 n

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=50}) prop_MinimaDistanciasIdentidad
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> sumaMinimaDistanciasIdentidad 50
--    41650
--    (0.24 secs, 149,395,744 bytes)
--    λ> sumaMinimaDistanciasIdentidad 100
--    333300
--    (1.98 secs, 1,294,676,272 bytes)
--    λ> sumaMinimaDistanciasIdentidad 200
--    2666600
--    (17.96 secs, 11,094,515,016 bytes)
--    
--    λ> sumaMinimaDistanciasIdentidad2 50
--    41650
--    (0.00 secs, 126,944 bytes)
--    λ> sumaMinimaDistanciasIdentidad2 100
--    333300
--    (0.00 secs, 126,872 bytes)
--    λ> sumaMinimaDistanciasIdentidad2 200
--    2666600
--    (0.00 secs, 131,240 bytes)
--
-- Resumidamente, el tiempo es
--
--    +-----+---------+--------+
--    |   n | 1ª def. | 2ª def |
--    +-----+---------+--------+
--    |  50 |  0.24   | 0.00   |
--    | 100 |  1.98   | 0.00   |
--    | 200 | 17.96   | 0.00   | 
--    +-----+---------+--------+

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

import Data.Matrix

import Data.Maybe

import Test.QuickCheck

-- 1ª definición de minimasDistancias

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

minimasDistancias :: Matrix Int -> Matrix Int

minimasDistancias a =

matrix (nrows a) (ncols a) (\(i,j) -> minimaDistancia (i,j) a)

minimaDistancia :: (Int,Int) -> Matrix Int -> Int

minimaDistancia (a,b) p =

minimum [distancia (a,b) (c,d) | (c,d) <- unos p]

unos :: Matrix Int -> [(Int,Int)]

unos p = [(i,j) | i <- [1..nrows p]

, j <- [1..ncols p]

, p ! (i,j) == 1]

distancia :: (Int,Int) -> (Int,Int) -> Int

distancia (a,b) (c,d) = abs (c - a) + abs (d - b)

-- 2ª definición de minimasDistancias

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

minimasDistancias2 :: Matrix Int -> Matrix Int

minimasDistancias2 a = fmap fromJust (aux (matrizInicial a))

where aux b | Nothing `elem` c = aux c

| otherwise = c

where c = propagacion b

-- (matrizInicial a) es la matriz que tiene (Just 0) en los elementos de

-- a iguales a 1 y Nothing en los restantes. Por ejemplo,

-- λ> matrizInicial (fromLists [[0,0,1],[1,0,0]])

-- ( Nothing Nothing Just 0 )

-- ( Just 0 Nothing Nothing )

matrizInicial :: Matrix Int -> Matrix (Maybe Int)

matrizInicial a = matrix m n f

where m = nrows a

n = ncols a

f (i,j) | a ! (i,j) == 1 = Just 0

| otherwise = Nothing

-- (propagacion a) es la matriz obtenida cambiando los elementos Nothing

-- de a por el siguiente del mínimo de los valores de sus vecinos. Por

-- ejemplo,

-- λ> propagacion (fromLists [[0,1,1],[0,0,1]])

-- ( Just 1 Just 0 Just 0 )

-- ( Nothing Just 1 Just 0 )

-- λ> propagacion it

-- ( Just 1 Just 0 Just 0 )

-- ( Just 2 Just 1 Just 0 )

propagacion :: Matrix (Maybe Int) -> Matrix (Maybe Int)

propagacion a = matrix m n f

where

m = nrows a

n = ncols a

f (i,j) | isJust x = x

| otherwise = siguiente (minimo (valoresVecinos a (i,j)))

where x = a ! (i,j)

-- (valoresVecinos a p) es la lista de los valores de los vecinos la

-- posición p en la matriz a. Por ejemplo,

-- λ> a = fromList 3 4 [1..]

-- λ> a

-- ( 1 2 3 4 )

-- ( 5 6 7 8 )

-- ( 9 10 11 12 )

-- λ> valoresVecinos a (1,1)

-- [5,2]

-- λ> valoresVecinos a (2,3)

-- [3,11,6,8]

-- λ> valoresVecinos a (2,4)

-- [4,12,7]

valoresVecinos :: Matrix a -> (Int,Int) -> [a]

valoresVecinos a (i,j) = [a ! (k,l) | (k,l) <- vecinos m n (i,j)]

where m = nrows a

n = ncols a

-- (vecinos m n p) es la lista de las posiciones vecinas de la posición

-- p en la matriz a; es decir, los que se encuentran a su izquierda,

-- derecha, arriba o abajo. por ejemplo,

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

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

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

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

vecinos m n (i,j) = [(i - 1,j) | i > 1] ++

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

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

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

-- (minimo xs) es el mínimo de la lista de valores opcionales xs

-- (considerando Nothing como el mayor elemento). Por ejemplo,

-- minimo [Just 3, Nothing, Just 2] == Just 2

minimo :: [Maybe Int] -> Maybe Int

minimo = foldr1 minimo2

-- (minimo2 x y) es el mínimo de los valores opcionales x e y

-- (considerando Nothing como el mayor elemento). Por ejemplo,

-- minimo2 (Just 3) (Just 2) == Just 2

-- minimo2 (Just 1) (Just 2) == Just 1

-- minimo2 (Just 1) Nothing == Just 1

-- minimo2 Nothing (Just 2) == Just 2

-- minimo2 Nothing Nothing == Nothing

minimo2 :: Maybe Int -> Maybe Int -> Maybe Int

minimo2 (Just x) (Just y) = Just (min x y)

minimo2 Nothing (Just y) = Just y

minimo2 (Just x) Nothing = Just x

minimo2 Nothing Nothing = Nothing

-- (siguiente x) es el siguiente elemento del opcional x (considerando

-- Nothing como el infinito). Por ejemplo,

-- siguiente (Just 3) == Just 4

-- siguiente Nothing == Nothing

siguiente :: Maybe Int -> Maybe Int

siguiente (Just x) = Just (1 + x)

siguiente Nothing = Nothing

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximum (minimasDistancias (identity 40))

-- 39

-- (3.85 secs, 654,473,496 bytes)

-- λ> maximum (minimasDistancias2 (identity 40))

-- 39

-- (0.50 secs, 75,079,912 bytes)

-- 1ª definición de sumaMinimaDistanciasIdentidad

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

sumaMinimaDistanciasIdentidad :: Int -> Int

sumaMinimaDistanciasIdentidad n =

sum (minimasDistancias (identity n))

-- 2ª definición de sumaMinimaDistanciasIdentidad

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

sumaMinimaDistanciasIdentidad2 :: Int -> Int

sumaMinimaDistanciasIdentidad2 n =

n*(n^2-1) `div` 3

-- Equivalencia de las definiciones de sumaMinimaDistanciasIdentidad

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

-- La propiedad es

prop_MinimaDistanciasIdentidad :: Positive Int -> Bool

prop_MinimaDistanciasIdentidad (Positive n) =

sumaMinimaDistanciasIdentidad n == sumaMinimaDistanciasIdentidad2 n

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=50}) prop_MinimaDistanciasIdentidad

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia de sumaMinimaDistanciasIdentidad

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

-- La comparación es

-- λ> sumaMinimaDistanciasIdentidad 50

-- 41650

-- (0.24 secs, 149,395,744 bytes)

-- λ> sumaMinimaDistanciasIdentidad 100

-- 333300

-- (1.98 secs, 1,294,676,272 bytes)

-- λ> sumaMinimaDistanciasIdentidad 200

-- 2666600

-- (17.96 secs, 11,094,515,016 bytes)

-- λ> sumaMinimaDistanciasIdentidad2 50

-- 41650

-- (0.00 secs, 126,944 bytes)

-- λ> sumaMinimaDistanciasIdentidad2 100

-- 333300

-- (0.00 secs, 126,872 bytes)

-- λ> sumaMinimaDistanciasIdentidad2 200

-- 2666600

-- (0.00 secs, 131,240 bytes)

-- Resumidamente, el tiempo es

-- +-----+---------+--------+

-- | n | 1ª def. | 2ª def |

-- +-----+---------+--------+

-- | 50 | 0.24 | 0.00 |

-- | 100 | 1.98 | 0.00 |

-- | 200 | 17.96 | 0.00 |

-- +-----+---------+--------+

Otras soluciones

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

Suma de segmentos iniciales

PorJosé A. Alonso 20-abril-20203-mayo-2020

Los segmentos iniciales de [3,1,2,5] son [3], [3,1], [3,1,2] y [3,1,2,5]. Sus sumas son 3, 4, 6 y 9, respectivamente. La suma de dichas sumas es 24.

Definir la función

   sumaSegmentosIniciales :: [Integer] -> Integer

1	sumaSegmentosIniciales :: [Integer] -> Integer

tal que (sumaSegmentosIniciales xs) es la suma de las sumas de los segmentos iniciales de xs. Por ejemplo,

   sumaSegmentosIniciales [3,1,2,5]     ==  24
   sumaSegmentosIniciales [1..3*10^6]  ==  4500004500001000000

1 2	sumaSegmentosIniciales [3,1,2,5] == 24 sumaSegmentosIniciales [1..3*10^6] == 4500004500001000000

Comprobar con QuickCheck que la suma de las sumas de los segmentos iniciales de la lista formada por n veces el número uno es el n-ésimo número triangular; es decir que

   sumaSegmentosIniciales (genericReplicate n 1)

1	sumaSegmentosIniciales (genericReplicate n 1)

es igual a

   n * (n + 1) `div` 2

1	n * (n + 1) `div` 2

Soluciones

import Data.List (genericLength, genericReplicate)
import Test.QuickCheck

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

sumaSegmentosIniciales :: [Integer] -> Integer
sumaSegmentosIniciales xs =
  sum [sum (take k xs) | k <- [1.. length xs]]

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

sumaSegmentosIniciales2 :: [Integer] -> Integer
sumaSegmentosIniciales2 xs =
  sum (zipWith (*) [n,n-1..1] xs)
  where n = genericLength xs

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

sumaSegmentosIniciales3 :: [Integer] -> Integer
sumaSegmentosIniciales3 xs =
  sum (scanl1 (+) xs)

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

-- La propiedad es
prop_sumaSegmentosInicialesEquiv :: [Integer] -> Bool
prop_sumaSegmentosInicialesEquiv xs =
  all (== sumaSegmentosIniciales xs) [f xs | f <- [ sumaSegmentosIniciales2
                                                  , sumaSegmentosIniciales3]]

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

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

--   λ> sumaSegmentosIniciales [1..10^4]
--   166716670000
--   (2.42 secs, 7,377,926,824 bytes)
--   λ> sumaSegmentosIniciales2 [1..10^4]
--   166716670000
--   (0.01 secs, 4,855,176 bytes)
--   
--   λ> sumaSegmentosIniciales2 [1..3*10^6]
--   4500004500001000000
--   (2.68 secs, 1,424,404,168 bytes)
--   λ> sumaSegmentosIniciales3 [1..3*10^6]
--   4500004500001000000
--   (1.54 secs, 943,500,384 bytes)

-- Comprobación de la propiedad
-- ============================

-- La propiedad es
prop_sumaSegmentosIniciales :: Positive Integer -> Bool
prop_sumaSegmentosIniciales (Positive n) =
  sumaSegmentosIniciales3 (genericReplicate n 1) ==
  n * (n + 1) `div` 2

-- La compronación es
--   λ> quickCheck prop_sumaSegmentosIniciales
--   +++ OK, passed 100 tests.

import Data.List (genericLength, genericReplicate)

import Test.QuickCheck

-- 1ª solución

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

sumaSegmentosIniciales :: [Integer] -> Integer

sumaSegmentosIniciales xs =

sum [sum (take k xs) | k <- [1.. length xs]]

-- 2ª solución

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

sumaSegmentosIniciales2 :: [Integer] -> Integer

sumaSegmentosIniciales2 xs =

sum (zipWith (*) [n,n-1..1] xs)

where n = genericLength xs

-- 3ª solución

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

sumaSegmentosIniciales3 :: [Integer] -> Integer

sumaSegmentosIniciales3 xs =

sum (scanl1 (+) xs)

-- Comprobación de la equivalencia

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

-- La propiedad es

prop_sumaSegmentosInicialesEquiv :: [Integer] -> Bool

prop_sumaSegmentosInicialesEquiv xs =

all (== sumaSegmentosIniciales xs) [f xs | f <- [ sumaSegmentosIniciales2

, sumaSegmentosIniciales3]]

-- La comprobación es

-- λ> quickCheck prop_sumaSegmentosInicialesEquiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> sumaSegmentosIniciales [1..10^4]

-- 166716670000

-- (2.42 secs, 7,377,926,824 bytes)

-- λ> sumaSegmentosIniciales2 [1..10^4]

-- 166716670000

-- (0.01 secs, 4,855,176 bytes)

-- λ> sumaSegmentosIniciales2 [1..3*10^6]

-- 4500004500001000000

-- (2.68 secs, 1,424,404,168 bytes)

-- λ> sumaSegmentosIniciales3 [1..3*10^6]

-- 4500004500001000000

-- (1.54 secs, 943,500,384 bytes)

-- Comprobación de la propiedad

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

-- La propiedad es

prop_sumaSegmentosIniciales :: Positive Integer -> Bool

prop_sumaSegmentosIniciales (Positive n) =

sumaSegmentosIniciales3 (genericReplicate n 1) ==

n * (n + 1) `div` 2

-- La compronación es

-- λ> quickCheck prop_sumaSegmentosIniciales

-- +++ OK, passed 100 tests.

Otras soluciones

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

Matrices de Hadamard

PorJosé A. Alonso 16-abril-202029-abril-2020

Las matrices de Hadamard se definen recursivamente como sigue

   λ> hadamard 0
   ( 1 )
   
   λ> hadamard 1
   (  1  1 )
   (  1 -1 )
   
   λ> hadamard 2
   (  1  1  1  1 )
   (  1 -1  1 -1 )
   (  1  1 -1 -1 )
   (  1 -1 -1  1 )
   
   λ> hadamard 3
   (  1  1  1  1  1  1  1  1 )
   (  1 -1  1 -1  1 -1  1 -1 )
   (  1  1 -1 -1  1  1 -1 -1 )
   (  1 -1 -1  1  1 -1 -1  1 )
   (  1  1  1  1 -1 -1 -1 -1 )
   (  1 -1  1 -1 -1  1 -1  1 )
   (  1  1 -1 -1 -1 -1  1  1 )
   (  1 -1 -1  1 -1  1  1 -1 )

λ> hadamard 0

( 1 )

λ> hadamard 1

( 1 1 )

( 1 -1 )

λ> hadamard 2

( 1 1 1 1 )

( 1 -1 1 -1 )

( 1 1 -1 -1 )

( 1 -1 -1 1 )

λ> hadamard 3

( 1 1 1 1 1 1 1 1 )

( 1 -1 1 -1 1 -1 1 -1 )

( 1 1 -1 -1 1 1 -1 -1 )

( 1 -1 -1 1 1 -1 -1 1 )

( 1 1 1 1 -1 -1 -1 -1 )

( 1 -1 1 -1 -1 1 -1 1 )

( 1 1 -1 -1 -1 -1 1 1 )

( 1 -1 -1 1 -1 1 1 -1 )

En general, la n-ésima matriz de Hadamard, H(n), es

   ( H(n-1)  H(n-1) )
   ( H(n-1) -H(n-1) )

1 2	( H(n-1) H(n-1) ) ( H(n-1) -H(n-1) )

Definir la función

   hadamard :: Int -> Matrix Int

1	hadamard :: Int -> Matrix Int

tal que (hadamard n) es la n-ésima matriz de Hadamard.

Comprobar con QuickCheck que para todo número natural n, el producto de la n-ésima matriz de Hadamard y su traspuesta es igual al producto de 2^n por la matriz identidad de orden 2^n.

Soluciones

import Data.Matrix (Matrix, identity, joinBlocks, scaleMatrix, transpose)
import Test.QuickCheck 

hadamard :: Int -> Matrix Int
hadamard 0 = identity 1
hadamard n = joinBlocks (a, a, a, b)
  where a = hadamard (n-1)
        b = scaleMatrix (-1) a

-- La propiedad es
prop_Hadamard :: (Positive Int) -> Bool
prop_Hadamard (Positive n) =
  h * transpose h == scaleMatrix (2^n) (identity (2^n))
  where h = hadamard n

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=7}) prop_Hadamard
--    +++ OK, passed 100 tests.

import Data.Matrix (Matrix, identity, joinBlocks, scaleMatrix, transpose)

import Test.QuickCheck

hadamard :: Int -> Matrix Int

hadamard 0 = identity 1

hadamard n = joinBlocks (a, a, a, b)

where a = hadamard (n-1)

b = scaleMatrix (-1) a

-- La propiedad es

prop_Hadamard :: (Positive Int) -> Bool

prop_Hadamard (Positive n) =

h * transpose h == scaleMatrix (2^n) (identity (2^n))

where h = hadamard n

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=7}) prop_Hadamard

-- +++ OK, passed 100 tests.

Otras soluciones

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

Cálculo de pi mediante la variante de Euler de la serie armónica

PorJosé A. Alonso 9-abril-202026-marzo-2022

En el artículo El desarrollo más bello de Pi como suma infinita, Miguel Ángel Morales comenta el desarrollo de pi publicado por Leonhard Euler en su libro «Introductio in Analysis Infinitorum» (1748).

El desarrollo es el siguiente

y se obtiene a partir de la serie armónica

modificando sólo el signo de algunos términos según el siguiente criterio:

Dejamos un + cuando el denominador de la fracción sea un 2 o un primo de la forma 4m-1.
Cambiamos a – si el denominador de la fracción es un primo de la forma 4m+1.
Si el número es compuesto ponemos el signo que quede al multiplicar los signos correspondientes a cada factor.

Por ejemplo,

la de denominador 3 = 4×1-1 lleva un +,
la de denominador 5 = 4×1+1 lleva un -,
la de denominador 13 = 4×3+1 lleva un -,
la de denominador 6 = 2×3 lleva un + (porque los dos llevan un +),
la de denominador 10 = 2×5 lleva un – (porque el 2 lleva un + y el 5 lleva un -) y
la de denominador 50 = 5x5x2 lleva un + (un – por el primer 5, otro – por el segundo 5 y un + por el 2).

Definir las funciones

  aproximacionPi :: Int -> Double
  grafica        :: Int -> IO ()

1 2	aproximacionPi :: Int -> Double grafica :: Int -> IO ()

tales que

(aproximacionPi n) es la aproximación de pi obtenida sumando los n primeros términos de la serie de Euler. Por ejemplo.

     aproximacionPi 1        ==  1.0
     aproximacionPi 10       ==  2.3289682539682537
     aproximacionPi 100      ==  2.934318000847734
     aproximacionPi 1000     ==  3.0603246224585128
     aproximacionPi 10000    ==  3.1105295744825403
     aproximacionPi 100000   ==  3.134308801935256
     aproximacionPi 1000000  ==  3.1395057903490806

aproximacionPi 1 == 1.0

aproximacionPi 10 == 2.3289682539682537

aproximacionPi 100 == 2.934318000847734

aproximacionPi 1000 == 3.0603246224585128

aproximacionPi 10000 == 3.1105295744825403

aproximacionPi 100000 == 3.134308801935256

aproximacionPi 1000000 == 3.1395057903490806

(grafica n) dibuja la gráfica de las aproximaciones de pi usando k sumando donde k toma los valores de la lista [100,110..n]. Por ejemplo, al evaluar (grafica 4000) se obtiene

Soluciones

import Data.Numbers.Primes
import Graphics.Gnuplot.Simple

-- 1ª definición
-- =============

aproximacionPi :: Int -> Double
aproximacionPi n =
  sum [1 / fromIntegral (k * signo k) | k <- [1..n]] 

signoPrimo :: Int -> Int
signoPrimo 2 = 1
signoPrimo p | p `mod` 4 == 3 = 1
             | otherwise      = -1

signo :: Int -> Int
signo n | isPrime n = signoPrimo n
        | otherwise = product (map signoPrimo (primeFactors n))

-- 2ª definición
-- =============

aproximacionPi2 :: Int -> Double
aproximacionPi2 n = serieEuler !! (n-1)

serieEuler :: [Double]
serieEuler =
  scanl1 (+) [1 / fromIntegral (n * signo n) | n <- [1..]]

-- Definición de grafica
-- =====================

grafica :: Int -> IO ()
grafica n = 
    plotList [Key Nothing]
             [(k,aproximacionPi2 k) | k <- [100,110..n]]

import Data.Numbers.Primes

import Graphics.Gnuplot.Simple

-- 1ª definición

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

aproximacionPi :: Int -> Double

aproximacionPi n =

sum [1 / fromIntegral (k * signo k) | k <- [1..n]]

signoPrimo :: Int -> Int

signoPrimo 2 = 1

signoPrimo p | p `mod` 4 == 3 = 1

| otherwise = -1

signo :: Int -> Int

signo n | isPrime n = signoPrimo n

| otherwise = product (map signoPrimo (primeFactors n))

-- 2ª definición

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

aproximacionPi2 :: Int -> Double

aproximacionPi2 n = serieEuler !! (n-1)

serieEuler :: [Double]

serieEuler =

scanl1 (+) [1 / fromIntegral (n * signo n) | n <- [1..]]

-- Definición de grafica

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

grafica :: Int -> IO ()

grafica n =

plotList [Key Nothing]

[(k,aproximacionPi2 k) | k <- [100,110..n]]

Otras soluciones

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

Cálculo de dígitos de pi y su distribución

PorJosé A. Alonso 8-abril-202021-abril-2020

Se pueden generar los dígitos de Pi, como se explica en el artículo Unbounded spigot algorithms for the digits of pi c0on la función digitosPi definida por

   digitosPi :: [Integer]
   digitosPi = g(1,0,1,1,3,3) where
     g (q,r,t,k,n,l) = 
       if 4*q+r-t < n*t
       then n : g (10*q, 10*(r-n*t), t, k, div (10*(3*q+r)) t - 10*n, l)
       else g (q*k, (2*q+r)*l, t*l, k+1, div (q*(7*k+2)+r*l) (t*l), l+2)

digitosPi :: [Integer]

digitosPi = g(1,0,1,1,3,3) where

g (q,r,t,k,n,l) =

if 4*q+r-t < n*t

then n : g (10*q, 10*(r-n*t), t, k, div (10*(3*q+r)) t - 10*n, l)

else g (q*k, (2*q+r)*l, t*l, k+1, div (q*(7*k+2)+r*l) (t*l), l+2)

Por ejemplo,

   λ> take 25 digitosPi
   [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3,2,3,8,4,6,2,6,4,3]

1 2	λ> take 25 digitosPi [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3,2,3,8,4,6,2,6,4,3]

La distribución de los primeros 25 dígitos de pi es [0,2,3,5,3,3,3,1,2,3] ya que el 0 no aparece, el 1 ocurre 2 veces, el 3 ocurre 3 veces, el 4 ocurre 5 veces, …

Usando digitosPi, definir las siguientes funciones

   distribucionDigitosPi :: Int -> [Int]
   frecuenciaDigitosPi   :: Int -> [Double]

1 2	distribucionDigitosPi :: Int -> [Int] frecuenciaDigitosPi :: Int -> [Double]

tales que

(distribucionDigitosPi n) es la distribución de los n primeros dígitos de pi. Por ejemplo,

     λ> distribucionDigitosPi 10
     [0,2,1,2,1,2,1,0,0,1]
     λ> distribucionDigitosPi 100
     [8,8,12,12,10,8,9,8,12,13]
     λ> distribucionDigitosPi 1000
     [93,116,103,103,93,97,94,95,101,105]
     λ> distribucionDigitosPi 5000
     [466,531,496,460,508,525,513,488,492,521]

λ> distribucionDigitosPi 10

[0,2,1,2,1,2,1,0,0,1]

λ> distribucionDigitosPi 100

[8,8,12,12,10,8,9,8,12,13]

λ> distribucionDigitosPi 1000

[93,116,103,103,93,97,94,95,101,105]

λ> distribucionDigitosPi 5000

[466,531,496,460,508,525,513,488,492,521]

(frecuenciaDigitosPi n) es la frecuencia de los n primeros dígitos de pi. Por ejemplo,

   λ> frecuenciaDigitosPi 10
   [0.0,20.0,10.0,20.0,10.0,20.0,10.0,0.0,0.0,10.0]
   λ> frecuenciaDigitosPi 100
   [8.0,8.0,12.0,12.0,10.0,8.0,9.0,8.0,12.0,13.0]
   λ> frecuenciaDigitosPi 1000
   [9.3,11.6,10.3,10.3,9.3,9.7,9.4,9.5,10.1,10.5]
   λ> frecuenciaDigitosPi 5000
   [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]

λ> frecuenciaDigitosPi 10

[0.0,20.0,10.0,20.0,10.0,20.0,10.0,0.0,0.0,10.0]

λ> frecuenciaDigitosPi 100

[8.0,8.0,12.0,12.0,10.0,8.0,9.0,8.0,12.0,13.0]

λ> frecuenciaDigitosPi 1000

[9.3,11.6,10.3,10.3,9.3,9.7,9.4,9.5,10.1,10.5]

λ> frecuenciaDigitosPi 5000

[9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]

Soluciones

import Data.Array
import Data.List (group, sort)

digitosPi :: [Integer]
digitosPi = g(1,0,1,1,3,3) where
  g (q,r,t,k,n,l) = 
    if 4*q+r-t < n*t
    then n : g (10*q, 10*(r-n*t), t, k, div (10*(3*q+r)) t - 10*n, l)
    else g (q*k, (2*q+r)*l, t*l, k+1, div (q*(7*k+2)+r*l) (t*l), l+2)

-- 1ª definición
-- =============

distribucionDigitosPi :: Int -> [Int]
distribucionDigitosPi n =
  elems (accumArray (+) 0 (0,9) [ (i,1)
                                | i <- take n digitosPi]) 

frecuenciaDigitosPi :: Int -> [Double]
frecuenciaDigitosPi n =
  [100 * (fromIntegral x / m) | x <- distribucionDigitosPi n]
  where m = fromIntegral n

-- 2ª definición
-- =============

distribucionDigitosPi2 :: Int -> [Int]
distribucionDigitosPi2 n =
  [length xs - 1 | xs <- group (sort (take n digitosPi ++ [0..9]))]

frecuenciaDigitosPi2 :: Int -> [Double]
frecuenciaDigitosPi2 n =
  [100 * (fromIntegral x / m) | x <- distribucionDigitosPi2 n]
  where m = fromIntegral n

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

--    λ> last (take 5000 digitosPi)
--    2
--    (4.47 secs, 3,927,848,448 bytes)
--    λ> frecuenciaDigitosPi 5000
--    [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]
--    (0.01 secs, 0 bytes)
--    λ> frecuenciaDigitosPi2 5000
--    [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]
--    (0.02 secs, 0 bytes)

import Data.Array

import Data.List (group, sort)

digitosPi :: [Integer]

digitosPi = g(1,0,1,1,3,3) where

g (q,r,t,k,n,l) =

if 4*q+r-t < n*t

then n : g (10*q, 10*(r-n*t), t, k, div (10*(3*q+r)) t - 10*n, l)

else g (q*k, (2*q+r)*l, t*l, k+1, div (q*(7*k+2)+r*l) (t*l), l+2)

-- 1ª definición

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

distribucionDigitosPi :: Int -> [Int]

distribucionDigitosPi n =

elems (accumArray (+) 0 (0,9) [ (i,1)

| i <- take n digitosPi])

frecuenciaDigitosPi :: Int -> [Double]

frecuenciaDigitosPi n =

[100 * (fromIntegral x / m) | x <- distribucionDigitosPi n]

where m = fromIntegral n

-- 2ª definición

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

distribucionDigitosPi2 :: Int -> [Int]

distribucionDigitosPi2 n =

[length xs - 1 | xs <- group (sort (take n digitosPi ++ [0..9]))]

frecuenciaDigitosPi2 :: Int -> [Double]

frecuenciaDigitosPi2 n =

[100 * (fromIntegral x / m) | x <- distribucionDigitosPi2 n]

where m = fromIntegral n

-- Comparación de eficiencia

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

-- λ> last (take 5000 digitosPi)

-- 2

-- (4.47 secs, 3,927,848,448 bytes)

-- λ> frecuenciaDigitosPi 5000

-- [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]

-- (0.01 secs, 0 bytes)

-- λ> frecuenciaDigitosPi2 5000

-- [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]

-- (0.02 secs, 0 bytes)

Otras soluciones

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

Repeticiones consecutivas

PorJosé A. Alonso 17-marzo-202024-marzo-2020

Se dice que una palabra tiene una repetición en una frase si es igual a una, o más, de las palabras consecutivas sin distinguir mayúsculas de minúsculas.

Definir la función

   nRepeticionesConsecutivas :: String ->Int

1	nRepeticionesConsecutivas :: String ->Int

tal que (nRepeticionesConsecutivas cs) es el número de repeticiones de palabras consecutivas de la cadena cs. Por ejemplo,

   nRepeticionesConsecutivas "oso rana"                    == 0      
   nRepeticionesConsecutivas "oso rana oso"                == 0
   nRepeticionesConsecutivas "oso oSo rana"                == 1
   nRepeticionesConsecutivas "oso oso oso rana"            == 1
   nRepeticionesConsecutivas "coronavirus virus oso rana"  == 0
   nRepeticionesConsecutivas "virus     virus oso rana"    == 1
   nRepeticionesConsecutivas "virus oso virus oso rana"    == 0
   nRepeticionesConsecutivas "oso oso oso oso oso oso"     == 1
   nRepeticionesConsecutivas "oso oso oso oso rana rana"   == 2
   nRepeticionesConsecutivas "rana rana oso oso rana rana" == 3

nRepeticionesConsecutivas "oso rana" == 0

nRepeticionesConsecutivas "oso rana oso" == 0

nRepeticionesConsecutivas "oso oSo rana" == 1

nRepeticionesConsecutivas "oso oso oso rana" == 1

nRepeticionesConsecutivas "coronavirus virus oso rana" == 0

nRepeticionesConsecutivas "virus virus oso rana" == 1

nRepeticionesConsecutivas "virus oso virus oso rana" == 0

nRepeticionesConsecutivas "oso oso oso oso oso oso" == 1

nRepeticionesConsecutivas "oso oso oso oso rana rana" == 2

nRepeticionesConsecutivas "rana rana oso oso rana rana" == 3

Soluciones

import Data.List (group)
import Data.Char (toUpper)

-- 1ª solución
nRepeticionesConsecutivas :: String ->Int
nRepeticionesConsecutivas = aux . words . map toUpper 
  where aux (x:y:zs) | x == y    = 1 + aux (dropWhile (== x) zs)
                     | otherwise = aux (y:zs)
        aux _ = 0

-- 2ª solución
nRepeticionesConsecutivas2 :: String ->Int
nRepeticionesConsecutivas2 cs =
  length [xs | xs <- group (words (map toUpper cs)), length xs > 1]

-- 3ª solución
nRepeticionesConsecutivas3 :: String ->Int
nRepeticionesConsecutivas3 =
  length . filter ((>1) . length) . group . words . map toUpper

import Data.List (group)

import Data.Char (toUpper)

-- 1ª solución

nRepeticionesConsecutivas :: String ->Int

nRepeticionesConsecutivas = aux . words . map toUpper

where aux (x:y:zs) | x == y = 1 + aux (dropWhile (== x) zs)

| otherwise = aux (y:zs)

aux _ = 0

-- 2ª solución

nRepeticionesConsecutivas2 :: String ->Int

nRepeticionesConsecutivas2 cs =

length [xs | xs <- group (words (map toUpper cs)), length xs > 1]

-- 3ª solución

nRepeticionesConsecutivas3 :: String ->Int

nRepeticionesConsecutivas3 =

length . filter ((>1) . length) . group . words . map toUpper

Otras soluciones

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

Pensamiento

«En el campo de la computación, el momento de la verdad es la ejecución de un programa; todo lo demás es profecía.»

Herbert A. Simon.

División de cadenas

PorJosé A. Alonso 11-marzo-202018-marzo-2020

Definir la función

   division :: String -> [String]

1	division :: String -> [String]

tal que (division cs) es la lista de las palabras formadas por dos elementos consecutivos de cs y, en el caso de que la longitud de cs sea impar, el último elemento de la última palabra es el carácter de subrayado. Por ejemplo,

   division "pandemia"    ==  ["pa","nd","em","ia"]
   division "covid2019"   ==  ["co","vi","d2","01","9_"]
   division "covid 2019"  ==  ["co","vi","d ","20","19"]

division "pandemia" == ["pa","nd","em","ia"]

division "covid2019" == ["co","vi","d2","01","9_"]

division "covid 2019" == ["co","vi","d ","20","19"]

Soluciones

import Data.List.Split

-- 1ª solución
division :: String -> [String]
division []       = []
division [x]      = [[x,'_']]
division (x:y:zs) = [x,y] : division zs

-- 2ª solución
division2 :: String -> [String]
division2 cs =
  [[ds!!i,ds!!(i+1)] | i <- [0,2.. length cs - 1]]
  where ds = cs ++ "_"

-- 3ª solución
division3 :: String -> [String]
division3 = takeWhile ((2 ==) . length) . chunksOf 2 . (++ "_")

-- 4ª solución
division4 :: String -> [String]
division4 = init . chunksOf 2 . (++ "_")

import Data.List.Split

-- 1ª solución

division :: String -> [String]

division [] = []

division [x] = [[x,'_']]

division (x:y:zs) = [x,y] : division zs

-- 2ª solución

division2 :: String -> [String]

division2 cs =

[[ds!!i,ds!!(i+1)] | i <- [0,2.. length cs - 1]]

where ds = cs ++ "_"

-- 3ª solución

division3 :: String -> [String]

division3 = takeWhile ((2 ==) . length) . chunksOf 2 . (++ "_")

-- 4ª solución

division4 :: String -> [String]

division4 = init . chunksOf 2 . (++ "_")

Otras soluciones

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

Pensamiento

«Las matemáticas tienen un triple objetivo. Debe proporcionar un instrumento para el estudio de la naturaleza. Pero esto no es todo: tiene un objetivo filosófico y, me atrevo a decir, un objetivo estético.»

Henri Poincaré.

Inversión de palabras

PorJosé A. Alonso 10-marzo-202017-marzo-2020

Definir la función

   palabrasInvertidas :: String -> String

1	palabrasInvertidas :: String -> String

tal que (palabrasInvertidas cs) es la cadena obtenida invirtiendo las palabras de cs. Por ejemplo,

   λ> palabrasInvertidas "Del principio al final"
   "final al principio Del"
   λ> palabrasInvertidas "una a una"
   "una a una"

λ> palabrasInvertidas "Del principio al final"

"final al principio Del"

λ> palabrasInvertidas "una a una"

"una a una"

Soluciones

palabrasInvertidas :: String -> String
palabrasInvertidas = unwords . reverse . words

1 2	palabrasInvertidas :: String -> String palabrasInvertidas = unwords . reverse . words

Otras soluciones

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

Pensamiento

«Las matemáticas son el arte de dar el mismo nombre a cosas diferentes.»

Henri Poincaré.

Mayor equidigital

PorJosé A. Alonso 3-marzo-202010-marzo-2020

Definir la función

   mayorEquidigital :: Integer -> Integer

1	mayorEquidigital :: Integer -> Integer

tal que (mayorEquidigital n) es el mayor número que se puede formar con los dígitos de n. Por ejemplo,

   mayorEquidigital 325271  ==  753221

1	mayorEquidigital 325271 == 753221

Soluciones

import Data.List (sort)

mayorEquidigital :: Integer -> Integer
mayorEquidigital = read . reverse . sort . show

import Data.List (sort)

mayorEquidigital :: Integer -> Integer

mayorEquidigital = read . reverse . sort . show

Otras soluciones

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

Pensamiento

«Un matemático, como un pintor o un poeta, es un creador de patrones. Si sus patrones son más permanentes que los de ellos, es porque están hechos con ideas.»

G. H. Hardy.

Subconjuntos de orden k

PorJosé A. Alonso 24-febrero-20202-marzo-2020

Definir la función

   kSubconjuntos :: [a] -> Int -> [[a]]

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

tal que (kSubconjuntos xs k) es la lista de los subconjuntos de xs con k elementos. Por ejemplo,

   ghci> kSubconjuntos "bcde" 2
   ["bc","bd","be","cd","ce","de"]
   ghci> kSubconjuntos "bcde" 3
   ["bcd","bce","bde","cde"]
   ghci> kSubconjuntos "abcde" 3
   ["abc","abd","abe","acd","ace","ade","bcd","bce","bde","cde"]

ghci> kSubconjuntos "bcde" 2

["bc","bd","be","cd","ce","de"]

ghci> kSubconjuntos "bcde" 3

["bcd","bce","bde","cde"]

ghci> kSubconjuntos "abcde" 3

["abc","abd","abe","acd","ace","ade","bcd","bce","bde","cde"]

Soluciones

import Data.List (subsequences)

-- 1ª definición
kSubconjuntos1 :: [a] -> Int -> [[a]]
kSubconjuntos1 xs k =
  [ys | ys <- subsequences xs
      , length ys == k]

-- 2ª definición
kSubconjuntos :: [a] -> Int -> [[a]]
kSubconjuntos _ 0      = [[]]
kSubconjuntos [] _     = []
kSubconjuntos (x:xs) k = 
  [x:ys | ys <- kSubconjuntos xs (k-1)] ++ kSubconjuntos xs k  

-- Comparación de eficiencia
--    λ> length (kSubconjuntos1 [1..24] 3)
--    2024
--    (4.70 secs, 3,489,911,856 bytes)
--    λ> length (kSubconjuntos [1..24] 3)
--    2024
--    (0.03 secs, 2,039,488 bytes)

import Data.List (subsequences)

-- 1ª definición

kSubconjuntos1 :: [a] -> Int -> [[a]]

kSubconjuntos1 xs k =

[ys | ys <- subsequences xs

, length ys == k]

-- 2ª definición

kSubconjuntos :: [a] -> Int -> [[a]]

kSubconjuntos _ 0 = [[]]

kSubconjuntos [] _ = []

kSubconjuntos (x:xs) k =

[x:ys | ys <- kSubconjuntos xs (k-1)] ++ kSubconjuntos xs k

-- Comparación de eficiencia

-- λ> length (kSubconjuntos1 [1..24] 3)

-- 2024

-- (4.70 secs, 3,489,911,856 bytes)

-- λ> length (kSubconjuntos [1..24] 3)

-- 2024

-- (0.03 secs, 2,039,488 bytes)

Otras soluciones

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

Pensamiento

«La belleza en las matemáticas es ver la verdad sin esfuerzo.»

George Pólya.

Cliques de un grafo

PorJosé A. Alonso 21-febrero-202028-febrero-2020

Nota: En este ejercicio usaremos las mismas notaciones que en el anterior importando el módulo Grafo.

Un clique (en español, pandilla) de un grafo g es un conjunto de nodos de g tal que todos sus elementos están conectados en g.

Definir las funciones

   esClique :: Eq a => Grafo a -> [a] -> Bool
   cliques  :: Eq a => Grafo a -> [[a]]

1 2	esClique :: Eq a => Grafo a -> [a] -> Bool cliques :: Eq a => Grafo a -> [[a]]

tales que

(esClique g xs) se verifica si el conjunto de nodos xs del grafo g es un clique de g. Por ejemplo,

     esClique [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] [2,3,5]  ==  True
     esClique [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] [2,3,4]  ==  False

1 2	esClique [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] [2,3,5] == True esClique [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] [2,3,4] == False

(cliques g) es la lista de los cliques del grafo g. Por ejemplo,

     λ> cliques [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)]
     [[],[1],[2],[1,2],[3],[2,3],[4],[2,4],
      [5],[2,5],[3,5],[2,3,5],[4,5],[2,4,5]]

λ> cliques [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)]

[[],[1],[2],[1,2],[3],[2,3],[4],[2,4],

[5],[2,5],[3,5],[2,3,5],[4,5],[2,4,5]]

Nota: Escribir la solución en el módulo Cliques para poderlo usar en los siguientes ejercicios.

Soluciones

module Cliques where

import Grafo
import Data.List (tails, subsequences)

esClique :: Eq a => Grafo a -> [a] -> Bool
esClique g xs =
  and [conectados g x y | (x,y) <- parejas xs]

-- (parejas xs) es la lista de las parejas formados por los elementos de
-- xs y sus siguientes en xs. Por ejemplo, 
--    parejas [1..4] == [(1,2),(1,3),(1,4),(2,3),(2,4),(3,4)]
parejas :: [a] -> [(a,a)]
parejas xs =
  [(x,y) | (x:ys) <- tails xs
         , y <- ys]

cliques :: Eq a => Grafo a -> [[a]]
cliques g =
  [xs | xs <- subsequences (nodos g)
      , esClique g xs]

module Cliques where

import Grafo

import Data.List (tails, subsequences)

esClique :: Eq a => Grafo a -> [a] -> Bool

esClique g xs =

and [conectados g x y | (x,y) <- parejas xs]

-- (parejas xs) es la lista de las parejas formados por los elementos de

-- xs y sus siguientes en xs. Por ejemplo,

-- parejas [1..4] == [(1,2),(1,3),(1,4),(2,3),(2,4),(3,4)]

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

parejas xs =

[(x,y) | (x:ys) <- tails xs

, y <- ys]

cliques :: Eq a => Grafo a -> [[a]]

cliques g =

[xs | xs <- subsequences (nodos g)

, esClique g xs]

Otras soluciones

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

Pensamiento

«Para enseñar de manera efectiva, un profesor debe desarrollar un sentimiento por su asignatura; no puede hacer que sus alumnos sientan su vitalidad si no la siente él mismo. No puede compartir su entusiasmo cuando no tiene entusiasmo que compartir. La forma en que expone su tema puede ser tan importante como el tema que expone; debe sentir personalmente que es importante.»

George Pólya.

Parejas de un conjunto

PorJosé A. Alonso 20-febrero-202028-febrero-2020

Definir la función

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

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

tal que (parejas xs) es la lista de las parejas formados por los elementos de xs y sus siguientes en xs. Por ejemplo,

   parejas [1..4] == [(1,2),(1,3),(1,4),(2,3),(2,4),(3,4)]
   length (parejas [sin,cos,tan,log])  ==  6

1 2	parejas [1..4] == [(1,2),(1,3),(1,4),(2,3),(2,4),(3,4)] length (parejas [sin,cos,tan,log]) == 6

Soluciones

import Data.List (tails)

-- 1ª solución
parejas :: [a] -> [(a,a)]
parejas []     = []
parejas (x:xs) = [(x,y) | y <- xs] ++ parejas xs

-- 2ª solución
parejas2 :: [a] -> [(a,a)]
parejas2 xs =
  [(x,y) | (x:ys) <- tails xs
         , y <- ys]

import Data.List (tails)

-- 1ª solución

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

parejas [] = []

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

-- 2ª solución

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

parejas2 xs =

[(x,y) | (x:ys) <- tails xs

, y <- ys]

Otras soluciones

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

Pensamiento

«La primera regla del descubrimiento es tener inteligencia y buena suerte. La segunda regla del descubrimiento es sentarse y esperar hasta que se tenga una idea brillante.»

George Pólya.

Nodos y conexiones de un grafo

PorJosé A. Alonso 19-febrero-202026-febrero-2020

Un grafo no dirigido se representa por la lista de sus arcos. Por ejemplo, el grafo

             1  -- 2 -- 4
                   | \  |
                   |  \ |
                   3 -- 5

1 -- 2 -- 4

| \ |

3 -- 5

se representa por [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)].

Se define el tipo de grafo por

   type Grafo a = [(a,a)]

1	type Grafo a = [(a,a)]

Definir las funciones

   nodos      :: Eq a => Grafo a -> [a]
   conectados :: Eq a => Grafo a -> a -> a -> Bool

1 2	nodos :: Eq a => Grafo a -> [a] conectados :: Eq a => Grafo a -> a -> a -> Bool

tales que

(nodos g) es la lista de los nodos del grafo g. Por ejemplo,

     nodos [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)]  ==  [1,2,3,4,5]

1	nodos [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] == [1,2,3,4,5]

(conectados g x y) se verifica si el grafo no dirigido g posee un arco con extremos x e y. Por ejemplo,

     conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 3 2  ==  True
     conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 2 3  ==  True
     conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 3 4  ==  False

conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 3 2 == True

conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 2 3 == True

conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 3 4 == False

Nota: Escribir la solución en el módulo Grafo para poderlo usar en los siguientes ejercicios.

module Grafo where

import Data.List (nub)

type Grafo a = [(a,a)]

nodos :: Eq a => Grafo a -> [a]
nodos g = nub (concat [[x,y] | (x,y) <- g])

conectados :: Eq a => Grafo a -> a -> a -> Bool
conectados g x y =
  (x,y) `elem` g || (y,x) `elem` g

module Grafo where

import Data.List (nub)

type Grafo a = [(a,a)]

nodos :: Eq a => Grafo a -> [a]

nodos g = nub (concat [[x,y] | (x,y) <- g])

conectados :: Eq a => Grafo a -> a -> a -> Bool

conectados g x y =

(x,y) `elem` g || (y,x) `elem` g

Otras soluciones

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

Soluciones

Pensamiento

«La elegancia de un teorema es directamente proporcional al número de ideas que puedes ver en él e inversamente proporcional al esfuerzo que requiere verlas.»

George Pólya.

Problema SAT para FNC (fórmulas en forma normal conjuntiva)

PorJosé A. Alonso 18-febrero-202025-febrero-2020

Nota: En este ejercicio usaremos las mismas notaciones que en los anteriores importando los módulos import Modelos_de_FNC y Evaluacion_de_FNC

Una FNC (fórmula en forma normal conjuntiva) es satisfacible, si tiene algún modelo. Por ejemplo,

Definir la función

   esSatisfacible :: FNC -> Bool

1	esSatisfacible :: FNC -> Bool

tal que (esSatisfacible f) se verifica si la FNC f es satistacible. Por ejemplo,

   esSatisfacible [[-1,2],[-2,1]]    ==  True
   esSatisfacible [[-1,2],[-2],[1]]  ==  False
   esSatisfacible [[1,2],[]]         ==  False
   esSatisfacible []                 ==  True

esSatisfacible [[-1,2],[-2,1]] == True

esSatisfacible [[-1,2],[-2],[1]] == False

esSatisfacible [[1,2],[]] == False

esSatisfacible [] == True

Nota: Escribir la solución en el módulo Problema_de_SAT_para_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Problema_SAT_para_FNC where

import Modelos_de_FNC  
import Evaluacion_de_FNC

esSatisfacible :: FNC -> Bool
esSatisfacible = not . null . modelos

module Problema_SAT_para_FNC where

import Modelos_de_FNC

import Evaluacion_de_FNC

esSatisfacible :: FNC -> Bool

esSatisfacible = not . null . modelos

Otras soluciones

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

Pensamiento

«Un gran descubrimiento resuelve un gran problema, pero hay un grano de descubrimiento en cualquier problema.»

George Pólya.

Modelos de FNC (fórmulas en forma normal conjuntiva)

PorJosé A. Alonso 17-febrero-202024-febrero-2020

Nota: En este ejercicio usaremos las mismas notaciones que en anterior importando los módulos Interpretaciones_de_FNC y Evaluacion_de_FNC

Una interpretación I es un modelo de un literal L si el valor de L en I es verdadero. Por ejemplo, la interpretación [2,5]

es modelo del literal x(2) (porque 2 ∈ [2,5])
no es modelo del literal x(3) (porque 3 ∉ [2,5])
es modelo del literal -x(4) (porque 4 ∉ [2,5])

Una interpretación I es un modelo de una cláusula C si el valor de C en I es verdadero. Por ejemplo, la interpretación [2,5]

es modelo de la cláusula (x(2) v x(3)) (porque x(2) es verdadero)
no es modelo de la cláusula (x(3) v x(4)) (porque x(3) y x(4) son falsos)

Una interpretación I es un modelo de una FNC F si el valor de F en I es verdadero. Por ejemplo, la interpretación [2,5]

es modelo de la FNC ((x(2) v x(5)) & (-x(4) v x(3)) porque lo es de sus dos cláusulas.

Definir las siguientes funciones

   esModeloLiteral  :: Interpretacion -> Literal -> Bool
   esModeloClausula :: Interpretacion -> Clausula -> Bool
   esModelo         :: Interpretacion -> FNC -> Bool
   modelosClausula  :: Clausula -> [Interpretacion]
   modelos          :: FNC -> [Interpretacion]

esModeloLiteral :: Interpretacion -> Literal -> Bool

esModeloClausula :: Interpretacion -> Clausula -> Bool

esModelo :: Interpretacion -> FNC -> Bool

modelosClausula :: Clausula -> [Interpretacion]

modelos :: FNC -> [Interpretacion]

tales que

(esModeloLiteral i l) se verifica si i es modelo del literal l. Por ejemplo,

     esModeloLiteral [3,5] 3     ==  True
     esModeloLiteral [3,5] 4     ==  False
     esModeloLiteral [3,5] (-3)  ==  False
     esModeloLiteral [3,5] (-4)  ==  True

esModeloLiteral [3,5] 3 == True

esModeloLiteral [3,5] 4 == False

esModeloLiteral [3,5] (-3) == False

esModeloLiteral [3,5] (-4) == True

(esModeloClausula i c) se verifica si i es modelo de la cláusula c. Por ejemplo,

     esModeloClausula [3,5] [2,3,-5]  ==  True
     esModeloClausula [3,5] [2,4,-1]  ==  True
     esModeloClausula [3,5] [2,4,1]   ==  False

esModeloClausula [3,5] [2,3,-5] == True

esModeloClausula [3,5] [2,4,-1] == True

esModeloClausula [3,5] [2,4,1] == False

(esModelo i f) se verifica si i es modelo de la fórmula f. Por ejemplo,

     esModelo [1,3] [[1,-2],[3]]  ==  True
     esModelo [1]   [[1,-2],[3]]  ==  False
     esModelo [1]   []            ==  True

esModelo [1,3] [[1,-2],[3]] == True

esModelo [1] [[1,-2],[3]] == False

esModelo [1] [] == True

(modelosClausula c) es la lista de los modelos de la cláusula c. Por ejemplo,

     modelosClausula [-1,2]  ==  [[],[2],[1,2]]
     modelosClausula [-1,1]  ==  [[],[1]]
     modelosClausula []      ==  []

modelosClausula [-1,2] == [[],[2],[1,2]]

modelosClausula [-1,1] == [[],[1]]

modelosClausula [] == []

(modelos f) es la lista de los modelos de la fórmula f. Por ejemplo,

     modelos [[-1,2],[-2,1]]    ==  [[],[1,2]]
     modelos [[-1,2],[-2],[1]]  ==  []
     modelos [[1,-1,2]]         ==  [[],[1],[2],[1,2]]

modelos [[-1,2],[-2,1]] == [[],[1,2]]

modelos [[-1,2],[-2],[1]] == []

modelos [[1,-1,2]] == [[],[1],[2],[1,2]]

Nota: Escribir la solución en el módulo Modelos_de_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Modelos_de_FNC where

import Interpretaciones_de_FNC 
import Evaluacion_de_FNC

esModeloLiteral :: Interpretacion -> Literal -> Bool
esModeloLiteral i l
  | l > 0     = l `elem` i
  | otherwise = negate l `notElem` i

esModeloClausula :: Interpretacion -> Clausula -> Bool
esModeloClausula i = any (esModeloLiteral i)

esModelo :: Interpretacion -> FNC -> Bool
esModelo i = all (esModeloClausula i)

modelosClausula :: Clausula -> [Interpretacion]
modelosClausula c =
  [i | i <- interpretacionesClausula c,
       esModeloClausula i c]

modelos :: FNC -> [Interpretacion]
modelos f =
  [i | i <- interpretaciones f,
       esModelo i f]

module Modelos_de_FNC where

import Interpretaciones_de_FNC

import Evaluacion_de_FNC

esModeloLiteral :: Interpretacion -> Literal -> Bool

esModeloLiteral i l

| l > 0 = l `elem` i

| otherwise = negate l `notElem` i

esModeloClausula :: Interpretacion -> Clausula -> Bool

esModeloClausula i = any (esModeloLiteral i)

esModelo :: Interpretacion -> FNC -> Bool

esModelo i = all (esModeloClausula i)

modelosClausula :: Clausula -> [Interpretacion]

modelosClausula c =

[i | i <- interpretacionesClausula c,

esModeloClausula i c]

modelos :: FNC -> [Interpretacion]

modelos f =

[i | i <- interpretaciones f,

esModelo i f]

Otras soluciones

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

Pensamiento

«Por muy correcto que parezca un teorema matemático, nunca hay que conformarse con que no haya algo imperfecto en él hasta obtener la impresión de qie es bello.»

George Boole.

Interpretaciones de FNC (fórmulas en forma normal conjuntiva)

PorJosé A. Alonso 14-febrero-202022-febrero-2020

Nota: En este ejercicio usaremos las mismas notaciones que en el anterior importando los módulos Evaluacion_de_FNC y Atomos_de_FNC.

Definir las siguientes funciones

   interpretacionesClausula :: Clausula -> [Interpretacion]
   interpretaciones         :: FNC -> [Interpretacion]

1 2	interpretacionesClausula :: Clausula -> [Interpretacion] interpretaciones :: FNC -> [Interpretacion]

tales que

(interpretacionesClausula c) es el conjunto de interpretaciones de la cláusula c. Por ejemplo,

     interpretacionesClausula [1,2,-1]  ==  [[],[1],[2],[1,2]]
     interpretacionesClausula []        ==  [[]]

1 2	interpretacionesClausula [1,2,-1] == [[],[1],[2],[1,2]] interpretacionesClausula [] == [[]]

(interpretaciones f) es el conjunto de interpretaciones de la fórmula f. Por ejemplo,

     interpretaciones [[1,-2],[-1,2]] == [[],[1],[2],[1,2]] 
     interpretaciones []              == [[]]

1 2	interpretaciones [[1,-2],[-1,2]] == [[],[1],[2],[1,2]] interpretaciones [] == [[]]

Nota: Escribir la solución en el módulo Interpretaciones_de_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Interpretaciones_de_FNC where

import Evaluacion_de_FNC
import Atomos_de_FNC
import Data.List (subsequences)

interpretacionesClausula :: Clausula -> [Interpretacion]
interpretacionesClausula = subsequences . atomosClausula 

interpretaciones :: FNC -> [Interpretacion]
interpretaciones = subsequences . atomosFNC

module Interpretaciones_de_FNC where

import Evaluacion_de_FNC

import Atomos_de_FNC

import Data.List (subsequences)

interpretacionesClausula :: Clausula -> [Interpretacion]

interpretacionesClausula = subsequences . atomosClausula

interpretaciones :: FNC -> [Interpretacion]

interpretaciones = subsequences . atomosFNC

Otras soluciones

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

Pensamiento

«En matemáticas, el arte de hacer preguntas es más valioso que la resolución de problemas.»

Georg Cantor.

Átomos de FNC (fórmulas en forma normal conjuntiva)

PorJosé A. Alonso 13-febrero-202020-febrero-2020

Nota: En este ejercicio usaremos las mismas notaciones que en el anterior importando el módulo Evaluacion_de_FNC.

Definir las siguientes funciones

    atomosClausula :: Clausula -> [Atomo]
    atomosFNC      :: FNC -> [Atomo]

1 2	atomosClausula :: Clausula -> [Atomo] atomosFNC :: FNC -> [Atomo]

tales que

(atomosClausula c) es el conjunto de los átomos de la cláusula c. Por ejemplo,

     atomosClausula [3,1,-3] == [1,3]

1	atomosClausula [3,1,-3] == [1,3]

(atomosFNC f) es el conjunto de los átomos de la FNC f. Por ejemplo,

   atomosFNC [[4,5],[1,-2],[-4,-1,-5]]  ==  [1,2,4,5]

1	atomosFNC [[4,5],[1,-2],[-4,-1,-5]] == [1,2,4,5]

Nota: Escribir la solución en el módulo Atomos_de_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Atomos_de_FNC where
  
import Evaluacion_de_FNC
import Data.List (sort, nub)

-- 1ª definición de atomosClausula
atomosClausula :: Clausula -> [Atomo]
atomosClausula c = sort (nub (map abs c))

-- 2ª definición de atomosClausula
atomosClausula2 :: Clausula -> [Atomo]
atomosClausula2 = sort . nub . map abs

-- 1ª definición de atomosFNC
atomosFNC :: FNC -> [Atomo]
atomosFNC f = sort (nub (concat [atomosClausula c | c <- f]))

-- 2ª definición
atomosFNC2 :: FNC -> [Atomo]
atomosFNC2 f = sort (nub (concatMap atomosClausula f))

-- 3ª definición
atomosFNC3 :: FNC -> [Atomo]
atomosFNC3 = sort . nub . concatMap atomosClausula

module Atomos_de_FNC where

import Evaluacion_de_FNC

import Data.List (sort, nub)

-- 1ª definición de atomosClausula

atomosClausula :: Clausula -> [Atomo]

atomosClausula c = sort (nub (map abs c))

-- 2ª definición de atomosClausula

atomosClausula2 :: Clausula -> [Atomo]

atomosClausula2 = sort . nub . map abs

-- 1ª definición de atomosFNC

atomosFNC :: FNC -> [Atomo]

atomosFNC f = sort (nub (concat [atomosClausula c | c <- f]))

-- 2ª definición

atomosFNC2 :: FNC -> [Atomo]

atomosFNC2 f = sort (nub (concatMap atomosClausula f))

-- 3ª definición

atomosFNC3 :: FNC -> [Atomo]

atomosFNC3 = sort . nub . concatMap atomosClausula

Otras soluciones

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

Pensamiento

«La esencia de las matemáticas es su libertad.»

Georg Cantor.

Evaluación de FNC (fórmulas en forma normal conjuntiva)

PorJosé A. Alonso 12-febrero-202019-febrero-2020

Una FNC (fórmula en forma normal conjuntiva) es una conjunción de cláusulas, donde una cláusula es una disyunción de literales y un literal es un átomo o su negación. Por ejemplo,

   (x(1) v -x(3)) & x(2) & (-x(2) v x(3) v x(1))

1	(x(1) v -x(3)) & x(2) & (-x(2) v x(3) v x(1))

es una FNC con tres clásulas tales que la primera cláusula tiene 2 literales (x(1) y -x(3)), la segunda tiene 1 (x(2)) y la tercera tiene 3 (-x(2), x(3) y x(1)).

Usaremos las siguientes representaciones:

Los átomos se representan por enteros positivos. Por ejemplo, 3 representa x(3).
Los literales se representan por enteros. Por ejemplo, 3 representa el literal positivo x(3) y -5 el literal negativo -x(5).
Una cláusula es una lista de literales que representa la disyunción se sus literales. Por ejemplo, [3,2,-4] representa a (x(3) v x(2) v -x(4)).
Una fórmula en forma normal conjuntiva (FNC) es una lista de cláusulas que representa la conjunción de sus cláusulas. Por ejemplo, [[3,2],[-1,2,5]] representa a ((x(3) v x(2)) & (-x(1) v x(2) v x(5))).

Una interpretación I es un conjunto de átomos. Se supone que los átomos de I son verdaderos y los restantes son falsos. Por ejemplo, en la interpretación [2,5]

el literal x(2) es verdadero (porque 2 ∈ [2,5])
el literal x(3) es falso (porque 3 ∉ [2,5])
el literal -x(4) es verdadero (porque 4 ∉ [2,5])
la cláusula (x(2) v x(3)) es verdadera (porque x(2) es verdadero)
la cláusula (x(3) v x(4)) es falsa (porque x(3) y x(4) son falsos)
la FNC ((x(2) v x(5)) & (-x(4) v x(3)) es verdadera porque lo son sus dos cláusulas

En el ejercicio se usarán los siguientes tipos de datos

   type Atomo          = Int
   type Literal        = Int
   type Clausula       = [Literal]
   type FNC            = [Clausula]
   type Interpretacion = [Atomo]

type Atomo = Int

type Literal = Int

type Clausula = [Literal]

type FNC = [Clausula]

type Interpretacion = [Atomo]

Definir las siguientes funciones

   valorLiteral  :: Interpretacion -> Literal -> Bool
   valorClausula :: Interpretacion -> Clausula -> Bool
   valor         :: Interpretacion -> FNC -> Bool

valorLiteral :: Interpretacion -> Literal -> Bool

valorClausula :: Interpretacion -> Clausula -> Bool

valor :: Interpretacion -> FNC -> Bool

tales que

(valorLiteral i l) es el valor del literal l en la interpretación i. Por ejemplo,

     valorLiteral [3,5] 3     ==  True
     valorLiteral [3,5] 4     ==  False
     valorLiteral [3,5] (-3)  ==  False
     valorLiteral [3,5] (-4)  ==  True

valorLiteral [3,5] 3 == True

valorLiteral [3,5] 4 == False

valorLiteral [3,5] (-3) == False

valorLiteral [3,5] (-4) == True

(valorClausula i c) es el valor de la cláusula c en la interpretación i. Por ejemplo,

     valorClausula [3,5] [2,3,-5]  ==  True
     valorClausula [3,5] [2,4,-1]  ==  True
     valorClausula [3,5] [2,4,1]   ==  False

valorClausula [3,5] [2,3,-5] == True

valorClausula [3,5] [2,4,-1] == True

valorClausula [3,5] [2,4,1] == False

(valor i f) es el valor de la fórmula en FNC f en la interpretación i. Por ejemplo,

     valor [1,3] [[1,-2],[3]]  ==  True
     valor [1]   [[1,-2],[3]]  ==  False
     valor [1]   []            ==  True

valor [1,3] [[1,-2],[3]] == True

valor [1] [[1,-2],[3]] == False

valor [1] [] == True

Nota: Escribir la solución en el módulo Evaluacion_de_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Evaluacion_de_FNC where

type Atomo          = Int
type Literal        = Int
type Clausula       = [Literal]
type FNC            = [Clausula]
type Interpretacion = [Atomo]

-- Definición de valorLiteral
-- ==========================

valorLiteral :: Interpretacion -> Literal -> Bool
valorLiteral i l
  | l > 0     = l `elem` i
  | otherwise = negate l `notElem` i

-- Definiciones de valorClausula
-- =============================

-- 1ª definición
valorClausula :: Interpretacion -> Clausula -> Bool
valorClausula i c = or [valorLiteral i l | l <- c]

-- 2ª definición
valorClausula2 :: Interpretacion -> Clausula -> Bool
valorClausula2 i = any (valorLiteral i)

-- Definiciones de valor de FNC
-- ============================

-- 1ª definición
valor :: Interpretacion -> FNC -> Bool
valor i f = and [valorClausula i c | c <- f]

-- 2ª definición
valor2 :: Interpretacion -> FNC -> Bool
valor2 i = all (valorClausula i)

module Evaluacion_de_FNC where

type Atomo = Int

type Literal = Int

type Clausula = [Literal]

type FNC = [Clausula]

type Interpretacion = [Atomo]

-- Definición de valorLiteral

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

valorLiteral :: Interpretacion -> Literal -> Bool

valorLiteral i l

| l > 0 = l `elem` i

| otherwise = negate l `notElem` i

-- Definiciones de valorClausula

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

-- 1ª definición

valorClausula :: Interpretacion -> Clausula -> Bool

valorClausula i c = or [valorLiteral i l | l <- c]

-- 2ª definición

valorClausula2 :: Interpretacion -> Clausula -> Bool

valorClausula2 i = any (valorLiteral i)

-- Definiciones de valor de FNC

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

-- 1ª definición

valor :: Interpretacion -> FNC -> Bool

valor i f = and [valorClausula i c | c <- f]

-- 2ª definición

valor2 :: Interpretacion -> FNC -> Bool

valor2 i = all (valorClausula i)

Otras soluciones

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

Pensamiento

«Todo buen matemático es al menos medio filósofo, y todo buen filósofo es al menos medio matemático.»

Gottlob Frege.

Conjetura de Lemoine

PorJosé A. Alonso 11-febrero-202026-marzo-2022

La conjetura de Lemoine afirma que

Todos los números impares mayores que 5 se pueden escribir de la forma p + 2q donde p y q son números primos. Por ejemplo, 47 = 13 + 2 x 17

Definir las funciones

   descomposicionesLemoine :: Integer -> [(Integer,Integer)]
   graficaLemoine :: Integer -> IO ()

1 2	descomposicionesLemoine :: Integer -> [(Integer,Integer)] graficaLemoine :: Integer -> IO ()

tales que

(descomposicionesLemoine n) es la lista de pares de primos (p,q) tales que n = p + 2q. Por ejemplo,

     descomposicionesLemoine 5   ==  []
     descomposicionesLemoine 7   ==  [(3,2)]
     descomposicionesLemoine 9   ==  [(5,2),(3,3)]
     descomposicionesLemoine 21  ==  [(17,2),(11,5),(7,7)]
     descomposicionesLemoine 47  ==  [(43,2),(41,3),(37,5),(13,17)]
     descomposicionesLemoine 33  ==  [(29,2),(23,5),(19,7),(11,11),(7,13)]
     length (descomposicionesLemoine 2625)  ==  133

descomposicionesLemoine 5 == []

descomposicionesLemoine 7 == [(3,2)]

descomposicionesLemoine 9 == [(5,2),(3,3)]

descomposicionesLemoine 21 == [(17,2),(11,5),(7,7)]

descomposicionesLemoine 47 == [(43,2),(41,3),(37,5),(13,17)]

descomposicionesLemoine 33 == [(29,2),(23,5),(19,7),(11,11),(7,13)]

length (descomposicionesLemoine 2625) == 133

(graficaLemoine n) dibuja la gráfica de los números de descomposiciones de Lemoine para los números impares menores o iguales que n. Por ejemplo, (graficaLemoine n 400) dibuja

Comprobar con QuickCheck la conjetura de Lemoine.

Nota: Basado en Lemoine’s conjecture

Soluciones

import Data.Numbers.Primes (isPrime, primes)
import Graphics.Gnuplot.Simple
import Test.QuickCheck

descomposicionesLemoine :: Integer -> [(Integer,Integer)]
descomposicionesLemoine n =
  [(p,q) | q <- takeWhile (<=(n-2) `div` 2) primes
         , let p = n - 2 * q
         , isPrime p]

graficaLemoine :: Integer -> IO ()
graficaLemoine n = do
  plotList [ Key Nothing
           , Title "Conjetura de Lemoine"
           , PNG "Conjetura_de_Lemoine.png"
           ]
           [(k,length (descomposicionesLemoine k)) | k <- [1,3..n]]

-- La conjetura es
prop_conjeturaLemoine :: Integer -> Bool
prop_conjeturaLemoine n =
  not (null (descomposicionesLemoine n'))
  where n' = 7 + 2 * abs n

-- Su comprobación es
--    λ> quickCheck prop_conjeturaLemoine
--    +++ OK, passed 100 tests.

import Data.Numbers.Primes (isPrime, primes)

import Graphics.Gnuplot.Simple

import Test.QuickCheck

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

descomposicionesLemoine n =

[(p,q) | q <- takeWhile (<=(n-2) `div` 2) primes

, let p = n - 2 * q

, isPrime p]

graficaLemoine :: Integer -> IO ()

graficaLemoine n = do

plotList [ Key Nothing

, Title "Conjetura de Lemoine"

, PNG "Conjetura_de_Lemoine.png"

]

[(k,length (descomposicionesLemoine k)) | k <- [1,3..n]]

-- La conjetura es

prop_conjeturaLemoine :: Integer -> Bool

prop_conjeturaLemoine n =

not (null (descomposicionesLemoine n'))

where n' = 7 + 2 * abs n

-- Su comprobación es

-- λ> quickCheck prop_conjeturaLemoine

-- +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

«Todo el mundo sabe lo que es una curva, hasta que ha estudiado suficientes matemáticas para confundirse a través del incontable número de posibles excepciones.»

Felix Klein.

Acotación del primorial

PorJosé A. Alonso 31-enero-20207-febrero-2020

El primorial de un número natural n es el producto de todos los números primos menores o iguales a n. Por ejemplo, el primorial de 5 es 30 porque el producto de los primos menores o iguales que 5 es

   2 * 3 * 5 = 30

1	2 * 3 * 5 = 30

La propiedad de Erdös de acotación de los primoriales afirma que

Para todo número natural n, su primorial es menor o igual que 4ⁿ.

Definir las funciones

   primorial :: Integer -> Integer
   primoriales :: [Integer]

1 2	primorial :: Integer -> Integer primoriales :: [Integer]

tales que

(primorial n) es el primorial de n. Por ejemplo,

     primorial 3  ==  6
     primorial 5  ==  30
     primorial 8  ==  210

primorial 3 == 6

primorial 5 == 30

primorial 8 == 210

primoriales es la sucesión de los primoriales. Por ejemplo,

   λ> take 15 primoriales
   [1,1,2,6,6,30,30,210,210,210,210,2310,2310,30030,30030]

1 2	λ> take 15 primoriales [1,1,2,6,6,30,30,210,210,210,210,2310,2310,30030,30030]

Comprobar con QuickCheck la propiedad de Erdös de acotación de los primoriales.

Soluciones

import Data.Numbers.Primes
import Test.QuickCheck

-- 1ª definición de primorial
-- ==========================

primorial :: Integer -> Integer
primorial n = product (takeWhile (<= n) primes)

-- 2ª definición de primorial
-- ==========================

primorial2 :: Integer -> Integer
primorial2 0 = 1
primorial2 n | gcd n x == 1 = n*x
             | otherwise    = x
  where x = primorial2 (n-1)

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

--    λ> length (show (primorial (5*10^5)))
--    216852
--    (1.65 secs, 2,472,977,584 bytes)
--    λ> length (show (primorial2 (5*10^5)))
--    216852
--    (3.56 secs, 2,719,162,272 bytes)

-- 1ª definición de primoriales
-- ============================

--    λ> take 15 primoriales
--    [1,1,2,6,6,30,30,210,210,210,210,2310,2310,30030,30030]
primoriales :: [Integer]
primoriales = map primorial [0..]

-- 2ª definición de primoriales
-- ============================

--    λ> take 15 primoriales2
--    [1,1,2,6,6,30,30,210,210,210,210,2310,2310,30030,30030]
primoriales2 :: [Integer]
primoriales2 = map primorial2 [0..]

-- 3ª definición de primoriales
-- ============================

--    λ> take 15 primoriales3
--    [1,1,2,6,6,30,30,210,210,210,210,2310,2310,30030,30030]
primoriales3 :: [Integer]
primoriales3 = scanl1 f [1..]
  where f x n | gcd n x == 1 = n*x
              | otherwise    = x

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

--    λ> minimum (take 5000 primoriales)
--    1
--    (1.56 secs, 4,857,760,464 bytes)
--    λ> minimum (take 5000 primoriales2)
--    1
--    (9.39 secs, 10,942,848,240 bytes)
--    λ> minimum (take 5000 primoriales3)
--    1
--    (0.01 secs, 5,575,024 bytes)
--    
--    λ> minimum (take 6000 primoriales)
--    1
--    (2.22 secs, 7,013,937,248 bytes)
--    λ> minimum (take 6000 primoriales3)
--    1
--    (0.01 secs, 6,737,328 bytes)

-- Propiedad
-- =========

prop_primorial :: Integer -> Property
prop_primorial n =
  n >= 0 ==> primorial n <= 4^n

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

import Data.Numbers.Primes

import Test.QuickCheck

-- 1ª definición de primorial

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

primorial :: Integer -> Integer

primorial n = product (takeWhile (<= n) primes)

-- 2ª definición de primorial

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

primorial2 :: Integer -> Integer

primorial2 0 = 1

primorial2 n | gcd n x == 1 = n*x

| otherwise = x

where x = primorial2 (n-1)

-- Comparación de eficiencia

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

-- λ> length (show (primorial (5*10^5)))

-- 216852

-- (1.65 secs, 2,472,977,584 bytes)

-- λ> length (show (primorial2 (5*10^5)))

-- 216852

-- (3.56 secs, 2,719,162,272 bytes)

-- 1ª definición de primoriales

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

-- λ> take 15 primoriales

-- [1,1,2,6,6,30,30,210,210,210,210,2310,2310,30030,30030]

primoriales :: [Integer]

primoriales = map primorial [0..]

-- 2ª definición de primoriales

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

-- λ> take 15 primoriales2

-- [1,1,2,6,6,30,30,210,210,210,210,2310,2310,30030,30030]

primoriales2 :: [Integer]

primoriales2 = map primorial2 [0..]

-- 3ª definición de primoriales

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

-- λ> take 15 primoriales3

-- [1,1,2,6,6,30,30,210,210,210,210,2310,2310,30030,30030]

primoriales3 :: [Integer]

primoriales3 = scanl1 f [1..]

where f x n | gcd n x == 1 = n*x

| otherwise = x

-- Comparación de eficiencia

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

-- λ> minimum (take 5000 primoriales)

-- 1

-- (1.56 secs, 4,857,760,464 bytes)

-- λ> minimum (take 5000 primoriales2)

-- 1

-- (9.39 secs, 10,942,848,240 bytes)

-- λ> minimum (take 5000 primoriales3)

-- 1

-- (0.01 secs, 5,575,024 bytes)

-- λ> minimum (take 6000 primoriales)

-- 1

-- (2.22 secs, 7,013,937,248 bytes)

-- λ> minimum (take 6000 primoriales3)

-- 1

-- (0.01 secs, 6,737,328 bytes)

-- Propiedad

-- =========

prop_primorial :: Integer -> Property

prop_primorial n =

n >= 0 ==> primorial n <= 4^n

-- La comprobación es

-- λ> quickCheck prop_primorial

-- +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

«Las matemáticas son la reina de las ciencias y la teoría de los números es la reina de las matemáticas.»

Carl Friedrich Gauss.

Primer elemento repetido

PorJosé A. Alonso 28-enero-202026-marzo-2022

Definir la función

   primerRepetido :: Eq a => [a] -> Maybe a

1	primerRepetido :: Eq a => [a] -> Maybe a

tal que (primerRepetido xs) es justo el primer elemento repetido de la lista xs o Nothing si no tiene elementos repetidos. Por ejemplo,

   primerRepetido [3,7,5,7,2]  ==  Just 7
   primerRepetido [3,9,5,6,2]  ==  Nothing

1 2	primerRepetido [3,7,5,7,2] == Just 7 primerRepetido [3,9,5,6,2] == Nothing

Soluciones

primerRepetido :: Eq a => [a] -> Maybe a
primerRepetido xs = aux xs []
  where
    aux [] _                     = Nothing
    aux (x:xs') ys | x `elem` ys = Just x
                   | otherwise   = aux xs' (x:ys)

primerRepetido :: Eq a => [a] -> Maybe a

primerRepetido xs = aux xs []

where

aux [] _ = Nothing

aux (x:xs') ys | x `elem` ys = Just x

| otherwise = aux xs' (x:ys)

Otras soluciones

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

Pensamiento

«¿Cuál es el núcleo central de la ciencia de la computación? ¿Qué es lo que lo diferencia de los otros temas con los que se relaciona? ¿Qué es lo que el hilo de unión que reúne estas ramas dispares en una sola disciplina? Mi respuesta a estas preguntas es simple: es el arte de programar un ordenador. Es el arte de diseñar métodos eficientes y elegantes para conseguir que un ordenador resuelva problemas, teóricos o prácticos, pequeños o grandes, simples o complejos. Es el arte de traducir estos diseños programas correctos y eficientes.»

Tony Hoare.

Productos de sumas de cuatro cuadrados

PorJosé A. Alonso 24-enero-202031-enero-2020

Definir la función

   productoSuma4Cuadrados :: Integral a => [a] -> [a] -> [a] -> [a] -> a

1	productoSuma4Cuadrados :: Integral a => [a] -> [a] -> [a] -> [a] -> a

tal que (productoSuma4Cuadrados as bs cs ds) es el producto de las sumas de los cuadrados de cada una de las listas que ocupan la misma posición (hasta que alguna se acaba). Por ejemplo,

   productoSuma4Cuadrados [2,3] [1,5] [4,6] [0,3,9]
   = (2² + 1² + 4² + 0²) * (3² + 5² + 6² + 3²)
   = (4 +  1 + 16  + 0)  * (9 + 25 + 36  + 9)
   = 1659

productoSuma4Cuadrados [2,3] [1,5] [4,6] [0,3,9]

= (2² + 1² + 4² + 0²) * (3² + 5² + 6² + 3²)

= (4 + 1 + 16 + 0) * (9 + 25 + 36 + 9)

= 1659

Comprobar con QuickCheckWith que si as, bs cs y ds son listas no vacías de enteros positivos, entonces (productoSuma4Cuadrados as bs cs ds) se puede escribir como la suma de los cuadrados de cuatro enteros positivos.

Soluciones

import Data.List (zip4)
import Test.QuickCheck

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

productoSuma4Cuadrados :: Integral a => [a] -> [a] -> [a] -> [a] -> a
productoSuma4Cuadrados (a:as) (b:bs) (c:cs) (d:ds) =
  (a^2+b^2+c^2+d^2) * productoSuma4Cuadrados as bs cs ds
productoSuma4Cuadrados _ _ _ _ = 1

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

productoSuma4Cuadrados2 :: Integral a => [a] -> [a] -> [a] -> [a] -> a
productoSuma4Cuadrados2 as bs cs ds =
  product [a^2 + b^2 + c^2 + d^2 | (a,b,c,d) <- zip4 as bs cs ds]

-- Propiedad
-- =========

-- La propiedad es
prop_productoSuma4Cuadrados ::
  [Integer] -> [Integer] -> [Integer] -> [Integer] -> Property
prop_productoSuma4Cuadrados as bs cs ds =
  all (not . null) [as, bs, cs, ds]
  ==> 
  esSuma4Cuadrados (productoSuma4Cuadrados as' bs' cs' ds')
  where as' = [1 + abs a | a <- as]
        bs' = [1 + abs b | b <- bs]
        cs' = [1 + abs c | c <- cs]
        ds' = [1 + abs d | d <- ds]

-- (esSuma4Cuadrados n) se verifica si n es la suma de 4 cuadrados. Por
-- ejemplo, 
--    esSuma4Cuadrados 42  ==  True
--    esSuma4Cuadrados 11  ==  False
--    esSuma4Cuadrados 41  ==  False
esSuma4Cuadrados :: Integer -> Bool
esSuma4Cuadrados = not . null . sumas4Cuadrados

-- (sumas4Cuadrados n) es la lista de las descomposiciones de n como
-- sumas de 4 cuadrados. Por ejemplo,
--    sumas4Cuadrados 42  ==  [(16,16,9,1),(25,9,4,4),(36,4,1,1)]
sumas4Cuadrados :: Integer -> [(Integer,Integer,Integer,Integer)]
sumas4Cuadrados n =
  [(a^2,b^2,c^2,d) | a <- [1 .. floor (sqrt (fromIntegral n / 4))]
                   , b <- [a .. floor (sqrt (fromIntegral (n-a^2) / 3))]
                   , c <- [b .. floor (sqrt (fromIntegral (n-a^2-b^2) / 2))]
                   , let d = n - a^2 - b^2 - c^2
                   , c^2 <= d 
                   , esCuadrado d]

-- (esCuadrado x) se verifica si x es un número al cuadrado. Por
-- ejemplo,
--    esCuadrado 25  ==  True
--    esCuadrado 26  ==  False
esCuadrado :: Integer -> Bool
esCuadrado x = x == y * y
  where y = raiz x

-- (raiz x) es la raíz cuadrada entera de x. Por ejemplo,
--    raiz 25  ==  5
--    raiz 24  ==  4
--    raiz 26  ==  5
raiz :: Integer -> Integer
raiz x = floor (sqrt (fromIntegral x))

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=5}) prop_productoSuma4Cuadrados
--    +++ OK, passed 100 tests.

import Data.List (zip4)

import Test.QuickCheck

-- 1ª solución

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

productoSuma4Cuadrados :: Integral a => [a] -> [a] -> [a] -> [a] -> a

productoSuma4Cuadrados (a:as) (b:bs) (c:cs) (d:ds) =

(a^2+b^2+c^2+d^2) * productoSuma4Cuadrados as bs cs ds

productoSuma4Cuadrados _ _ _ _ = 1

-- 2ª solución

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

productoSuma4Cuadrados2 :: Integral a => [a] -> [a] -> [a] -> [a] -> a

productoSuma4Cuadrados2 as bs cs ds =

product [a^2 + b^2 + c^2 + d^2 | (a,b,c,d) <- zip4 as bs cs ds]

-- Propiedad

-- =========

-- La propiedad es

prop_productoSuma4Cuadrados ::

[Integer] -> [Integer] -> [Integer] -> [Integer] -> Property

prop_productoSuma4Cuadrados as bs cs ds =

all (not . null) [as, bs, cs, ds]

==>

esSuma4Cuadrados (productoSuma4Cuadrados as' bs' cs' ds')

where as' = [1 + abs a | a <- as]

bs' = [1 + abs b | b <- bs]

cs' = [1 + abs c | c <- cs]

ds' = [1 + abs d | d <- ds]

-- (esSuma4Cuadrados n) se verifica si n es la suma de 4 cuadrados. Por

-- ejemplo,

-- esSuma4Cuadrados 42 == True

-- esSuma4Cuadrados 11 == False

-- esSuma4Cuadrados 41 == False

esSuma4Cuadrados :: Integer -> Bool

esSuma4Cuadrados = not . null . sumas4Cuadrados

-- (sumas4Cuadrados n) es la lista de las descomposiciones de n como

-- sumas de 4 cuadrados. Por ejemplo,

-- sumas4Cuadrados 42 == [(16,16,9,1),(25,9,4,4),(36,4,1,1)]

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

sumas4Cuadrados n =

[(a^2,b^2,c^2,d) | a <- [1 .. floor (sqrt (fromIntegral n / 4))]

, b <- [a .. floor (sqrt (fromIntegral (n-a^2) / 3))]

, c <- [b .. floor (sqrt (fromIntegral (n-a^2-b^2) / 2))]

, let d = n - a^2 - b^2 - c^2

, c^2 <= d

, esCuadrado d]

-- (esCuadrado x) se verifica si x es un número al cuadrado. Por

-- ejemplo,

-- esCuadrado 25 == True

-- esCuadrado 26 == False

esCuadrado :: Integer -> Bool

esCuadrado x = x == y * y

where y = raiz x

-- (raiz x) es la raíz cuadrada entera de x. Por ejemplo,

-- raiz 25 == 5

-- raiz 24 == 4

-- raiz 26 == 5

raiz :: Integer -> Integer

raiz x = floor (sqrt (fromIntegral x))

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=5}) prop_productoSuma4Cuadrados

-- +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

¿Vivir? Sencillamente:
la sed y el agua cerca …
o el agua lejos, más, la sed y el agua,
un poco de cansancio ¡y a beberla!.

Antonio Machado

Números de Munchausen

PorJosé A. Alonso 13-enero-202020-enero-2020

Un número de Munchausen es un número entero positivo tal que es igual a la suma de sus dígitos elevados a sí mismo. Por ejemplo, 3435 es un número de Munchausen ya que

   3³ + 4⁴ + 3³ + 5⁵ = 27 + 256 + 27 + 3125 = 3435

1	3³ + 4⁴ + 3³ + 5⁵ = 27 + 256 + 27 + 3125 = 3435

Definir la función

   esMunchausen :: Integer -> Bool

1	esMunchausen :: Integer -> Bool

tal que (esMunchausen n) se verifica si n es un número de Munchausen. Por ejemplo,

   esMunchausen 3435  ==  True
   esMunchausen 2020  ==  False

1 2	esMunchausen 3435 == True esMunchausen 2020 == False

Comprobar con QuickCheck que que los únicos números de Munchausen son 1 y 3435.

Nota 1: No usar la propiedad en la definición.

Nota 2: El ejercicio está basado en el artículo ¿Por qué 3435 es uno de mis números favoritos? de Miguel Ángel Morales en El Aleph.

Soluciones

import Test.QuickCheck

esMunchausen :: Integer -> Bool
esMunchausen n =
  n == sum [x^x | x <- digitos n]

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 3435  ==  [3,4,3,5]
digitos :: Integer -> [Integer]
digitos n = [read [c] | c <- show n]

-- La propiedad es
prop_Munchausen :: Integer -> Property
prop_Munchausen n =
  n > 0
  ==>
  esMunchausen n == elem n [1, 3435]

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

import Test.QuickCheck

esMunchausen :: Integer -> Bool

esMunchausen n =

n == sum [x^x | x <- digitos n]

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,

-- digitos 3435 == [3,4,3,5]

digitos :: Integer -> [Integer]

digitos n = [read [c] | c <- show n]

-- La propiedad es

prop_Munchausen :: Integer -> Property

prop_Munchausen n =

n > 0

==>

esMunchausen n == elem n [1, 3435]

-- La comprobación es

-- λ> quickCheck prop_Munchausen

-- +++ OK, passed 100 tests.

Pensamiento

Escribiré en tu abanico:
te quiero para olvidarte,
para quererte te olvido.

Antonio Machado

Enteros como sumas de tres coprimos.

PorJosé A. Alonso 8-enero-202015-enero-2020

Dos números enteros son coprimos (o primos entre sí) si no tienen ningún factor primo en común. Por ejemplo, 4 y 15 son coprimos.

Una terna coprima es una terna (a,b,c) tal que

a y b son coprimos,
a y c son coprimos y
b y c son coprimos.

Por ejemplo, (3,4,5) es una terna coprima.

Definir la función

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

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

tal que (sumas3coprimos n) es la lista de las ternas coprimas cuya suma es n. Por ejemplo,

   sumas3coprimos 10  ==  [(2,3,5)]
   sumas3coprimos 11  ==  []
   sumas3coprimos 12  ==  [(2,3,7),(3,4,5)]
   length (sumas3coprimos 4000)  ==  546146

sumas3coprimos 10 == [(2,3,5)]

sumas3coprimos 11 == []

sumas3coprimos 12 == [(2,3,7),(3,4,5)]

length (sumas3coprimos 4000) == 546146

Comprobar con QuickCheck que todo número entero mayor que 17 se puede escribir como suma de alguna terna coprima; es decir, para todo entero n, (sumas3coprimos2 (18 + abs n)) tiene algún elemento.

Soluciones

import Test.QuickCheck

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

sumas3coprimos :: Integer -> [(Integer,Integer,Integer)]
sumas3coprimos n =
  [(a,b,c) | a <- [2..n]
           , b <- [a+1..n]
           , c <- [b+1..n]
           , a + b + c == n
           , gcd a b == 1
           , gcd a c == 1
           , gcd b c == 1]

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

sumas3coprimos2 :: Integer -> [(Integer,Integer,Integer)]
sumas3coprimos2 n =
  [(a,b,c) | a <- [2..n `div` 3]
           , b <- [a+1..(n - a) `div` 2]
           , gcd a b == 1
           , let c = n - a - b  
           , gcd a c == 1
           , gcd b c == 1]

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

-- La propiedad de equivalencia es
prop_sumas3coprimos_equiv :: Integer -> Property
prop_sumas3coprimos_equiv n =
  n > 0 ==> sumas3coprimos n == sumas3coprimos2 n

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

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

--    λ> length (sumas3coprimos 400)
--    5345
--    (4.16 secs, 2,894,799,744 bytes)
--    λ> length (sumas3coprimos2 400)
--    5345
--    (0.06 secs, 16,565,136 bytes)

-- Propiedad
-- =========

-- La propiedad
prop_sumas3coprimos :: Integer -> Bool
prop_sumas3coprimos n =
  not (null (sumas3coprimos2 (18 + abs n)))

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

import Test.QuickCheck

-- 1ª solución

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

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

sumas3coprimos n =

[(a,b,c) | a <- [2..n]

, b <- [a+1..n]

, c <- [b+1..n]

, a + b + c == n

, gcd a b == 1

, gcd a c == 1

, gcd b c == 1]

-- 2ª solución

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

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

sumas3coprimos2 n =

[(a,b,c) | a <- [2..n `div` 3]

, b <- [a+1..(n - a) `div` 2]

, gcd a b == 1

, let c = n - a - b

, gcd a c == 1

, gcd b c == 1]

-- Equivalencia de las definiciones

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

-- La propiedad de equivalencia es

prop_sumas3coprimos_equiv :: Integer -> Property

prop_sumas3coprimos_equiv n =

n > 0 ==> sumas3coprimos n == sumas3coprimos2 n

-- La comprobación es

-- λ> quickCheck prop_sumas3coprimos_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> length (sumas3coprimos 400)

-- 5345

-- (4.16 secs, 2,894,799,744 bytes)

-- λ> length (sumas3coprimos2 400)

-- 5345

-- (0.06 secs, 16,565,136 bytes)

-- Propiedad

-- =========

-- La propiedad

prop_sumas3coprimos :: Integer -> Bool

prop_sumas3coprimos n =

not (null (sumas3coprimos2 (18 + abs n)))

-- La comprobación es

-- λ> quickCheck prop_sumas3coprimos

-- +++ OK, passed 100 tests.

Referencias

Basado en Integers as sum of three pairwise coprime integers de ProofWiki.

Pensamiento

Todo amor es fantasía;
él inventa el año, el día,
la hora y su melodía;
inventa el amante y, más
la amada. No prueba nada,
contra el amor, que la amada
no haya existido jamás.

Antonio Machado

Factorizaciones de 4n+1

PorJosé A. Alonso 6-enero-202013-enero-2020

Sea S el conjunto

   S = {1, 5, 9, 13, 17, 21, 25, 29, 33, 37, 41, 45, ...}

1	S = {1, 5, 9, 13, 17, 21, 25, 29, 33, 37, 41, 45, ...}

de los enteros positivos congruentes con 1 módulo 4; es decir,

   S = {4n+1 | n ∈ N}

1	S = {4n+1 \| n ∈ N}

Un elemento n de S es irreducible si sólo es divisible por dos elementos de S: 1 y n. Por ejemplo, 9 es irreducible; pero 45 no lo es (ya que es el proctos de 5 y 9 que son elementos de S).

Definir las funciones

   esIrreducible :: Integer -> Bool
   factorizaciones :: Integer -> [[Integer]]
   conFactorizacionNoUnica :: [Integer]

esIrreducible :: Integer -> Bool

factorizaciones :: Integer -> [[Integer]]

conFactorizacionNoUnica :: [Integer]

tales que

(esIrreducible n) se verifica si n es irreducible. Por ejemplo,

     esIrreducible 9   ==  True
     esIrreducible 45  ==  False

1 2	esIrreducible 9 == True esIrreducible 45 == False

(factorizaciones n) es la lista de conjuntos de elementos irreducibles de S cuyo producto es n. Por ejemplo,

     factorizaciones 9     ==  [[9]]
     factorizaciones 693   ==  [[9,77],[21,33]]
     factorizaciones 4389  ==  [[21,209],[33,133],[57,77]]
     factorizaciones 2205  ==  [[5,9,49],[5,21,21]]

factorizaciones 9 == [[9]]

factorizaciones 693 == [[9,77],[21,33]]

factorizaciones 4389 == [[21,209],[33,133],[57,77]]

factorizaciones 2205 == [[5,9,49],[5,21,21]]

conFactorizacionNoUnica es la lista de elementos de S cuya factorización no es única. Por ejemplo,

     λ> take 10 conFactorizacionNoUnica
     [441,693,1089,1197,1449,1617,1881,1953,2205,2277]

1 2	λ> take 10 conFactorizacionNoUnica [441,693,1089,1197,1449,1617,1881,1953,2205,2277]

Soluciones

esIrreducible :: Integer -> Bool
esIrreducible n = divisores n == [1,n]

-- (divisores n) es el conjunto de elementos de S que dividen a n. Por
-- ejemplo, 
--    divisores 9    ==  [9]
--    divisores 693  ==  [9,21,33,77,693]
divisores :: Integer -> [Integer]
divisores n = [x | x <- [1,5..n], n `mod` x == 0] 
  
factorizaciones :: Integer -> [[Integer]]
factorizaciones 1 = [[1]]
factorizaciones n
  | esIrreducible n = [[n]]
  | otherwise       = [d:ds | d <- divisores n
                            , esIrreducible d
                            , ds@(e:_) <- factorizaciones (n `div` d)
                            , d <= e]

conFactorizacionNoUnica :: [Integer]
conFactorizacionNoUnica =
  [n | n <- [1,5..], length (factorizaciones n) > 1]

esIrreducible :: Integer -> Bool

esIrreducible n = divisores n == [1,n]

-- (divisores n) es el conjunto de elementos de S que dividen a n. Por

-- ejemplo,

-- divisores 9 == [9]

-- divisores 693 == [9,21,33,77,693]

divisores :: Integer -> [Integer]

divisores n = [x | x <- [1,5..n], n `mod` x == 0]

factorizaciones :: Integer -> [[Integer]]

factorizaciones 1 = [[1]]

factorizaciones n

| esIrreducible n = [[n]]

| otherwise = [d:ds | d <- divisores n

, esIrreducible d

, ds@(e:_) <- factorizaciones (n `div` d)

, d <= e]

conFactorizacionNoUnica :: [Integer]

conFactorizacionNoUnica =

[n | n <- [1,5..], length (factorizaciones n) > 1]

Pensamiento

¡Qué bien los nombres ponía
quien puso Sierra Morena
a esta serranía!

Antonio Machado

Postulado de Bertrand

PorJosé A. Alonso 30-diciembre-20196-enero-2020

El postulado de Bertrand afirma que para cualquier número entero n > 1, existe al menos un número primo p con n < p < 2n.

Definir la función

   siguientePrimo :: Integer -> Integer

1	siguientePrimo :: Integer -> Integer

tal que (siguientePrimo n) es el menor primo mayor que n. Por ejemplo,

   siguientePrimo 8   ==  11
   siguientePrimo 11  ==  13

1 2	siguientePrimo 8 == 11 siguientePrimo 11 == 13

Comprobar con QuickCheck el postulado de Bertrand; es decir, para todo entero n > 1, se verifica que n < p < 2n, donde p es (siguientePrimo n).

Soluciones

import Data.Numbers.Primes
import Test.QuickCheck

siguientePrimo :: Integer -> Integer
siguientePrimo n = head (dropWhile (<= n) primes)

-- La propiedad es
postuladoDeBertrand :: Integer -> Property
postuladoDeBertrand n =
  n > 1 ==> n < p && p < 2 * n
  where p = siguientePrimo n

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

import Data.Numbers.Primes

import Test.QuickCheck

siguientePrimo :: Integer -> Integer

siguientePrimo n = head (dropWhile (<= n) primes)

-- La propiedad es

postuladoDeBertrand :: Integer -> Property

postuladoDeBertrand n =

n > 1 ==> n < p && p < 2 * n

where p = siguientePrimo n

-- La comprobación es

-- λ> quickCheck postuladoDeBertrand

-- +++ OK, passed 100 tests.

Referencias

Bertrand’s postulate en Wikipedia.

Pensamiento

Pero caer de cabeza,
en esta noche sin luna,
en medio de esta maleza,
junto a la negra laguna.

Antonio Machado

Árbol binario de divisores

PorJosé A. Alonso 18-diciembre-201925-diciembre-2019

El árbol binario de los divisores de 24 es

2 45

3 15

3 5

Se puede representar por

   N 90 (H 2) (N 45 (H 3) (N 15 (H 3) (H 5)))

1	N 90 (H 2) (N 45 (H 3) (N 15 (H 3) (H 5)))

usando el tipo de dato definido por

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

data Arbol = H Int

| N Int Arbol Arbol

deriving (Eq, Show)

Análogamente se obtiene el árbol binario de cualquier número x: se comienza en x y en cada paso se tiene dos hijos (su menor divisor y su cociente) hasta obtener números primos en las hojas.

Definir las funciones

   arbolDivisores      :: Int -> Arbol
   hojasArbolDivisores :: Int -> [Int]

1 2	arbolDivisores :: Int -> Arbol hojasArbolDivisores :: Int -> [Int]

tales que

(arbolDivisores x) es el árbol binario de los divisores de x. Por ejemplo,

     λ> arbolDivisores 90
     N 90 (H 2) (N 45 (H 3) (N 15 (H 3) (H 5)))
     λ> arbolDivisores 24
     N 24 (H 2) (N 12 (H 2) (N 6 (H 2) (H 3)))
     λ> arbolDivisores 300
     N 300 (H 2) (N 150 (H 2) (N 75 (H 3) (N 25 (H 5) (H 5))))

λ> arbolDivisores 90

N 90 (H 2) (N 45 (H 3) (N 15 (H 3) (H 5)))

λ> arbolDivisores 24

N 24 (H 2) (N 12 (H 2) (N 6 (H 2) (H 3)))

λ> arbolDivisores 300

N 300 (H 2) (N 150 (H 2) (N 75 (H 3) (N 25 (H 5) (H 5))))

(hojasArbolDivisores x) es la lista de las hohas del árbol binario de los divisores de x. Por ejemplo

     hojasArbolDivisores 90   ==  [2,3,3,5]
     hojasArbolDivisores 24   ==  [2,2,2,3]
     hojasArbolDivisores 300  ==  [2,2,3,5,5]

hojasArbolDivisores 90 == [2,3,3,5]

hojasArbolDivisores 24 == [2,2,2,3]

hojasArbolDivisores 300 == [2,2,3,5,5]

Soluciones

import Data.Numbers.Primes (isPrime, primeFactors)

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

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

arbolDivisores :: Int -> Arbol
arbolDivisores x
  | y == x    = H x
  | otherwise = N x (H y) (arbolDivisores (x `div` y))
  where y = menorDivisor x

-- (menorDivisor x) es el menor divisor primo de x. Por ejemplo,
--    menorDivisor 45  ==  3
--    menorDivisor 5   ==  5
menorDivisor :: Int -> Int
menorDivisor x =
  head [y | y <- [2..x], x `mod` y == 0]

hojasArbolDivisores :: Int -> [Int]
hojasArbolDivisores = hojas . arbolDivisores

-- (hojas a) es la lista de las hojas del árbol a. Por ejemplo,
--    hojas (N 3 (H 4) (N 5 (H 7) (H 2)))  ==  [4,7,2]
hojas :: Arbol -> [Int]
hojas (H x)     = [x]
hojas (N _ i d) = hojas i ++ hojas d

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

arbolDivisores2 :: Int -> Arbol
arbolDivisores2 x
  | y == x    = H x
  | otherwise = N x (H y) (arbolDivisores (x `div` y))
  where (y:_) = primeFactors x

hojasArbolDivisores2 :: Int -> [Int]
hojasArbolDivisores2 = primeFactors

import Data.Numbers.Primes (isPrime, primeFactors)

data Arbol = H Int

| N Int Arbol Arbol

deriving (Eq, Show)

-- 1ª solución

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

arbolDivisores :: Int -> Arbol

arbolDivisores x

| y == x = H x

| otherwise = N x (H y) (arbolDivisores (x `div` y))

where y = menorDivisor x

-- (menorDivisor x) es el menor divisor primo de x. Por ejemplo,

-- menorDivisor 45 == 3

-- menorDivisor 5 == 5

menorDivisor :: Int -> Int

menorDivisor x =

head [y | y <- [2..x], x `mod` y == 0]

hojasArbolDivisores :: Int -> [Int]

hojasArbolDivisores = hojas . arbolDivisores

-- (hojas a) es la lista de las hojas del árbol a. Por ejemplo,

-- hojas (N 3 (H 4) (N 5 (H 7) (H 2))) == [4,7,2]

hojas :: Arbol -> [Int]

hojas (H x) = [x]

hojas (N _ i d) = hojas i ++ hojas d

-- 2ª solución

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

arbolDivisores2 :: Int -> Arbol

arbolDivisores2 x

| y == x = H x

| otherwise = N x (H y) (arbolDivisores (x `div` y))

where (y:_) = primeFactors x

hojasArbolDivisores2 :: Int -> [Int]

hojasArbolDivisores2 = primeFactors

Pensamiento

Cuando el Ser que se es hizo la nada
y reposó que bien lo merecía,
ya tuvo el día noche, y compañía
tuvo el amante en la ausencia de la amada.

Antonio Machado

Menor número triangular con más de n divisores

PorJosé A. Alonso 27-noviembre-20194-diciembre-2019

La sucesión de los números triangulares se obtiene sumando los números naturales.

   *     *      *        *         *   
        * *    * *      * *       * *  
              * * *    * * *     * * * 
                      * * * *   * * * *
                               * * * * * 
   1     3      6        10        15

* * * * *

* * * * * * * *

* * * * * * * * *

* * * * * * * *

* * * * *

1 3 6 10 15

Así, el 7º número triangular es

   1 + 2 + 3 + 4 + 5 + 6 + 7 = 28.

1	1 + 2 + 3 + 4 + 5 + 6 + 7 = 28.

Los primeros 10 números triangulares son

   1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...

1	1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...

Los divisores de los primeros 7 números triangulares son:

    1: 1
    3: 1,3
    6: 1,2,3,6
   10: 1,2,5,10
   15: 1,3,5,15
   21: 1,3,7,21
   28: 1,2,4,7,14,28

1: 1

3: 1,3

6: 1,2,3,6

10: 1,2,5,10

15: 1,3,5,15

21: 1,3,7,21

28: 1,2,4,7,14,28

Como se puede observar, 28 es el menor número triangular con más de 5 divisores.

Definir la función

   menorTriangularConAlMenosNDivisores :: Int -> Integer

1	menorTriangularConAlMenosNDivisores :: Int -> Integer

tal que (menorTriangularConAlMenosNDivisores n) es el menor número triangular que tiene al menos n divisores. Por ejemplo,

   menorTriangularConAlMenosNDivisores 5    ==  28
   menorTriangularConAlMenosNDivisores 50   ==  25200
   menorTriangularConAlMenosNDivisores 500  ==  76576500

menorTriangularConAlMenosNDivisores 5 == 28

menorTriangularConAlMenosNDivisores 50 == 25200

menorTriangularConAlMenosNDivisores 500 == 76576500

Nota: Este ejercicio está basado en el problema 12 del Proyecto Euler

Soluciones

import Data.List (group)
import Data.Numbers.Primes (primeFactors)

menorTriangularConAlMenosNDivisores :: Int -> Integer
menorTriangularConAlMenosNDivisores n = 
  head [x | x <- triangulares, nDivisores x >= n]

-- Nota: Se usarán las funciones
-- + triangulares definida en [Números triangulares](http://bit.ly/2rtr6a3) y
-- + nDivisores definida en [Número de divisores](http://bit.ly/2DgVh74)

-- triangulares es la sucesión de los números triangulares. Por ejemplo,
--    take 10 triangulares  ==  [1,3,6,10,15,21,28,36,45,55]
triangulares :: [Integer]
triangulares = scanl1 (+) [1..]

-- (nDivisores x) es el número de divisores de x. Por ejemplo,
--    nDivisores 28  ==  6
nDivisores :: Integer -> Int
nDivisores = product . map ((+1) . length) . group . primeFactors

import Data.List (group)

import Data.Numbers.Primes (primeFactors)

menorTriangularConAlMenosNDivisores :: Int -> Integer

menorTriangularConAlMenosNDivisores n =

head [x | x <- triangulares, nDivisores x >= n]

-- Nota: Se usarán las funciones

-- + triangulares definida en [Números triangulares](http://bit.ly/2rtr6a3) y

-- + nDivisores definida en [Número de divisores](http://bit.ly/2DgVh74)

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

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

triangulares :: [Integer]

triangulares = scanl1 (+) [1..]

-- (nDivisores x) es el número de divisores de x. Por ejemplo,

-- nDivisores 28 == 6

nDivisores :: Integer -> Int

nDivisores = product . map ((+1) . length) . group . primeFactors

Pensamiento

«La Matemática es una ciencia experimental y la computación es el experimento.» ~ Rivin

Mayor divisor primo

PorJosé A. Alonso 26-noviembre-20193-diciembre-2019

Los divisores primos de 13195 son 5, 7, 13 y 29. Por tanto, el mayor divisor primo de 13195 es 29.

Definir la función

   mayorDivisorPrimo :: Integer -> Integer

1	mayorDivisorPrimo :: Integer -> Integer

tal que (mayorDivisorPrimo n) es el mayor divisor primo de n. Por ejemplo,

   mayorDivisorPrimo 13195            ==  29
   mayorDivisorPrimo 152416333181401  ==  12345701

1 2	mayorDivisorPrimo 13195 == 29 mayorDivisorPrimo 152416333181401 == 12345701

Nota: Este ejercicio está basado en el problema 3 del Proyecto Euler

Soluciones

import Data.Numbers.Primes (primeFactors)

-- 1ª solución  (sin librerías auxiliares)
-- =======================================

mayorDivisorPrimo :: Integer -> Integer
mayorDivisorPrimo = last . divisoresPrimos 

-- (divisoresPrimos n) es la lista de los divisores primos de n. Por
-- ejemplo, 
--    divisoresPrimos 13195  ==  [5,7,13,29]
divisoresPrimos :: Integer -> [Integer]
divisoresPrimos 0 = []
divisoresPrimos 1 = []
divisoresPrimos n = m : divisoresPrimos (n `div` m)
  where m = menorDivisorPrimo n 

-- (menorDivisorPrimo n) es el menor divisor primo de n. Por ejemplo, 
--    menorDivisorPrimo 24  ==  2
--    menorDivisorPrimo 25  ==  5
--    menorDivisorPrimo 29  ==  29
menorDivisorPrimo :: Integer -> Integer
menorDivisorPrimo x =
  head [y | y <- 2 : [3,5..(ceiling . sqrt . fromIntegral) x] ++ [x]
          , x `mod` y == 0]

-- 2ª solución (con la librería Data.Numbers.Primes)
-- =================================================

mayorDivisorPrimo2 :: Integer -> Integer
mayorDivisorPrimo2 = last . primeFactors

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

--   λ> mayorDivisorPrimo 152416333181401
--   12345701
--   (1.96 secs, 1,630,201,856 bytes)
--   λ> mayorDivisorPrimo2 152416333181401
--   12345701
--   (2.01 secs, 5,445,284,432 bytes)

import Data.Numbers.Primes (primeFactors)

-- 1ª solución (sin librerías auxiliares)

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

mayorDivisorPrimo :: Integer -> Integer

mayorDivisorPrimo = last . divisoresPrimos

-- (divisoresPrimos n) es la lista de los divisores primos de n. Por

-- ejemplo,

-- divisoresPrimos 13195 == [5,7,13,29]

divisoresPrimos :: Integer -> [Integer]

divisoresPrimos 0 = []

divisoresPrimos 1 = []

divisoresPrimos n = m : divisoresPrimos (n `div` m)

where m = menorDivisorPrimo n

-- (menorDivisorPrimo n) es el menor divisor primo de n. Por ejemplo,

-- menorDivisorPrimo 24 == 2

-- menorDivisorPrimo 25 == 5

-- menorDivisorPrimo 29 == 29

menorDivisorPrimo :: Integer -> Integer

menorDivisorPrimo x =

head [y | y <- 2 : [3,5..(ceiling . sqrt . fromIntegral) x] ++ [x]

, x `mod` y == 0]

-- 2ª solución (con la librería Data.Numbers.Primes)

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

mayorDivisorPrimo2 :: Integer -> Integer

mayorDivisorPrimo2 = last . primeFactors

-- Comparación de eficiencia

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

-- λ> mayorDivisorPrimo 152416333181401

-- 12345701

-- (1.96 secs, 1,630,201,856 bytes)

-- λ> mayorDivisorPrimo2 152416333181401

-- 12345701

-- (2.01 secs, 5,445,284,432 bytes)

Pensamiento

«Un programa de ordenador es una demostración.» ~ Igor Rivin

Números triangulares

PorJosé A. Alonso 25-noviembre-201925-marzo-2022

La sucesión de los números triangulares se obtiene sumando los números naturales.

   *     *      *        *         *   
        * *    * *      * *       * *  
              * * *    * * *     * * * 
                      * * * *   * * * *
                               * * * * * 
   1     3      6        10        15

* * * * *

* * * * * * * *

* * * * * * * * *

* * * * * * * *

* * * * *

1 3 6 10 15

Así, los 5 primeros números triangulares son

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

1 = 1

3 = 1+2

6 = 1+2+3

10 = 1+2+3+4

15 = 1+2+3+4+5

Definir la función

   triangulares :: [Integer]

1	triangulares :: [Integer]

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

   take 10 triangulares  ==  [1,3,6,10,15,21,28,36,45,55]
   maximum (take (5*10^6) triangulares4)  ==  12500002500000

1 2	take 10 triangulares == [1,3,6,10,15,21,28,36,45,55] maximum (take (5*10^6) triangulares4) == 12500002500000

Comprobar con QuickCheck que entre dos números triangulares consecutivos siempre hay un número primo.

Soluciones

import Test.QuickCheck (Property, (==>), quickCheck)
import Data.Numbers.Primes (primes)

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

triangulares :: [Integer]
triangulares = [sum [1..n] | n <- [1..]]

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

triangulares2 :: [Integer]
triangulares2 = map triangular [1..]

-- (triangular n) es el n-ésimo número triangular. Por ejemplo, 
--    triangular 5  ==  15
triangular :: Integer -> Integer
triangular 1 = 1
triangular n = n + triangular (n-1)

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

triangulares3 :: [Integer]
triangulares3 = 1 : [x+y | (x,y) <- zip [2..] triangulares]

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

triangulares4 :: [Integer]
triangulares4 = scanl1 (+) [1..]

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

triangulares5 :: [Integer]
triangulares5 = [(n*(n+1)) `div` 2 | n <- [1..]]

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

--    λ> maximum (take (10^4) triangulares)
--    50005000
--    (2.10 secs, 8,057,774,104 bytes)
--    λ> maximum (take (10^4) triangulares2)
--    50005000
--    (18.89 secs, 12,142,690,784 bytes)
--    λ> maximum (take (10^4) triangulares3)
--    50005000
--    (0.01 secs, 4,600,976 bytes)
--    λ> maximum (take (10^4) triangulares4)
--    50005000
--    (0.01 secs, 3,643,192 bytes)
--    λ> maximum (take (10^4) triangulares5)
--    50005000
--    (0.02 secs, 5,161,464 bytes)
--    
--    λ> maximum (take (3*10^4) triangulares3)
--    450015000
--    (26.06 secs, 72,546,027,136 bytes)
--    λ> maximum (take (3*10^4) triangulares4)
--    450015000
--    (0.02 secs, 10,711,600 bytes)
--    λ> maximum (take (3*10^4) triangulares5)
--    450015000
--    (0.03 secs, 15,272,320 bytes)
--    
--    λ> maximum (take (5*10^6) triangulares4)
--    12500002500000
--    (1.67 secs, 1,772,410,336 bytes)
--    λ> maximum (take (5*10^6) triangulares5)
--    12500002500000
--    (4.09 secs, 2,532,407,720 bytes)

-- La propiedad es
prop_triangulares :: Int -> Property
prop_triangulares n =
  n >= 0 ==> siguientePrimo x < y
  where (x:y:_) = drop n triangulares4

-- (siguientePrimo n) es el menor primo mayor o igual que n. Por
-- ejemplo, 
--    siguientePrimo 14  ==  17
--    siguientePrimo 17  ==  17
siguientePrimo :: Integer -> Integer
siguientePrimo n = head (dropWhile (< n) primes)

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

import Test.QuickCheck (Property, (==>), quickCheck)

import Data.Numbers.Primes (primes)

-- 1ª solución

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

triangulares :: [Integer]

triangulares = [sum [1..n] | n <- [1..]]

-- 2ª solución

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

triangulares2 :: [Integer]

triangulares2 = map triangular [1..]

-- (triangular n) es el n-ésimo número triangular. Por ejemplo,

-- triangular 5 == 15

triangular :: Integer -> Integer

triangular 1 = 1

triangular n = n + triangular (n-1)

-- 3ª solución

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

triangulares3 :: [Integer]

triangulares3 = 1 : [x+y | (x,y) <- zip [2..] triangulares]

-- 4ª solución

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

triangulares4 :: [Integer]

triangulares4 = scanl1 (+) [1..]

-- 5ª solución

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

triangulares5 :: [Integer]

triangulares5 = [(n*(n+1)) `div` 2 | n <- [1..]]

-- Comparación de eficiencia

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

-- λ> maximum (take (10^4) triangulares)

-- 50005000

-- (2.10 secs, 8,057,774,104 bytes)

-- λ> maximum (take (10^4) triangulares2)

-- 50005000

-- (18.89 secs, 12,142,690,784 bytes)

-- λ> maximum (take (10^4) triangulares3)

-- 50005000

-- (0.01 secs, 4,600,976 bytes)

-- λ> maximum (take (10^4) triangulares4)

-- 50005000

-- (0.01 secs, 3,643,192 bytes)

-- λ> maximum (take (10^4) triangulares5)

-- 50005000

-- (0.02 secs, 5,161,464 bytes)

-- λ> maximum (take (3*10^4) triangulares3)

-- 450015000

-- (26.06 secs, 72,546,027,136 bytes)

-- λ> maximum (take (3*10^4) triangulares4)

-- 450015000

-- (0.02 secs, 10,711,600 bytes)

-- λ> maximum (take (3*10^4) triangulares5)

-- 450015000

-- (0.03 secs, 15,272,320 bytes)

-- λ> maximum (take (5*10^6) triangulares4)

-- 12500002500000

-- (1.67 secs, 1,772,410,336 bytes)

-- λ> maximum (take (5*10^6) triangulares5)

-- 12500002500000

-- (4.09 secs, 2,532,407,720 bytes)

-- La propiedad es

prop_triangulares :: Int -> Property

prop_triangulares n =

n >= 0 ==> siguientePrimo x < y

where (x:y:_) = drop n triangulares4

-- (siguientePrimo n) es el menor primo mayor o igual que n. Por

-- ejemplo,

-- siguientePrimo 14 == 17

-- siguientePrimo 17 == 17

siguientePrimo :: Integer -> Integer

siguientePrimo n = head (dropWhile (< n) primes)

-- La comprobación es

-- λ> quickCheck prop_triangulares

-- +++ OK, passed 100 tests.

Pensamiento

Autores, la escena acaba
con un dogma de teatro:
En el principio era la máscara.

Antonio Machado

Soluciones

Otras soluciones

Soluciones

Otras soluciones

Soluciones

Otras soluciones

Soluciones

Otras soluciones

Soluciones

Otras soluciones

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Otras soluciones

Soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Referencias

Pensamiento

Soluciones

Pensamiento

Soluciones

Referencias

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Entradas recientes