Exercitium

Primos circulares

PorJosé A. Alonso 7-junio-20223-junio-2022

Un primo circular es un número tal que todas las rotaciones de dígitos producen números primos. Por ejemplo, 195 es un primo circular ya que las rotaciones de sus dígitos son 197, 971 y 719 y los tres números son primos.

Definir la lista

   circulares :: [Integer]

1	circulares :: [Integer]

cuyo valor es la lista de los números primos circulares. Por ejemplo,

   take 16 circulares == [2,3,5,7,11,13,17,31,37,71,73,79,97,113,131,197]
   circulares !! 50   == 933199

1 2	take 16 circulares == [2,3,5,7,11,13,17,31,37,71,73,79,97,113,131,197] circulares !! 50 == 933199

Soluciones

import Data.Numbers.Primes (isPrime, primes)
import Test.QuickCheck (Positive (Positive), quickCheck)

-- 1ª solución
-- ===========
  
circulares1 :: [Integer]
circulares1 = filter esCircular1 primes

-- (esCircular1 n) se verifica si n es un número circular. Por ejemplo, 
--    esCircular1 197  ==  True
--    esCircular1 157  ==  False
esCircular1 :: Integer -> Bool
esCircular1 = all (isPrime . read) . rotaciones1 . show 

-- (rotaciones1 xs) es la lista de las rotaciones obtenidas desplazando
-- el primer elemento xs al final. Por ejemplo,
--    rotaciones1 [2,3,5]  ==  [[2,3,5],[3,5,2],[5,2,3]]
rotaciones1 :: [a] -> [[a]]
rotaciones1 xs = reverse (aux (length xs) [xs])
    where aux 1 yss      = yss
          aux n (ys:yss) = aux (n-1) (rota ys : ys :yss)

-- 2ª solución
-- ===========
  
circulares2 :: [Integer]
circulares2 = filter esCircular2 primes

esCircular2 :: Integer -> Bool
esCircular2 = all (isPrime . read) . rotaciones2 . show 

rotaciones2 :: [a] -> [[a]]
rotaciones2 xs = take (length xs) (iterate rota xs)

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

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

circulares3 :: [Integer]
circulares3 = filter (all isPrime . rotaciones3) primes 

rotaciones3 :: Integer -> [Integer]
rotaciones3 n = [read (take m (drop i (cycle s))) | i <- [1..m]]
    where s = show n
          m = length s

-- 4ª definición
-- =============

-- Nota. La 4ª definición es una mejora observando que para que n sea un
-- número primo circular es necesario que todos los dígitos de n sean
-- impares, salvo para n = 2. 

circulares4 :: [Integer]
circulares4 = 2 : filter esCircular4 primes

-- (esCircular4 n) se verifica si n es un número circular. Por ejemplo, 
--    esCircular4 197  ==  True
--    esCircular4 157  ==  False
esCircular4 :: Integer -> Bool
esCircular4 n = digitosImpares n && 
                all (isPrime . read) (rotaciones2 (show n))

-- (digitosImpares n) se verifica si todos los dígitos de n son
-- impares. Por ejemplo,
--    digitosImpares 7351  ==  True
--    digitosImpares 7341  ==  False
digitosImpares :: Integer -> Bool
digitosImpares = all (`elem` "135679") . show

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

-- La propiedad es
prop_circulares :: Positive Int -> Bool
prop_circulares (Positive n) =
  all (== circulares1 !! n)
      [circulares2 !! n,
       circulares3 !! n,
       circulares4 !! n]

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

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

-- La comparación es
--    λ> circulares1 !! 46
--    331999
--    (2.08 secs, 7,229,208,200 bytes)
--    λ> circulares2 !! 46
--    331999
--    (1.93 secs, 7,165,043,992 bytes)
--    λ> circulares3 !! 46
--    331999
--    (0.74 secs, 2,469,098,648 bytes)
--    λ> circulares4 !! 46
--    331999
--    (0.28 secs, 917,501,600 bytes)

100

101

102

103

104

105

106

107

import Data.Numbers.Primes (isPrime, primes)

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

-- 1ª solución

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

circulares1 :: [Integer]

circulares1 = filter esCircular1 primes

-- (esCircular1 n) se verifica si n es un número circular. Por ejemplo,

-- esCircular1 197 == True

-- esCircular1 157 == False

esCircular1 :: Integer -> Bool

esCircular1 = all (isPrime . read) . rotaciones1 . show

-- (rotaciones1 xs) es la lista de las rotaciones obtenidas desplazando

-- el primer elemento xs al final. Por ejemplo,

-- rotaciones1 [2,3,5] == [[2,3,5],[3,5,2],[5,2,3]]

rotaciones1 :: [a] -> [[a]]

rotaciones1 xs = reverse (aux (length xs) [xs])

where aux 1 yss = yss

aux n (ys:yss) = aux (n-1) (rota ys : ys :yss)

-- 2ª solución

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

circulares2 :: [Integer]

circulares2 = filter esCircular2 primes

esCircular2 :: Integer -> Bool

esCircular2 = all (isPrime . read) . rotaciones2 . show

rotaciones2 :: [a] -> [[a]]

rotaciones2 xs = take (length xs) (iterate rota xs)

-- (rota xs) es la lista añadiendo el primer elemento de xs al

-- final. Por ejemplo,

-- rota [3,2,5,7] == [2,5,7,3]

rota :: [a] -> [a]

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

-- 3ª solución

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

circulares3 :: [Integer]

circulares3 = filter (all isPrime . rotaciones3) primes

rotaciones3 :: Integer -> [Integer]

rotaciones3 n = [read (take m (drop i (cycle s))) | i <- [1..m]]

where s = show n

m = length s

-- 4ª definición

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

-- Nota. La 4ª definición es una mejora observando que para que n sea un

-- número primo circular es necesario que todos los dígitos de n sean

-- impares, salvo para n = 2.

circulares4 :: [Integer]

circulares4 = 2 : filter esCircular4 primes

-- (esCircular4 n) se verifica si n es un número circular. Por ejemplo,

-- esCircular4 197 == True

-- esCircular4 157 == False

esCircular4 :: Integer -> Bool

esCircular4 n = digitosImpares n &&

all (isPrime . read) (rotaciones2 (show n))

-- (digitosImpares n) se verifica si todos los dígitos de n son

-- impares. Por ejemplo,

-- digitosImpares 7351 == True

-- digitosImpares 7341 == False

digitosImpares :: Integer -> Bool

digitosImpares = all (`elem` "135679") . show

-- Comprobación de equivalencia

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

-- La propiedad es

prop_circulares :: Positive Int -> Bool

prop_circulares (Positive n) =

all (== circulares1 !! n)

[circulares2 !! n,

circulares3 !! n,

circulares4 !! n]

-- La comprobación es

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

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> circulares1 !! 46

-- 331999

-- (2.08 secs, 7,229,208,200 bytes)

-- λ> circulares2 !! 46

-- 331999

-- (1.93 secs, 7,165,043,992 bytes)

-- λ> circulares3 !! 46

-- 331999

-- (0.74 secs, 2,469,098,648 bytes)

-- λ> circulares4 !! 46

-- 331999

-- (0.28 secs, 917,501,600 bytes)

El código se encuentra en GitHub.

Diccionario de frecuencias

PorJosé A. Alonso 6-junio-20222-junio-2022

Definir la función

   frecuencias :: Ord a => [a] -> Map a Int

1	frecuencias :: Ord a => [a] -> Map a Int

tal que (frecuencias xs) es el diccionario formado por los elementos de xs junto con el número de veces que aparecen en xs. Por ejemplo,

   λ> frecuencias "sosos"
   fromList [('o',2),('s',3)]
   λ> frecuencias (show (10^100))
   fromList [('0',100),('1',1)]
   λ> frecuencias (take (10^6) (cycle "abc"))
   fromList [('a',333334),('b',333333),('c',333333)]
   λ> size (frecuencias (take (10^6) (cycle [1..10^6])))
   1000000

λ> frecuencias "sosos"

fromList [('o',2),('s',3)]

λ> frecuencias (show (10^100))

fromList [('0',100),('1',1)]

λ> frecuencias (take (10^6) (cycle "abc"))

fromList [('a',333334),('b',333333),('c',333333)]

λ> size (frecuencias (take (10^6) (cycle [1..10^6])))

1000000

Soluciones

import Data.List (foldl')
import Data.Map (Map, empty, insertWith, fromList, fromListWith, size)
import Test.QuickCheck

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

frecuencias1 :: Ord a => [a] -> Map a Int
frecuencias1 []     = empty
frecuencias1 (x:xs) = insertWith (+) x 1 (frecuencias1 xs)

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

frecuencias2 :: Ord a => [a] -> Map a Int
frecuencias2 = foldl' (\d x-> insertWith (+) x 1 d) empty

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

frecuencias3 :: Ord a => [a] -> Map a Int
frecuencias3 xs = fromListWith (+) (zip xs (repeat 1))

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

-- La propiedad es
prop_frecuencias :: [Int] -> Bool
prop_frecuencias xs =
  all (== frecuencias1 xs)
      [ frecuencias2 xs
      , frecuencias3 xs]

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

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

-- La comparación es
--    λ> frecuencias1 (take (10^6) (cycle "abc"))
--    fromList [('a',333334),('b',333333),('c',333333)]
--    (0.89 secs, 453,842,448 bytes)
--    λ> frecuencias2 (take (10^6) (cycle "abc"))
--    fromList [('a',333334),('b',333333),('c',333333)]
--    (0.54 secs, 274,181,128 bytes)
--    λ> frecuencias3 (take (10^6) (cycle "abc"))
--    fromList [('a',333334),('b',333333),('c',333333)]
--    (0.29 secs, 313,787,976 bytes)
     
--    λ> size (frecuencias1 (take (10^6) (cycle [1..10^6])))
--    1000000
--    (3.76 secs, 2,651,926,024 bytes)
--    λ> size (frecuencias2 (take (10^6) (cycle [1..10^6])))
--    1000000
--    (1.03 secs, 1,640,678,448 bytes)
--    λ> size (frecuencias3 (take (10^6) (cycle [1..10^6])))
--    1000000
--    (0.88 secs, 1,672,678,536 bytes)

import Data.List (foldl')

import Data.Map (Map, empty, insertWith, fromList, fromListWith, size)

import Test.QuickCheck

-- 1ª solución

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

frecuencias1 :: Ord a => [a] -> Map a Int

frecuencias1 [] = empty

frecuencias1 (x:xs) = insertWith (+) x 1 (frecuencias1 xs)

-- 2ª solución

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

frecuencias2 :: Ord a => [a] -> Map a Int

frecuencias2 = foldl' (\d x-> insertWith (+) x 1 d) empty

-- 3ª solución

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

frecuencias3 :: Ord a => [a] -> Map a Int

frecuencias3 xs = fromListWith (+) (zip xs (repeat 1))

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_frecuencias :: [Int] -> Bool

prop_frecuencias xs =

all (== frecuencias1 xs)

[ frecuencias2 xs

, frecuencias3 xs]

-- La comprobación es

-- λ> quickCheck prop_frecuencias

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> frecuencias1 (take (10^6) (cycle "abc"))

-- fromList [('a',333334),('b',333333),('c',333333)]

-- (0.89 secs, 453,842,448 bytes)

-- λ> frecuencias2 (take (10^6) (cycle "abc"))

-- fromList [('a',333334),('b',333333),('c',333333)]

-- (0.54 secs, 274,181,128 bytes)

-- λ> frecuencias3 (take (10^6) (cycle "abc"))

-- fromList [('a',333334),('b',333333),('c',333333)]

-- (0.29 secs, 313,787,976 bytes)

-- λ> size (frecuencias1 (take (10^6) (cycle [1..10^6])))

-- 1000000

-- (3.76 secs, 2,651,926,024 bytes)

-- λ> size (frecuencias2 (take (10^6) (cycle [1..10^6])))

-- 1000000

-- (1.03 secs, 1,640,678,448 bytes)

-- λ> size (frecuencias3 (take (10^6) (cycle [1..10^6])))

-- 1000000

-- (0.88 secs, 1,672,678,536 bytes)

El código se encuentra en GitHub.

Descomposiciones con sumandos 1 ó 2

PorJosé A. Alonso 3-junio-20225-junio-2022

Definir la funciones

   sumas  :: Int -> [[Int]]
   nSumas :: Int -> Integer

1 2	sumas :: Int -> [[Int]] nSumas :: Int -> Integer

tales que

(sumas n) es la lista de las descomposiciones de n como sumas cuyos sumandos son 1 ó 2. Por ejemplo,

      sumas 1            ==  [[1]]
      sumas 2            ==  [[1,1],[2]]
      sumas 3            ==  [[1,1,1],[1,2],[2,1]]
      sumas 4            ==  [[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[2,2]]
      length (sumas 26)  ==  196418
      length (sumas 33)  ==  5702887

sumas 1 == [[1]]

sumas 2 == [[1,1],[2]]

sumas 3 == [[1,1,1],[1,2],[2,1]]

sumas 4 == [[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[2,2]]

length (sumas 26) == 196418

length (sumas 33) == 5702887

(nSumas n) es el número de descomposiciones de n como sumas cuyos sumandos son 1 ó 2. Por ejemplo,

      nSumas 4                      ==  5
      nSumas 123                    ==  36726740705505779255899443
      length (show (nSumas 123456)) ==  25801

nSumas 4 == 5

nSumas 123 == 36726740705505779255899443

length (show (nSumas 123456)) == 25801

Soluciones

import Data.List  (genericIndex, genericLength)
import Data.Array ((!), array)
import Test.QuickCheck (Positive(Positive), quickCheckWith)

-- 1ª solución de sumas
-- ====================

sumas1 :: Int -> [[Int]]
sumas1 0 = [[]]
sumas1 1 = [[1]]
sumas1 n = [1:xs | xs <- sumas1 (n-1)] ++ [2:xs | xs <- sumas1 (n-2)]

-- 2ª solución de sumas
-- ====================

sumas2 :: Int -> [[Int]]
sumas2 0 = [[]]
sumas2 1 = [[1]]
sumas2 n = map (1:) (sumas2 (n-1)) ++ map (2:) (sumas2 (n-2))

-- 3ª solución de sumas
-- ====================

sumas3 :: Int -> [[Int]]
sumas3 n = v ! n
  where v = array (0,n) [(i, f i) | i <- [0..n]]
        f 0 = [[]]
        f 1 = [[1]]
        f k = map (1:) (v!(k-1)) ++ map (2:) (v!(k-2))
 
-- 4ª solución de sumas
-- ====================

sumas4 :: Int -> [[Int]]
sumas4 n = sucSumas !! n

-- sucSumas es la sucesión cuyo n-ésimo elemento es la lista de las
-- descomposiciones de n como sumas cuyos sumandos son 1 ó 2. Por
-- ejemplo,
--    λ> take 4 sucSumas
--    [[[]],[[1]],[[1,1],[2]],[[1,1,1],[1,2],[2,1]]]
--    λ> mapM_ print (take 5 sucSumas)
--    [[]]
--    [[1]]
--    [[1,1],[2]]
--    [[1,1,1],[1,2],[2,1]]
--    [[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[2,2]]
sucSumas :: [[[Int]]]
sucSumas = [[]] : [[1]] : zipWith f (tail sucSumas) sucSumas
  where f xs ys = map (1:) xs ++ map (2:) ys

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

-- La propiedad es
prop_sumas :: Positive Int -> Bool
prop_sumas (Positive n) =
  all (== sumas1 n)
      [sumas2 n,
       sumas3 n,
       sumas4 n]

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

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

-- La comparación es
--    λ> length (sumas1 28)
--    514229
--    (2.79 secs, 1,739,784,512 bytes)
--    λ> length (sumas2 28)
--    514229
--    (1.33 secs, 1,512,291,248 bytes)
--    λ> length (sumas3 28)
--    514229
--    (0.20 secs, 165,215,800 bytes)
--    λ> length (sumas4 28)
--    514229
--    (0.17 secs, 165,201,592 bytes)
--
--    λ> length (sumas3 33)
--    5702887
--    (2.16 secs, 1,830,761,864 bytes)
--    λ> length (sumas4 33)
--    5702887
--    (1.44 secs, 1,830,749,832 bytes)

-- Definición de sumas
-- ===================

-- La cuarta solución es más eficiente y es la que usaremos en lo
-- sucesivo:
sumas :: Int -> [[Int]]
sumas = sumas4

-- 1ª solución de nSumas
-- =====================

nSumas1 :: Int -> Integer
nSumas1 = genericLength . sumas2

-- 2ª solución de nSumas
-- =====================

nSumas2 :: Int -> Integer
nSumas2 0 = 1
nSumas2 1 = 1
nSumas2 n = nSumas2 (n-1) + nSumas2 (n-2)

-- 3ª solución de nSumas
-- =====================

nSumas3 :: Int -> Integer
nSumas3 n = v ! n
  where v = array (0,n) [(i,f i) | i <- [0..n]]
        f 0 = 1
        f 1 = 1
        f k = v ! (k-1) + v ! (k-2)

-- 4ª solución de nSumas
-- =====================

nSumas4 :: Int -> Integer
nSumas4 n = aux `genericIndex` n
  where aux = 1 : 1 : zipWith (+) aux (tail aux) 

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

-- La propiedad es
prop_nSumas :: Positive Int -> Bool
prop_nSumas (Positive n) =
  all (== nSumas1 n)
      [nSumas2 n,
       nSumas3 n,
       nSumas4 n]

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

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

-- La comparación es
--    λ> nSumas1 33
--    5702887
--    (17.32 secs, 23,140,562,600 bytes)
--    λ> nSumas2 33
--    5702887
--    (3.48 secs, 1,870,676,904 bytes)
--    λ> nSumas3 33
--    5702887
--    (0.00 secs, 152,960 bytes)
--    λ> nSumas4 33
--    5702887
--    (0.00 secs, 139,456 bytes)
--    
--    λ> length (show (nSumas3 (2*10^5)))
--    41798
--    (1.41 secs, 1,895,295,528 bytes)
--    λ> length (show (nSumas4 (2*10^5)))
--    41798
--    (2.39 secs, 1,834,998,800 bytes)

-- Nota. El valor de (nSumas n) es el n-ésimo término de la sucesión de
-- Fibonacci 1, 1, 2, 3, 5, 8, ...

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

import Data.List (genericIndex, genericLength)

import Data.Array ((!), array)

import Test.QuickCheck (Positive(Positive), quickCheckWith)

-- 1ª solución de sumas

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

sumas1 :: Int -> [[Int]]

sumas1 0 = [[]]

sumas1 1 = [[1]]

sumas1 n = [1:xs | xs <- sumas1 (n-1)] ++ [2:xs | xs <- sumas1 (n-2)]

-- 2ª solución de sumas

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

sumas2 :: Int -> [[Int]]

sumas2 0 = [[]]

sumas2 1 = [[1]]

sumas2 n = map (1:) (sumas2 (n-1)) ++ map (2:) (sumas2 (n-2))

-- 3ª solución de sumas

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

sumas3 :: Int -> [[Int]]

sumas3 n = v ! n

where v = array (0,n) [(i, f i) | i <- [0..n]]

f 0 = [[]]

f 1 = [[1]]

f k = map (1:) (v!(k-1)) ++ map (2:) (v!(k-2))

-- 4ª solución de sumas

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

sumas4 :: Int -> [[Int]]

sumas4 n = sucSumas !! n

-- sucSumas es la sucesión cuyo n-ésimo elemento es la lista de las

-- descomposiciones de n como sumas cuyos sumandos son 1 ó 2. Por

-- ejemplo,

-- λ> take 4 sucSumas

-- [[[]],[[1]],[[1,1],[2]],[[1,1,1],[1,2],[2,1]]]

-- λ> mapM_ print (take 5 sucSumas)

-- [[]]

-- [[1]]

-- [[1,1],[2]]

-- [[1,1,1],[1,2],[2,1]]

-- [[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[2,2]]

sucSumas :: [[[Int]]]

sucSumas = [[]] : [[1]] : zipWith f (tail sucSumas) sucSumas

where f xs ys = map (1:) xs ++ map (2:) ys

-- Comprobación de equivalencia de sumas

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

-- La propiedad es

prop_sumas :: Positive Int -> Bool

prop_sumas (Positive n) =

all (== sumas1 n)

[sumas2 n,

sumas3 n,

sumas4 n]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_sumas

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia de sumas

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

-- La comparación es

-- λ> length (sumas1 28)

-- 514229

-- (2.79 secs, 1,739,784,512 bytes)

-- λ> length (sumas2 28)

-- 514229

-- (1.33 secs, 1,512,291,248 bytes)

-- λ> length (sumas3 28)

-- 514229

-- (0.20 secs, 165,215,800 bytes)

-- λ> length (sumas4 28)

-- 514229

-- (0.17 secs, 165,201,592 bytes)

-- λ> length (sumas3 33)

-- 5702887

-- (2.16 secs, 1,830,761,864 bytes)

-- λ> length (sumas4 33)

-- 5702887

-- (1.44 secs, 1,830,749,832 bytes)

-- Definición de sumas

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

-- La cuarta solución es más eficiente y es la que usaremos en lo

-- sucesivo:

sumas :: Int -> [[Int]]

sumas = sumas4

-- 1ª solución de nSumas

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

nSumas1 :: Int -> Integer

nSumas1 = genericLength . sumas2

-- 2ª solución de nSumas

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

nSumas2 :: Int -> Integer

nSumas2 0 = 1

nSumas2 1 = 1

nSumas2 n = nSumas2 (n-1) + nSumas2 (n-2)

-- 3ª solución de nSumas

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

nSumas3 :: Int -> Integer

nSumas3 n = v ! n

where v = array (0,n) [(i,f i) | i <- [0..n]]

f 0 = 1

f 1 = 1

f k = v ! (k-1) + v ! (k-2)

-- 4ª solución de nSumas

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

nSumas4 :: Int -> Integer

nSumas4 n = aux `genericIndex` n

where aux = 1 : 1 : zipWith (+) aux (tail aux)

-- Comprobación de equivalencia de nSumas

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

-- La propiedad es

prop_nSumas :: Positive Int -> Bool

prop_nSumas (Positive n) =

all (== nSumas1 n)

[nSumas2 n,

nSumas3 n,

nSumas4 n]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_nSumas

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia de nSumas

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

-- La comparación es

-- λ> nSumas1 33

-- 5702887

-- (17.32 secs, 23,140,562,600 bytes)

-- λ> nSumas2 33

-- 5702887

-- (3.48 secs, 1,870,676,904 bytes)

-- λ> nSumas3 33

-- 5702887

-- (0.00 secs, 152,960 bytes)

-- λ> nSumas4 33

-- 5702887

-- (0.00 secs, 139,456 bytes)

-- λ> length (show (nSumas3 (2*10^5)))

-- 41798

-- (1.41 secs, 1,895,295,528 bytes)

-- λ> length (show (nSumas4 (2*10^5)))

-- 41798

-- (2.39 secs, 1,834,998,800 bytes)

-- Nota. El valor de (nSumas n) es el n-ésimo término de la sucesión de

-- Fibonacci 1, 1, 2, 3, 5, 8, ...

El código se encuentra en GitHub.

Suma de los elementos de las diagonales matrices espirales

PorJosé A. Alonso 2-junio-202231-mayo-2022

Empezando con el número 1 y moviéndose en el sentido de las agujas del reloj se obtienen las matrices espirales

   |1 2|   |7 8 9|   | 7  8  9 10|   |21 22 23 24 25|
   |4 3|   |6 1 2|   | 6  1  2 11|   |20  7  8  9 10|
           |5 4 3|   | 5  4  3 12|   |19  6  1  2 11|
                     |16 15 14 13|   |18  5  4  3 12|
                                     |17 16 15 14 13|

|1 2| |7 8 9| | 7 8 9 10| |21 22 23 24 25|

|4 3| |6 1 2| | 6 1 2 11| |20 7 8 9 10|

|5 4 3| | 5 4 3 12| |19 6 1 2 11|

|16 15 14 13| |18 5 4 3 12|

|17 16 15 14 13|

La suma los elementos de sus diagonales es

   + en la 2x2: 1+3+2+4               =  10
   + en la 3x3: 1+3+5+7+9             =  25
   + en la 4x4: 1+2+3+4+7+10+13+16    =  56
   + en la 5x5: 1+3+5+7+9+13+17+21+25 = 101

+ en la 2x2: 1+3+2+4 = 10

+ en la 3x3: 1+3+5+7+9 = 25

+ en la 4x4: 1+2+3+4+7+10+13+16 = 56

+ en la 5x5: 1+3+5+7+9+13+17+21+25 = 101

Definir la función

   sumaDiagonales :: Integer -> Integer

1	sumaDiagonales :: Integer -> Integer

tal que (sumaDiagonales n) es la suma de los elementos en las diagonales de la matriz espiral de orden nxn. Por ejemplo.

   sumaDiagonales 1         ==  1
   sumaDiagonales 2         ==  10
   sumaDiagonales 3         ==  25
   sumaDiagonales 4         ==  56
   sumaDiagonales 5         ==  101
   sumaDiagonales (10^6)    ==  666667166668000000
   sumaDiagonales (1+10^6)  ==  666669166671000001

   sumaDiagonales (10^2)  ==         671800
   sumaDiagonales (10^3)  ==        667168000
   sumaDiagonales (10^4)  ==       666716680000
   sumaDiagonales (10^5)  ==      666671666800000
   sumaDiagonales (10^6)  ==     666667166668000000
   sumaDiagonales (10^7)  ==    666666716666680000000
   sumaDiagonales (10^8)  ==   666666671666666800000000
   sumaDiagonales (10^9)  ==  666666667166666668000000000

sumaDiagonales 1 == 1

sumaDiagonales 2 == 10

sumaDiagonales 3 == 25

sumaDiagonales 4 == 56

sumaDiagonales 5 == 101

sumaDiagonales (10^6) == 666667166668000000

sumaDiagonales (1+10^6) == 666669166671000001

sumaDiagonales (10^2) == 671800

sumaDiagonales (10^3) == 667168000

sumaDiagonales (10^4) == 666716680000

sumaDiagonales (10^5) == 666671666800000

sumaDiagonales (10^6) == 666667166668000000

sumaDiagonales (10^7) == 666666716666680000000

sumaDiagonales (10^8) == 666666671666666800000000

sumaDiagonales (10^9) == 666666667166666668000000000

Comprobar con QuickCheck que el último dígito de (sumaDiagonales n) es 0, 4 ó 6 si n es par y es 1, 5 ó 7 en caso contrario.

Soluciones

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

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

sumaDiagonales1 :: Integer -> Integer
sumaDiagonales1 = sum . elementosEnDiagonales

-- (elementosEnDiagonales n) es la lista de los elementos en las
-- diagonales de la matriz espiral de orden nxn. Por ejemplo,
--    elementosEnDiagonales 1  ==  [1]
--    elementosEnDiagonales 2  ==  [1,2,3,4]
--    elementosEnDiagonales 3  ==  [1,3,5,7,9]
--    elementosEnDiagonales 4  ==  [1,2,3,4,7,10,13,16]
--    elementosEnDiagonales 5  ==  [1,3,5,7,9,13,17,21,25]
elementosEnDiagonales :: Integer -> [Integer]
elementosEnDiagonales n 
  | even n    = tail (scanl (+) 0 (concatMap (replicate 4) [1,3..n-1]))
  | otherwise = scanl (+) 1 (concatMap (replicate 4) [2,4..n-1])

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

sumaDiagonales2 :: Integer -> Integer
sumaDiagonales2 n
  | even n    = (-1) + n `div` 2 + sum [2*k^2-k+1 | k <- [0..n]]
  | otherwise = 1 + sum [4*k^2-6*k+6 | k <- [3,5..n]]

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

sumaDiagonales3 :: Integer -> Integer
sumaDiagonales3 n
  | even n    = n * (4*n^2 + 3*n + 8) `div` 6
  | otherwise = (4*n^3 + 3*n^2 + 8*n - 9) `div` 6

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

-- La propiedad es
prop_sumaDiagonales :: Positive Integer -> Bool
prop_sumaDiagonales (Positive n) =
  all (== sumaDiagonales1 n)
      [sumaDiagonales2 n,
       sumaDiagonales3 n]

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

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

-- La comparación es
--    λ> sumaDiagonales (2*10^6)
--    5333335333336000000
--    (2.30 secs, 1,521,955,848 bytes)
--    λ> sumaDiagonales2 (2*10^6)
--    5333335333336000000
--    (2.77 secs, 1,971,411,440 bytes)
--    λ> sumaDiagonales3 (2*10^6)
--    5333335333336000000
--    (0.01 secs, 139,520 bytes)

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

-- La propiedad es
prop_sumaDiagonales2 :: Positive Integer -> Bool
prop_sumaDiagonales2 (Positive n) 
  | even n    = x `elem` [0,4,6] 
  | otherwise = x `elem` [1,5,7] 
  where x = sumaDiagonales1 n `mod` 10

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

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

-- 1ª solución

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

sumaDiagonales1 :: Integer -> Integer

sumaDiagonales1 = sum . elementosEnDiagonales

-- (elementosEnDiagonales n) es la lista de los elementos en las

-- diagonales de la matriz espiral de orden nxn. Por ejemplo,

-- elementosEnDiagonales 1 == [1]

-- elementosEnDiagonales 2 == [1,2,3,4]

-- elementosEnDiagonales 3 == [1,3,5,7,9]

-- elementosEnDiagonales 4 == [1,2,3,4,7,10,13,16]

-- elementosEnDiagonales 5 == [1,3,5,7,9,13,17,21,25]

elementosEnDiagonales :: Integer -> [Integer]

elementosEnDiagonales n

| even n = tail (scanl (+) 0 (concatMap (replicate 4) [1,3..n-1]))

| otherwise = scanl (+) 1 (concatMap (replicate 4) [2,4..n-1])

-- 2ª solución

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

sumaDiagonales2 :: Integer -> Integer

sumaDiagonales2 n

| even n = (-1) + n `div` 2 + sum [2*k^2-k+1 | k <- [0..n]]

| otherwise = 1 + sum [4*k^2-6*k+6 | k <- [3,5..n]]

-- 3ª solución

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

sumaDiagonales3 :: Integer -> Integer

sumaDiagonales3 n

| even n = n * (4*n^2 + 3*n + 8) `div` 6

| otherwise = (4*n^3 + 3*n^2 + 8*n - 9) `div` 6

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_sumaDiagonales :: Positive Integer -> Bool

prop_sumaDiagonales (Positive n) =

all (== sumaDiagonales1 n)

[sumaDiagonales2 n,

sumaDiagonales3 n]

-- La comprobación es

-- λ> quickCheck prop_sumaDiagonales_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sumaDiagonales (2*10^6)

-- 5333335333336000000

-- (2.30 secs, 1,521,955,848 bytes)

-- λ> sumaDiagonales2 (2*10^6)

-- 5333335333336000000

-- (2.77 secs, 1,971,411,440 bytes)

-- λ> sumaDiagonales3 (2*10^6)

-- 5333335333336000000

-- (0.01 secs, 139,520 bytes)

-- Propiedad

-- =========

-- La propiedad es

prop_sumaDiagonales2 :: Positive Integer -> Bool

prop_sumaDiagonales2 (Positive n)

| even n = x `elem` [0,4,6]

| otherwise = x `elem` [1,5,7]

where x = sumaDiagonales1 n `mod` 10

-- La comprobación es

-- λ> quickCheck prop_sumaDiagonales2

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

Término ausente en una progresión aritmética

PorJosé A. Alonso 1-junio-202230-mayo-2022

Una progresión aritmética es una sucesión de números tales que la diferencia de dos términos sucesivos cualesquiera de la sucesión es constante.

Definir la función

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

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

tal que (ausente xs) es el único término ausente de la progresión aritmética xs. Por ejemplo,

   ausente [3,7,9,11]               ==  5
   ausente [3,5,9,11]               ==  7
   ausente [3,5,7,11]               ==  9
   ausente ([1..9]++[11..])         ==  10
   ausente ([1..10^6] ++ [2+10^6])  ==  1000001

ausente [3,7,9,11] == 5

ausente [3,5,9,11] == 7

ausente [3,5,7,11] == 9

ausente ([1..9]++[11..]) == 10

ausente ([1..10^6] ++ [2+10^6]) == 1000001

Nota. Se supone que la lista tiene al menos 3 elementos, que puede ser infinita y que sólo hay un término de la progresión aritmética que no está en la lista.

Soluciones

import Data.List (group, genericLength)
import Test.QuickCheck (Arbitrary, Gen,
                        arbitrary, frequency, suchThat, quickCheck) 

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

ausente1 :: Integral a => [a] -> a
ausente1 (x1:xs@(x2:x3:_))
  | d1 == d2     = ausente1 xs
  | d1 == 2 * d2 = x1 + d2
  | d2 == 2 * d1 = x2 + d1
  where d1 = x2 - x1
        d2 = x3 - x2          

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

ausente2 :: Integral a => [a] -> a
ausente2 s@(x1:x2:x3:_) 
  | x1 + x3 /= 2 * x2 = x1 + (x3 - x2)
  | otherwise         = head [a | (a,b) <- zip [x1,x2..] s
                                , a /= b]

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

ausente3 :: Integral a => [a] -> a
ausente3  xs@(x1:x2:_) 
  | null us   = x1 + v
  | otherwise = x2 + u * genericLength (u:us) 
  where ((u:us):(v:_):_) = group (zipWith (-) (tail xs) xs)

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

-- Tipo de progresiones aritméticas con un término ausente.
newtype PAconAusente = PA [Integer]
  deriving Show

-- Generación de progresiones aritméticas con un término ausente. 
progresionConAusenteArbitraria :: Gen PAconAusente
progresionConAusenteArbitraria = do
  x <- arbitrary
  d <- arbitrary `suchThat` (/= 0)
  n <- arbitrary `suchThat` (> 2)
  k <- arbitrary `suchThat` (> 0)
  let (as,_:bs) = splitAt k [x,x+d..]
  frequency [(1,return (PA (as ++ bs))),
             (1,return (PA (take (length as + n) (as ++ bs))))]

-- Inclusión del tipo PAconAusente en Arbitrary.
instance Arbitrary PAconAusente where
  arbitrary = progresionConAusenteArbitraria

-- La propiedad es
prop_ausente :: PAconAusente -> Bool 
prop_ausente (PA xs) =
  all (== ausente1 xs)
      [ausente2 xs,
       ausente3 xs]

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

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

-- La comparación es
--    λ> let n = 10^6 in ausente1 ([1..n] ++ [n+2])
--    1000001
--    (1.15 secs, 560,529,520 bytes)
--    λ> let n = 10^6 in ausente2 ([1..n] ++ [n+2])
--    1000001
--    (0.33 secs, 336,530,680 bytes)
--    λ> let n = 10^6 in ausente3 ([1..n] ++ [n+2])
--    1000001
--    (0.50 secs, 498,047,584 bytes)

import Data.List (group, genericLength)

import Test.QuickCheck (Arbitrary, Gen,

arbitrary, frequency, suchThat, quickCheck)

-- 1ª solución

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

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

ausente1 (x1:xs@(x2:x3:_))

| d1 == d2 = ausente1 xs

| d1 == 2 * d2 = x1 + d2

| d2 == 2 * d1 = x2 + d1

where d1 = x2 - x1

d2 = x3 - x2

-- 2ª solución

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

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

ausente2 s@(x1:x2:x3:_)

| x1 + x3 /= 2 * x2 = x1 + (x3 - x2)

| otherwise = head [a | (a,b) <- zip [x1,x2..] s

, a /= b]

-- 3ª solución

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

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

ausente3 xs@(x1:x2:_)

| null us = x1 + v

| otherwise = x2 + u * genericLength (u:us)

where ((u:us):(v:_):_) = group (zipWith (-) (tail xs) xs)

-- Comprobación de equivalencia

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

-- Tipo de progresiones aritméticas con un término ausente.

newtype PAconAusente = PA [Integer]

deriving Show

-- Generación de progresiones aritméticas con un término ausente.

progresionConAusenteArbitraria :: Gen PAconAusente

progresionConAusenteArbitraria = do

x <- arbitrary

d <- arbitrary `suchThat` (/= 0)

n <- arbitrary `suchThat` (> 2)

k <- arbitrary `suchThat` (> 0)

let (as,_:bs) = splitAt k [x,x+d..]

frequency [(1,return (PA (as ++ bs))),

(1,return (PA (take (length as + n) (as ++ bs))))]

-- Inclusión del tipo PAconAusente en Arbitrary.

instance Arbitrary PAconAusente where

arbitrary = progresionConAusenteArbitraria

-- La propiedad es

prop_ausente :: PAconAusente -> Bool

prop_ausente (PA xs) =

all (== ausente1 xs)

[ausente2 xs,

ausente3 xs]

-- La comprobación es

-- λ> quickCheck prop_ausente

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> let n = 10^6 in ausente1 ([1..n] ++ [n+2])

-- 1000001

-- (1.15 secs, 560,529,520 bytes)

-- λ> let n = 10^6 in ausente2 ([1..n] ++ [n+2])

-- 1000001

-- (0.33 secs, 336,530,680 bytes)

-- λ> let n = 10^6 in ausente3 ([1..n] ++ [n+2])

-- 1000001

-- (0.50 secs, 498,047,584 bytes)

El código se encuentra en GitHub.

Primos circulares

Soluciones

Diccionario de frecuencias

Soluciones

Descomposiciones con sumandos 1 ó 2

Soluciones

Suma de los elementos de las diagonales matrices espirales

Soluciones

Término ausente en una progresión aritmética

Soluciones

Entradas recientes

Buscar

Correo electrónico