zip – Exercitium

Representación de Zeckendorf

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

Los primeros números de Fibonacci son

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

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

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

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

   100 = 89 + 8 + 3

1	100 = 89 + 8 + 3

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

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

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

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

Definir la función

   zeckendorf :: Integer -> [Integer]

1	zeckendorf :: Integer -> [Integer]

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

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

zeckendorf 100 == [89,8,3]

zeckendorf 200 == [144,55,1]

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

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

Soluciones

module Representacion_de_Zeckendorf where

import Data.List (subsequences)
import Test.QuickCheck

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

module Representacion_de_Zeckendorf where

import Data.List (subsequences)

import Test.QuickCheck

-- 1ª solución

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

zeckendorf1 :: Integer -> [Integer]

zeckendorf1 = head . zeckendorf1Aux

zeckendorf1Aux :: Integer -> [[Integer]]

zeckendorf1Aux n =

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

sum xs == n,

sinFibonacciConsecutivos xs]

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

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

fibs :: [Integer]

fibs = 1 : scanl (+) 1 fibs

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

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

-- ejemplo,

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

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

-- ejemplo,

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

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

sinFibonacciConsecutivos :: [Integer] -> Bool

sinFibonacciConsecutivos xs =

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

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

-- n. Por ejemplo,

-- siguienteFibonacci 34 == 55

siguienteFibonacci :: Integer -> Integer

siguienteFibonacci n =

head (dropWhile (<= n) fibs)

-- 2ª solución

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

zeckendorf2 :: Integer -> [Integer]

zeckendorf2 = head . zeckendorf2Aux

zeckendorf2Aux :: Integer -> [[Integer]]

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

where aux 0 _ = [[]]

aux m (x:y:zs)

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

| otherwise = []

-- 3ª solución

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

zeckendorf3 :: Integer -> [Integer]

zeckendorf3 0 = []

zeckendorf3 n = x : zeckendorf3 (n - x)

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

-- 4ª solución

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

zeckendorf4 :: Integer -> [Integer]

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

where aux 0 _ = []

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

-- Comprobación de equivalencia

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

-- La propiedad es

prop_zeckendorf :: Positive Integer -> Bool

prop_zeckendorf (Positive n) =

all (== zeckendorf1 n)

[zeckendorf2 n,

zeckendorf3 n,

zeckendorf4 n]

-- La comprobación es

-- λ> quickCheck prop_zeckendorf

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

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

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

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

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

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

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

-- λ> zeckendorf2 (10^6)

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

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

-- λ> zeckendorf3 (10^6)

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

-- (0.01 secs, 542,488 bytes)

-- λ> zeckendorf4 (10^6)

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

-- (0.01 secs, 536,424 bytes)

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

-- 3947

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

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

-- 2611

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

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

-- 66097

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

El código se encuentra en GitHub.

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

Separación por posición

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

Definir la función

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

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

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

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

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

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

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

Soluciones

module Separacion_por_posicion where

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

module Separacion_por_posicion where

import Data.List (partition)

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

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

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

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

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

where nxs = enumeracion xs

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

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

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

enumeracion = zip [0..]

-- 2ª solución

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

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

particion2 [] = ([],[])

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

where (ys,zs) = particion2 xs

-- 3ª solución

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

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

particion3 = foldr f ([],[])

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

-- 4ª solución

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

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

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

-- 5ª solución

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

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

particion5 xs =

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

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

where n = length xs - 1

-- 6ª solución

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

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

particion6 xs = (pares xs, impares xs)

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

-- pares. Por ejemplo,

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

pares :: [a] -> [a]

pares [] = []

pares (x:xs) = x : impares xs

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

-- impares. Por ejemplo,

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

impares :: [a] -> [a]

impares [] = []

impares (_:xs) = pares xs

-- 7ª solución

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

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

particion7 [] = ([],[])

particion7 xs =

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

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

where v = V.fromList xs

n = V.length v

-- 8ª solución

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

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

particion8 xs =

(map snd ys, map snd zs)

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

posicionPar :: (Int,a) -> Bool

posicionPar = even . fst

-- Comprobación de equivalencia

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

-- La propiedad es

prop_particion :: [Int] -> Bool

prop_particion xs =

all (== particion1 xs)

[particion2 xs,

particion3 xs,

particion4 xs,

particion5 xs,

particion6 xs,

particion7 xs,

particion8 xs]

-- La comprobación es

-- λ> quickCheck prop_particion

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

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

-- 6000000

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

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

-- 6000000

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

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

-- 6000000

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

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

-- 6000000

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

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

-- 6000000

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

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

-- 6000000

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

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

-- 6000000

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

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

-- 6000000

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

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

-- 6000000

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

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

-- 10000000

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

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

-- 10000000

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

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

-- 10000000

-- (1.33 secs, 5,640,516,960 bytes)

El código se encuentra en GitHub.

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

Nuevas soluciones

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

Código de las alergias

PorJosé A. Alonso 11-abril-2022

Para la determinación de las alergia se utiliza los siguientes códigos para los alérgenos:

   Huevos ........   1
   Cacahuetes ....   2
   Mariscos ......   4
   Fresas ........   8
   Tomates .......  16
   Chocolate .....  32
   Polen .........  64
   Gatos ......... 128

Huevos ........ 1

Cacahuetes .... 2

Mariscos ...... 4

Fresas ........ 8

Tomates ....... 16

Chocolate ..... 32

Polen ......... 64

Gatos ......... 128

Así, si Juan es alérgico a los cacahuetes y al chocolate, su puntuación es 34 (es decir, 2+32).

Los alérgenos se representan mediante el siguiente tipo de dato

  data Alergeno = Huevos
                | Cacahuetes
                | Mariscos
                | Fresas
                | Tomates
                | Chocolate
                | Polen
                | Gatos
    deriving (Enum, Eq, Show, Bounded)

data Alergeno = Huevos

| Cacahuetes

| Mariscos

| Fresas

| Tomates

| Chocolate

| Polen

| Gatos

deriving (Enum, Eq, Show, Bounded)

Definir la función

   alergias :: Int -> [Alergeno]

1	alergias :: Int -> [Alergeno]

tal que (alergias n) es la lista de alergias correspondiente a una puntuación n. Por ejemplo,

   λ> alergias 1
   [Huevos]
   λ> alergias 2
   [Cacahuetes]
   λ> alergias 3
   [Huevos,Cacahuetes]
   λ> alergias 5
   [Huevos,Mariscos]
   λ> alergias 255
   [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

λ> alergias 1

[Huevos]

λ> alergias 2

[Cacahuetes]

λ> alergias 3

[Huevos,Cacahuetes]

λ> alergias 5

[Huevos,Mariscos]

λ> alergias 255

[Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

Soluciones

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

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

[/schedule]

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

import Data.List (subsequences)
import Test.QuickCheck

data Alergeno =
    Huevos
  | Cacahuetes
  | Mariscos
  | Fresas
  | Tomates
  | Chocolate
  | Polen
  | Gatos
  deriving (Enum, Eq, Show, Bounded)

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

alergias1 :: Int -> [Alergeno]
alergias1 n =
  [a | (a,c) <- zip alergenos codigos, c `elem` descomposicion n]

-- codigos es la lista de los códigos de los alergenos.
codigos :: [Int]
codigos = [2^x| x <- [0..7]]

-- (descomposicion n) es la descomposición de n como sumas de potencias
-- de 2. Por ejemplo,
--    descomposicion 3    ==  [1,2]
--    descomposicion 5    ==  [1,4]
--    descomposicion 248  ==  [8,16,32,64,128]
--    descomposicion 255  ==  [1,2,4,8,16,32,64,128]
descomposicion :: Int -> [Int]
descomposicion n =
  head [xs | xs <- subsequences codigos, sum xs == n]

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

alergias2 :: Int -> [Alergeno]
alergias2 = map toEnum . codigosAlergias

-- (codigosAlergias n) es la lista de códigos de alergias
-- correspondiente a una puntuación n. Por ejemplo,
--    codigosAlergias 1  ==  [0]
--    codigosAlergias 2  ==  [1]
--    codigosAlergias 3  ==  [0,1]
--    codigosAlergias 4  ==  [2]
--    codigosAlergias 5  ==  [0,2]
--    codigosAlergias 6  ==  [1,2]
codigosAlergias :: Int -> [Int]
codigosAlergias = aux [0..7]
  where aux []     _             = []
        aux (x:xs) n | odd n     = x : aux xs (n `div` 2)
                     | otherwise = aux xs (n `div` 2)

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

alergias3 :: Int -> [Alergeno]
alergias3 = map toEnum . codigosAlergias3

codigosAlergias3 :: Int -> [Int]
codigosAlergias3 n =
  [x | (x,y) <- zip [0..7] (int2bin n), y == 1]

-- (int2bin n) es la representación binaria del número n. Por ejemplo,
--    int2bin 10  ==  [0,1,0,1]
-- ya que 10 = 0*1 + 1*2 + 0*4 + 1*8
int2bin :: Int -> [Int]
int2bin n | n < 2     = [n]
          | otherwise = n `rem` 2 : int2bin (n `div` 2)

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

alergias4 :: Int -> [Alergeno]
alergias4 = map toEnum . codigosAlergias4

codigosAlergias4 :: Int -> [Int]
codigosAlergias4 n =
  map fst (filter ((== 1) . snd) (zip  [0..7] (int2bin n)))

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

alergias5 :: Int -> [Alergeno]
alergias5 = map (toEnum . fst)
          . filter ((1 ==) . snd)
          . zip [0..7]
          . int2bin

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

alergias6 :: Int -> [Alergeno]
alergias6 = aux alergenos
  where aux []     _             = []
        aux (x:xs) n | odd n     = x : aux xs (n `div` 2)
                     | otherwise = aux xs (n `div` 2)

-- alergenos es la lista de los alergenos. Por ejemplo.
--    take 3 alergenos  ==  [Huevos,Cacahuetes,Mariscos]
alergenos :: [Alergeno]
alergenos = [minBound..maxBound]

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

-- La propiedad es
prop_alergias :: Property
prop_alergias =
  forAll (arbitrary `suchThat` esValido) $ \n ->
  all (== alergias1 n)
      [alergias2 n,
       alergias3 n,
       alergias4 n,
       alergias5 n,
       alergias6 n]
  where esValido x = 1 <= x && x <= 255

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

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

-- La comparación es
--    λ> last (map alergias1 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.02 secs, 1,657,912 bytes)
--    λ> last (map alergias2 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.01 secs, 597,080 bytes)
--    λ> last (map alergias3 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.01 secs, 597,640 bytes)
--    λ> last (map alergias4 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.01 secs, 598,152 bytes)
--    λ> last (map alergias5 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.01 secs, 596,888 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

import Data.List (subsequences)

import Test.QuickCheck

data Alergeno =

Huevos

| Cacahuetes

| Mariscos

| Fresas

| Tomates

| Chocolate

| Polen

| Gatos

deriving (Enum, Eq, Show, Bounded)

-- 1ª solución

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

alergias1 :: Int -> [Alergeno]

alergias1 n =

[a | (a,c) <- zip alergenos codigos, c `elem` descomposicion n]

-- codigos es la lista de los códigos de los alergenos.

codigos :: [Int]

codigos = [2^x| x <- [0..7]]

-- (descomposicion n) es la descomposición de n como sumas de potencias

-- de 2. Por ejemplo,

-- descomposicion 3 == [1,2]

-- descomposicion 5 == [1,4]

-- descomposicion 248 == [8,16,32,64,128]

-- descomposicion 255 == [1,2,4,8,16,32,64,128]

descomposicion :: Int -> [Int]

descomposicion n =

head [xs | xs <- subsequences codigos, sum xs == n]

-- 2ª solución

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

alergias2 :: Int -> [Alergeno]

alergias2 = map toEnum . codigosAlergias

-- (codigosAlergias n) es la lista de códigos de alergias

-- correspondiente a una puntuación n. Por ejemplo,

-- codigosAlergias 1 == [0]

-- codigosAlergias 2 == [1]

-- codigosAlergias 3 == [0,1]

-- codigosAlergias 4 == [2]

-- codigosAlergias 5 == [0,2]

-- codigosAlergias 6 == [1,2]

codigosAlergias :: Int -> [Int]

codigosAlergias = aux [0..7]

where aux [] _ = []

aux (x:xs) n | odd n = x : aux xs (n `div` 2)

| otherwise = aux xs (n `div` 2)

-- 3ª solución

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

alergias3 :: Int -> [Alergeno]

alergias3 = map toEnum . codigosAlergias3

codigosAlergias3 :: Int -> [Int]

codigosAlergias3 n =

[x | (x,y) <- zip [0..7] (int2bin n), y == 1]

-- (int2bin n) es la representación binaria del número n. Por ejemplo,

-- int2bin 10 == [0,1,0,1]

-- ya que 10 = 0*1 + 1*2 + 0*4 + 1*8

int2bin :: Int -> [Int]

int2bin n | n < 2 = [n]

| otherwise = n `rem` 2 : int2bin (n `div` 2)

-- 4ª solución

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

alergias4 :: Int -> [Alergeno]

alergias4 = map toEnum . codigosAlergias4

codigosAlergias4 :: Int -> [Int]

codigosAlergias4 n =

map fst (filter ((== 1) . snd) (zip [0..7] (int2bin n)))

-- 5ª solución

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

alergias5 :: Int -> [Alergeno]

alergias5 = map (toEnum . fst)

. filter ((1 ==) . snd)

. zip [0..7]

. int2bin

-- 6ª solución

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

alergias6 :: Int -> [Alergeno]

alergias6 = aux alergenos

where aux [] _ = []

aux (x:xs) n | odd n = x : aux xs (n `div` 2)

| otherwise = aux xs (n `div` 2)

-- alergenos es la lista de los alergenos. Por ejemplo.

-- take 3 alergenos == [Huevos,Cacahuetes,Mariscos]

alergenos :: [Alergeno]

alergenos = [minBound..maxBound]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_alergias :: Property

prop_alergias =

forAll (arbitrary `suchThat` esValido) $ \n ->

all (== alergias1 n)

[alergias2 n,

alergias3 n,

alergias4 n,

alergias5 n,

alergias6 n]

where esValido x = 1 <= x && x <= 255

-- La comprobación es

-- λ> quickCheck prop_alergias

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (map alergias1 [1..255])

-- [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

-- (0.02 secs, 1,657,912 bytes)

-- λ> last (map alergias2 [1..255])

-- [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

-- (0.01 secs, 597,080 bytes)

-- λ> last (map alergias3 [1..255])

-- [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

-- (0.01 secs, 597,640 bytes)

-- λ> last (map alergias4 [1..255])

-- [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

-- (0.01 secs, 598,152 bytes)

-- λ> last (map alergias5 [1..255])

-- [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

-- (0.01 secs, 596,888 bytes)

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

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

Nuevas soluciones

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

[/schedule]

Números triangulares con n cifras distintas

PorJosé A. Alonso 5-abril-202212-abril-2022

Los números triangulares se forman como sigue

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

* * *

* * * *

* * *

1 3 6

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

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

1 = 1

3 = 1 + 2

6 = 1 + 2 + 3

10 = 1 + 2 + 3 + 4

15 = 1 + 2 + 3 + 4 + 5

Definir la función

   triangularesConCifras :: Int -> [Integer]

1	triangularesConCifras :: Int -> [Integer]

tal que (triangulares n) es la lista de los números triangulares con n cifras distintas. Por ejemplo,

   take 6 (triangularesConCifras 1)   ==  [1,3,6,55,66,666]
   take 6 (triangularesConCifras 2)   ==  [10,15,21,28,36,45]
   take 6 (triangularesConCifras 3)   ==  [105,120,136,153,190,210]
   take 5 (triangularesConCifras 4)   ==  [1035,1275,1326,1378,1485]
   take 2 (triangularesConCifras 10)  ==  [1062489753,1239845706]

take 6 (triangularesConCifras 1) == [1,3,6,55,66,666]

take 6 (triangularesConCifras 2) == [10,15,21,28,36,45]

take 6 (triangularesConCifras 3) == [105,120,136,153,190,210]

take 5 (triangularesConCifras 4) == [1035,1275,1326,1378,1485]

take 2 (triangularesConCifras 10) == [1062489753,1239845706]

Soluciones

import Data.List (nub)
import Test.QuickCheck

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

triangularesConCifras1 :: Int -> [Integer]
triangularesConCifras1 n =
  [x | x <- triangulares1,
       nCifras x == n]

-- triangulares1 es la lista de los números triangulares. Por ejemplo,
--    take 10 triangulares1 == [1,3,6,10,15,21,28,36,45,55]
triangulares1 :: [Integer]
triangulares1 = map triangular [1..]

triangular :: Integer -> Integer
triangular 1 = 1
triangular n = triangular (n-1) + n

-- (nCifras x) es el número de cifras distintas del número x. Por
-- ejemplo,
--    nCifras 325275  ==  4
nCifras :: Integer -> Int
nCifras = length . nub . show

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

triangularesConCifras2 :: Int -> [Integer]
triangularesConCifras2 n =
  [x | x <- triangulares2,
       nCifras x == n]

triangulares2 :: [Integer]
triangulares2 = [(n*(n+1)) `div` 2 | n <- [1..]]

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

triangularesConCifras3 :: Int -> [Integer]
triangularesConCifras3 n =
  [x | x <- triangulares3,
       nCifras x == n]

triangulares3 :: [Integer]
triangulares3 = 1 : [x+y | (x,y) <- zip [2..] triangulares3]

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

triangularesConCifras4 :: Int -> [Integer]
triangularesConCifras4 n =
  [x | x <- triangulares4,
       nCifras x == n]

triangulares4 :: [Integer]
triangulares4 = 1 : zipWith (+) [2..] triangulares4

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

triangularesConCifras5 :: Int -> [Integer]
triangularesConCifras5 n =
  [x | x <- triangulares5,
       nCifras x == n]

triangulares5 :: [Integer]
triangulares5 = scanl (+) 1 [2..]

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

-- La 1ª propiedad es
prop_triangularesConCifras1 :: Bool
prop_triangularesConCifras1 =
  [take 2 (triangularesConCifras1 n) | n <- [1..7]] ==
  [take 2 (triangularesConCifras2 n) | n <- [1..7]]

-- La comprobación es
--    λ> prop_triangularesConCifras1
--    True

-- La 2ª propiedad es
prop_triangularesConCifras2 :: Int -> Bool
prop_triangularesConCifras2 n =
  all (== take 5 (triangularesConCifras2 n'))
      [take 5 (triangularesConCifras3 n'),
       take 5 (triangularesConCifras4 n'),
       take 5 (triangularesConCifras5 n')]
  where n' = 1 + n `mod` 9

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

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

-- La comparación es
--    λ> (triangularesConCifras1 3) !! 220
--    5456556
--    (2.48 secs, 1,228,690,120 bytes)
--    λ> (triangularesConCifras2 3) !! 220
--    5456556
--    (0.01 secs, 4,667,288 bytes)
--
--    λ> (triangularesConCifras2 3) !! 600
--    500010500055
--    (1.76 secs, 1,659,299,872 bytes)
--    λ> (triangularesConCifras3 3) !! 600
--    500010500055
--    (1.67 secs, 1,603,298,648 bytes)
--    λ> (triangularesConCifras4 3) !! 600
--    500010500055
--    (1.20 secs, 1,507,298,248 bytes)
--    λ> (triangularesConCifras5 3) !! 600
--    500010500055
--    (1.15 secs, 1,507,298,256 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

import Data.List (nub)

import Test.QuickCheck

-- 1ª solución

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

triangularesConCifras1 :: Int -> [Integer]

triangularesConCifras1 n =

[x | x <- triangulares1,

nCifras x == n]

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

-- take 10 triangulares1 == [1,3,6,10,15,21,28,36,45,55]

triangulares1 :: [Integer]

triangulares1 = map triangular [1..]

triangular :: Integer -> Integer

triangular 1 = 1

triangular n = triangular (n-1) + n

-- (nCifras x) es el número de cifras distintas del número x. Por

-- ejemplo,

-- nCifras 325275 == 4

nCifras :: Integer -> Int

nCifras = length . nub . show

-- 2ª solución

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

triangularesConCifras2 :: Int -> [Integer]

triangularesConCifras2 n =

[x | x <- triangulares2,

nCifras x == n]

triangulares2 :: [Integer]

triangulares2 = [(n*(n+1)) `div` 2 | n <- [1..]]

-- 3ª solución

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

triangularesConCifras3 :: Int -> [Integer]

triangularesConCifras3 n =

[x | x <- triangulares3,

nCifras x == n]

triangulares3 :: [Integer]

triangulares3 = 1 : [x+y | (x,y) <- zip [2..] triangulares3]

-- 4ª solución

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

triangularesConCifras4 :: Int -> [Integer]

triangularesConCifras4 n =

[x | x <- triangulares4,

nCifras x == n]

triangulares4 :: [Integer]

triangulares4 = 1 : zipWith (+) [2..] triangulares4

-- 5ª solución

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

triangularesConCifras5 :: Int -> [Integer]

triangularesConCifras5 n =

[x | x <- triangulares5,

nCifras x == n]

triangulares5 :: [Integer]

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

-- Comprobación de equivalencia

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

-- La 1ª propiedad es

prop_triangularesConCifras1 :: Bool

prop_triangularesConCifras1 =

[take 2 (triangularesConCifras1 n) | n <- [1..7]] ==

[take 2 (triangularesConCifras2 n) | n <- [1..7]]

-- La comprobación es

-- λ> prop_triangularesConCifras1

-- True

-- La 2ª propiedad es

prop_triangularesConCifras2 :: Int -> Bool

prop_triangularesConCifras2 n =

all (== take 5 (triangularesConCifras2 n'))

[take 5 (triangularesConCifras3 n'),

take 5 (triangularesConCifras4 n'),

take 5 (triangularesConCifras5 n')]

where n' = 1 + n `mod` 9

-- La comprobación es

-- λ> quickCheck prop_triangularesConCifras

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> (triangularesConCifras1 3) !! 220

-- 5456556

-- (2.48 secs, 1,228,690,120 bytes)

-- λ> (triangularesConCifras2 3) !! 220

-- 5456556

-- (0.01 secs, 4,667,288 bytes)

-- λ> (triangularesConCifras2 3) !! 600

-- 500010500055

-- (1.76 secs, 1,659,299,872 bytes)

-- λ> (triangularesConCifras3 3) !! 600

-- 500010500055

-- (1.67 secs, 1,603,298,648 bytes)

-- λ> (triangularesConCifras4 3) !! 600

-- 500010500055

-- (1.20 secs, 1,507,298,248 bytes)

-- λ> (triangularesConCifras5 3) !! 600

-- 500010500055

-- (1.15 secs, 1,507,298,256 bytes)

El código se encuentra en GitHub.

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

Nuevas soluciones

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

Trenzado de listas

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

Definir la función

   trenza :: [a] -> [a] -> [a]

1	trenza :: [a] -> [a] -> [a]

tal que (trenza xs ys) es la lista obtenida intercalando los elementos de xs e ys. Por ejemplo,

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

trenza [5,1] [2,7,4] == [5,2,1,7]

trenza [5,1,7] [2..] == [5,2,1,3,7,4]

trenza [2..] [5,1,7] == [2,5,3,1,4,7]

take 8 (trenza [2,4..] [1,5..]) == [2,1,4,5,6,9,8,13]

Soluciones

import Test.QuickCheck (quickCheck)

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

trenza1 :: [a] -> [a] -> [a]
trenza1 []     _      = []
trenza1 _      []     = []
trenza1 (x:xs) (y:ys) = x : y : trenza1 xs ys

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

trenza2 :: [a] -> [a] -> [a]
trenza2 (x:xs) (y:ys) = x : y : trenza2 xs ys
trenza2 _      _      = []

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

trenza3 :: [a] -> [a] -> [a]
trenza3 xs ys = concat [[x,y] | (x,y) <- zip xs ys]

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

trenza4 :: [a] -> [a] -> [a]
trenza4 xs ys = concat (zipWith par xs ys)

par :: a -> a -> [a]
par x y = [x,y]

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

-- Explicación de eliminación de argumentos en composiciones con varios
-- argumentos:

f :: Int -> Int
f x = x + 1

g :: Int -> Int -> Int
g x y = x + y

h1, h2, h3, h4, h5, h6, h7 :: Int -> Int -> Int
h1 x y  = f (g x y)
h2 x y  = f ((g x) y)
h3 x y  = (f . (g x)) y
h4 x    = f . (g x)
h5 x    = (f .) (g x)
h6 x    = ((f .) . g) x
h7      = (f .) . g

prop_composicion :: Int -> Int -> Bool
prop_composicion x y =
  all (== h1 x y)
      [p x y | p <- [h2, h3, h4, h5, h6, h7]]

-- λ> quickCheck prop_composicion
-- +++ OK, passed 100 tests.

-- En general,
--    f . g             --> \x -> f (g x)
--    (f .) . g         --> \x y -> f (g x y)
--    ((f .) .) . g     --> \x y z -> f (g x y z)
--    (((f .) .) .) . g --> \w x y z -> f (g w x y z)

trenza5 :: [a] -> [a] -> [a]
trenza5 = (concat .) . zipWith par

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

-- La propiedad es
prop_trenza :: [Int] -> [Int] -> Bool
prop_trenza xs ys =
  all (== trenza1 xs ys)
      [trenza2 xs ys,
       trenza3 xs ys,
       trenza4 xs ys,
       trenza5 xs ys]

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

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

-- La comparación es
--    λ> last (trenza1 [1,1..] [1..4*10^6])
--    4000000
--    (2.33 secs, 1,472,494,952 bytes)
--    λ> last (trenza2 [1,1..] [1..4*10^6])
--    4000000
--    (2.24 secs, 1,376,494,928 bytes)
--    λ> last (trenza3 [1,1..] [1..4*10^6])
--    4000000
--    (1.33 secs, 1,888,495,048 bytes)
--    λ> last (trenza4 [1,1..] [1..4*10^6])
--    4000000
--    (0.76 secs, 1,696,494,968 bytes)
--    λ> last (trenza5 [1,1..] [1..4*10^6])
--    4000000
--    (0.76 secs, 1,696,495,064 bytes)

100

101

102

103

104

105

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

trenza1 :: [a] -> [a] -> [a]

trenza1 [] _ = []

trenza1 _ [] = []

trenza1 (x:xs) (y:ys) = x : y : trenza1 xs ys

-- 2ª solución

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

trenza2 :: [a] -> [a] -> [a]

trenza2 (x:xs) (y:ys) = x : y : trenza2 xs ys

trenza2 _ _ = []

-- 3ª solución

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

trenza3 :: [a] -> [a] -> [a]

trenza3 xs ys = concat [[x,y] | (x,y) <- zip xs ys]

-- 4ª solución

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

trenza4 :: [a] -> [a] -> [a]

trenza4 xs ys = concat (zipWith par xs ys)

par :: a -> a -> [a]

par x y = [x,y]

-- 5ª solución

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

-- Explicación de eliminación de argumentos en composiciones con varios

-- argumentos:

f :: Int -> Int

f x = x + 1

g :: Int -> Int -> Int

g x y = x + y

h1, h2, h3, h4, h5, h6, h7 :: Int -> Int -> Int

h1 x y = f (g x y)

h2 x y = f ((g x) y)

h3 x y = (f . (g x)) y

h4 x = f . (g x)

h5 x = (f .) (g x)

h6 x = ((f .) . g) x

h7 = (f .) . g

prop_composicion :: Int -> Int -> Bool

prop_composicion x y =

all (== h1 x y)

[p x y | p <- [h2, h3, h4, h5, h6, h7]]

-- λ> quickCheck prop_composicion

-- +++ OK, passed 100 tests.

-- En general,

-- f . g --> \x -> f (g x)

-- (f .) . g --> \x y -> f (g x y)

-- ((f .) .) . g --> \x y z -> f (g x y z)

-- (((f .) .) .) . g --> \w x y z -> f (g w x y z)

trenza5 :: [a] -> [a] -> [a]

trenza5 = (concat .) . zipWith par

-- Comprobación de equivalencia

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

-- La propiedad es

prop_trenza :: [Int] -> [Int] -> Bool

prop_trenza xs ys =

all (== trenza1 xs ys)

[trenza2 xs ys,

trenza3 xs ys,

trenza4 xs ys,

trenza5 xs ys]

-- La comprobación es

-- λ> quickCheck prop_trenza

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (trenza1 [1,1..] [1..4*10^6])

-- 4000000

-- (2.33 secs, 1,472,494,952 bytes)

-- λ> last (trenza2 [1,1..] [1..4*10^6])

-- 4000000

-- (2.24 secs, 1,376,494,928 bytes)

-- λ> last (trenza3 [1,1..] [1..4*10^6])

-- 4000000

-- (1.33 secs, 1,888,495,048 bytes)

-- λ> last (trenza4 [1,1..] [1..4*10^6])

-- 4000000

-- (0.76 secs, 1,696,494,968 bytes)

-- λ> last (trenza5 [1,1..] [1..4*10^6])

-- 4000000

-- (0.76 secs, 1,696,495,064 bytes)

El código se encuentra en GitHub.

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

Nuevas soluciones

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

Biparticiones de una lista

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

Definir la función

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

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

tal que (biparticiones xs) es la lista de pares formados por un prefijo de xs y el resto de xs. Por ejemplo,

   λ> biparticiones [3,2,5]
   [([],[3,2,5]),([3],[2,5]),([3,2],[5]),([3,2,5],[])]
   λ> biparticiones "Roma"
   [("","Roma"),("R","oma"),("Ro","ma"),("Rom","a"),("Roma","")]

λ> biparticiones [3,2,5]

[([],[3,2,5]),([3],[2,5]),([3,2],[5]),([3,2,5],[])]

λ> biparticiones "Roma"

[("","Roma"),("R","oma"),("Ro","ma"),("Rom","a"),("Roma","")]

Soluciones

import Data.List (inits, tails)
import Control.Applicative (liftA2)
import Test.QuickCheck (quickCheck)

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

biparticiones1 :: [a] -> [([a],[a])]
biparticiones1 [] = [([],[])]
biparticiones1 (x:xs) =
  ([],(x:xs)) : [(x:ys,zs) | (ys,zs) <- biparticiones1 xs]

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

biparticiones2 :: [a] -> [([a],[a])]
biparticiones2 xs =
  [(take i xs, drop i xs) | i <- [0..length xs]]

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

biparticiones3 :: [a] -> [([a],[a])]
biparticiones3 xs =
  [splitAt i xs | i <- [0..length xs]]

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

biparticiones4 :: [a] -> [([a],[a])]
biparticiones4 xs =
  zip (inits xs) (tails xs)

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

biparticiones5 :: [a] -> [([a],[a])]
biparticiones5 = liftA2 zip inits tails

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

biparticiones6 :: [a] -> [([a],[a])]
biparticiones6 = zip <$> inits <*> tails

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

-- La propiedad es
prop_biparticiones :: [Int] -> Bool
prop_biparticiones xs =
  all (== biparticiones1 xs)
      [biparticiones2 xs,
       biparticiones3 xs,
       biparticiones4 xs,
       biparticiones5 xs,
       biparticiones6 xs]

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

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

-- La comparación es
--    λ> length (biparticiones1 [1..6*10^3])
--    6001
--    (2.21 secs, 3,556,073,552 bytes)
--    λ> length (biparticiones2 [1..6*10^3])
--    6001
--    (0.01 secs, 2,508,448 bytes)
--
--    λ> length (biparticiones2 [1..6*10^6])
--    6000001
--    (2.26 secs, 2,016,494,864 bytes)
--    λ> length (biparticiones3 [1..6*10^6])
--    6000001
--    (2.12 secs, 1,584,494,792 bytes)
--    λ> length (biparticiones4 [1..6*10^6])
--    6000001
--    (0.78 secs, 1,968,494,704 bytes)
--    λ> length (biparticiones5 [1..6*10^6])
--    6000001
--    (0.79 secs, 1,968,494,688 bytes)
--    λ> length (biparticiones6 [1..6*10^6])
--    6000001
--    (0.77 secs, 1,968,494,720 bytes)
--
--    λ> length (biparticiones4 [1..10^7])
--    10000001
--    (1.30 secs, 3,280,495,432 bytes)
--    λ> length (biparticiones5 [1..10^7])
--    10000001
--    (1.42 secs, 3,280,495,416 bytes)
--    λ> length (biparticiones6 [1..10^7])
--    10000001
--    (1.30 secs, 3,280,495,448 bytes)

import Data.List (inits, tails)

import Control.Applicative (liftA2)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

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

biparticiones1 [] = [([],[])]

biparticiones1 (x:xs) =

([],(x:xs)) : [(x:ys,zs) | (ys,zs) <- biparticiones1 xs]

-- 2ª solución

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

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

biparticiones2 xs =

[(take i xs, drop i xs) | i <- [0..length xs]]

-- 3ª solución

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

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

biparticiones3 xs =

[splitAt i xs | i <- [0..length xs]]

-- 4ª solución

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

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

biparticiones4 xs =

zip (inits xs) (tails xs)

-- 5ª solución

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

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

biparticiones5 = liftA2 zip inits tails

-- 6ª solución

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

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

biparticiones6 = zip <$> inits <*> tails

-- Comprobación de equivalencia

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

-- La propiedad es

prop_biparticiones :: [Int] -> Bool

prop_biparticiones xs =

all (== biparticiones1 xs)

[biparticiones2 xs,

biparticiones3 xs,

biparticiones4 xs,

biparticiones5 xs,

biparticiones6 xs]

-- La comprobación es

-- λ> quickCheck prop_biparticiones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (biparticiones1 [1..6*10^3])

-- 6001

-- (2.21 secs, 3,556,073,552 bytes)

-- λ> length (biparticiones2 [1..6*10^3])

-- 6001

-- (0.01 secs, 2,508,448 bytes)

-- λ> length (biparticiones2 [1..6*10^6])

-- 6000001

-- (2.26 secs, 2,016,494,864 bytes)

-- λ> length (biparticiones3 [1..6*10^6])

-- 6000001

-- (2.12 secs, 1,584,494,792 bytes)

-- λ> length (biparticiones4 [1..6*10^6])

-- 6000001

-- (0.78 secs, 1,968,494,704 bytes)

-- λ> length (biparticiones5 [1..6*10^6])

-- 6000001

-- (0.79 secs, 1,968,494,688 bytes)

-- λ> length (biparticiones6 [1..6*10^6])

-- 6000001

-- (0.77 secs, 1,968,494,720 bytes)

-- λ> length (biparticiones4 [1..10^7])

-- 10000001

-- (1.30 secs, 3,280,495,432 bytes)

-- λ> length (biparticiones5 [1..10^7])

-- 10000001

-- (1.42 secs, 3,280,495,416 bytes)

-- λ> length (biparticiones6 [1..10^7])

-- 10000001

-- (1.30 secs, 3,280,495,448 bytes)

El código se encuentra en GitHub.

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

Nuevas soluciones

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

Reparto de escaños por la ley d’Hont

PorJosé A. Alonso 27-abril-20205-mayo-2020

El sistema D’Hondt es una fórmula creada por Victor d’Hondt, que permite obtener el número de cargos electos asignados a las candidaturas, en proporción a los votos conseguidos.

Tras el recuento de los votos, se calcula una serie de divisores para cada partido. La fórmula de los divisores es V/N, donde V representa el número total de votos recibidos por el partido, y N representa cada uno de los números enteros desde 1 hasta el número de cargos electos de la circunscripción objeto de escrutinio. Una vez realizadas las divisiones de los votos de cada partido por cada uno de los divisores desde 1 hasta N, la asignación de cargos electos se hace ordenando los cocientes de las divisiones de mayor a menor y asignando a cada uno un escaño hasta que éstos se agoten

Definir la función

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

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

tal que (reparto n vs) es la lista de los pares formados por los números de los partidos y el número de escaño que les corresponden al repartir n escaños en función de la lista de sus votos. Por ejemplo,

   ghci> reparto 7 [340000,280000,160000,60000,15000]
   [(1,3),(2,3),(3,1)]
   ghci> reparto 21 [391000,311000,184000,73000,27000,12000,2000]
   [(1,9),(2,7),(3,4),(4,1)]

ghci> reparto 7 [340000,280000,160000,60000,15000]

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

ghci> reparto 21 [391000,311000,184000,73000,27000,12000,2000]

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

es decir, en el primer ejemplo,

al 1º partido (que obtuvo 340000 votos) le corresponden 3 escaños,
al 2º partido (que obtuvo 280000 votos) le corresponden 3 escaños,
al 3º partido (que obtuvo 160000 votos) le corresponden 1 escaño.

Soluciones

import Data.List (sort, group)

-- Para los ejemplos que siguen, se usará la siguiente ditribución de
-- votos entre 5 partidos.
ejVotos :: [Int]
ejVotos = [340000,280000,160000,60000,15000]

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

reparto :: Int -> [Int] -> [(Int,Int)]
reparto n vs = 
  [(x,1 + length xs) | (x:xs) <- group (sort (repartoAux n vs))] 

-- (repartoAux n vs) es el número de los partidos, cuyos votos son vs, que
-- obtienen los n escaños. Por ejemplo,
--    ghci> repartoAux 7 ejVotos
--    [1,2,1,3,2,1,2]
repartoAux :: Int -> [Int] -> [Int]
repartoAux n vs = map snd (repartoAux' n vs)

-- (repartoAux' n vs) es la lista formada por los n restos mayores
-- correspondientes a la lista de votos vs. Por ejemplo,
--    ghci> repartoAux' 7 ejVotos
--    [(340000,1),(280000,2),(170000,1),(160000,3),(140000,2),(113333,1),
--     (93333,2)]
repartoAux' :: Int -> [Int] -> [(Int,Int)]
repartoAux' n vs = 
  take n (reverse (sort (concatMap (restos n) (votosPartidos vs))))

-- (votosPartidos vs) es la lista con los pares formados por los votos y
-- el número de cada partido. Por ejemplo, 
--    ghci> votosPartidos ejVotos
--    [(340000,1),(280000,2),(160000,3),(60000,4),(15000,5)]
votosPartidos :: [Int] -> [(Int,Int)]
votosPartidos vs = zip vs [1..]

-- (restos n (x,i)) es la lista obtenidas dividiendo n entre 1, 2,..., n.
-- Por ejemplo, 
--    ghci> restos 5 (340000,1)
--    [(340000,1),(170000,1),(113333,1),(85000,1),(68000,1)]
restos :: Int -> (Int,Int) -> [(Int,Int)]
restos n (x,i) = [(x `div` k,i) | k <- [1..n]]

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

reparto2 :: Int -> [Int] -> [(Int,Int)]
reparto2 n xs = 
  ( map (\x -> (head x, length x))  
  . group  
  . sort  
  . map snd  
  . take n  
  . reverse  
  . sort
  ) [(x `div` i, p) | (x,p) <- zip xs [1..], i <- [1..n]]

import Data.List (sort, group)

-- Para los ejemplos que siguen, se usará la siguiente ditribución de

-- votos entre 5 partidos.

ejVotos :: [Int]

ejVotos = [340000,280000,160000,60000,15000]

-- 1ª solución

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

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

reparto n vs =

[(x,1 + length xs) | (x:xs) <- group (sort (repartoAux n vs))]

-- (repartoAux n vs) es el número de los partidos, cuyos votos son vs, que

-- obtienen los n escaños. Por ejemplo,

-- ghci> repartoAux 7 ejVotos

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

repartoAux :: Int -> [Int] -> [Int]

repartoAux n vs = map snd (repartoAux' n vs)

-- (repartoAux' n vs) es la lista formada por los n restos mayores

-- correspondientes a la lista de votos vs. Por ejemplo,

-- ghci> repartoAux' 7 ejVotos

-- [(340000,1),(280000,2),(170000,1),(160000,3),(140000,2),(113333,1),

-- (93333,2)]

repartoAux' :: Int -> [Int] -> [(Int,Int)]

repartoAux' n vs =

take n (reverse (sort (concatMap (restos n) (votosPartidos vs))))

-- (votosPartidos vs) es la lista con los pares formados por los votos y

-- el número de cada partido. Por ejemplo,

-- ghci> votosPartidos ejVotos

-- [(340000,1),(280000,2),(160000,3),(60000,4),(15000,5)]

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

votosPartidos vs = zip vs [1..]

-- (restos n (x,i)) es la lista obtenidas dividiendo n entre 1, 2,..., n.

-- Por ejemplo,

-- ghci> restos 5 (340000,1)

-- [(340000,1),(170000,1),(113333,1),(85000,1),(68000,1)]

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

restos n (x,i) = [(x `div` k,i) | k <- [1..n]]

-- 2ª solución

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

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

reparto2 n xs =

( map (\x -> (head x, length x))

. group

. sort

. map snd

. take n

. reverse

. sort

) [(x `div` i, p) | (x,p) <- zip xs [1..], i <- [1..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>

Orden de divisibilidad

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

El orden de divisibilidad de un número x es el mayor n tal que para todo i menor o igual que n, los i primeros dígitos de n es divisible por i. Por ejemplo, el orden de divisibilidad de 74156 es 3 porque

   7       es divisible por 1
   74      es divisible por 2
   741     es divisible por 3
   7415 no es divisible por 4

7 es divisible por 1

74 es divisible por 2

741 es divisible por 3

7415 no es divisible por 4

Definir la función

   ordenDeDivisibilidad :: Integer -> Int

1	ordenDeDivisibilidad :: Integer -> Int

tal que (ordenDeDivisibilidad x) es el orden de divisibilidad de x. Por ejemplo,

   ordenDeDivisibilidad 74156                      ==  3
   ordenDeDivisibilidad 12                         ==  2
   ordenDeDivisibilidad 7                          ==  1
   ordenDeDivisibilidad 3608528850368400786036725  ==  25

ordenDeDivisibilidad 74156 == 3

ordenDeDivisibilidad 12 == 2

ordenDeDivisibilidad 7 == 1

ordenDeDivisibilidad 3608528850368400786036725 == 25

Soluciones

import Data.List (inits)

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

ordenDeDivisibilidad :: Integer -> Int
ordenDeDivisibilidad n = 
  length (takeWhile (\(x,k) -> x `mod` k == 0) (zip (sucDigitos n) [1..]))

-- (sucDigitos x) es la sucesión de los dígitos de x. Por ejemplo,
--    sucDigitos 325    ==  [3,32,325]
--    sucDigitos 32050  ==  [3,32,320,3205,32050]
sucDigitos :: Integer -> [Integer]
sucDigitos n = 
    [n `div` (10^i) | i <- [k-1,k-2..0]]
    where k = length (show n)

-- 2ª definición de sucDigitos
sucDigitos2 :: Integer -> [Integer]
sucDigitos2 n = [read xs | xs <- aux (show n)]
  where aux []     = []
        aux (d:ds) = [d] : map (d:) (aux ds)

-- 3ª definición de sucDigitos
sucDigitos3 :: Integer -> [Integer]
sucDigitos3 n = 
  [read (take k ds) | k <- [1..length ds]]
  where ds = show n

-- 4ª definición de sucDigitos
sucDigitos4 :: Integer -> [Integer]
sucDigitos4 n = [read xs | xs <- tail (inits (show n))]

-- 5ª definición de sucDigitos
sucDigitos5 :: Integer -> [Integer]
sucDigitos5 n = map read (tail (inits (show n)))

-- 6ª definición de sucDigitos
sucDigitos6 :: Integer -> [Integer]
sucDigitos6 = map read . (tail . inits . show)

-- Eficiencia de las definiciones de sucDigitos
--    ghci> length (sucDigitos (10^5000))
--    5001
--    (0.01 secs, 1550688 bytes)
--    ghci> length (sucDigitos2 (10^5000))
--    5001
--    (1.25 secs, 729411872 bytes)
--    ghci> length (sucDigitos3 (10^5000))
--    5001
--    (0.02 secs, 2265120 bytes)
--    ghci> length (sucDigitos4 (10^5000))
--    5001
--    (1.10 secs, 728366872 bytes)
--    ghci> length (sucDigitos5 (10^5000))
--    5001
--    (1.12 secs, 728393864 bytes)
--    ghci> length (sucDigitos6 (10^5000))
--    5001
--    (1.20 secs, 728403052 bytes)
-- 
--    ghci> length (sucDigitos (10^3000000))
--    3000001
--    (2.73 secs, 820042696 bytes)
--    ghci> length (sucDigitos3 (10^3000000))
--    3000001
--    (3.69 secs, 820043688 bytes)

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

ordenDeDivisibilidad2 :: Integer -> Int
ordenDeDivisibilidad2 x =
  length
  $ takeWhile (==0)
  $ zipWith (mod . read) (tail $ inits $ show x) [1..]

import Data.List (inits)

-- 1ª definición de ordenDeDivisibilidad

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

ordenDeDivisibilidad :: Integer -> Int

ordenDeDivisibilidad n =

length (takeWhile (\(x,k) -> x `mod` k == 0) (zip (sucDigitos n) [1..]))

-- (sucDigitos x) es la sucesión de los dígitos de x. Por ejemplo,

-- sucDigitos 325 == [3,32,325]

-- sucDigitos 32050 == [3,32,320,3205,32050]

sucDigitos :: Integer -> [Integer]

sucDigitos n =

[n `div` (10^i) | i <- [k-1,k-2..0]]

where k = length (show n)

-- 2ª definición de sucDigitos

sucDigitos2 :: Integer -> [Integer]

sucDigitos2 n = [read xs | xs <- aux (show n)]

where aux [] = []

aux (d:ds) = [d] : map (d:) (aux ds)

-- 3ª definición de sucDigitos

sucDigitos3 :: Integer -> [Integer]

sucDigitos3 n =

[read (take k ds) | k <- [1..length ds]]

where ds = show n

-- 4ª definición de sucDigitos

sucDigitos4 :: Integer -> [Integer]

sucDigitos4 n = [read xs | xs <- tail (inits (show n))]

-- 5ª definición de sucDigitos

sucDigitos5 :: Integer -> [Integer]

sucDigitos5 n = map read (tail (inits (show n)))

-- 6ª definición de sucDigitos

sucDigitos6 :: Integer -> [Integer]

sucDigitos6 = map read . (tail . inits . show)

-- Eficiencia de las definiciones de sucDigitos

-- ghci> length (sucDigitos (10^5000))

-- 5001

-- (0.01 secs, 1550688 bytes)

-- ghci> length (sucDigitos2 (10^5000))

-- 5001

-- (1.25 secs, 729411872 bytes)

-- ghci> length (sucDigitos3 (10^5000))

-- 5001

-- (0.02 secs, 2265120 bytes)

-- ghci> length (sucDigitos4 (10^5000))

-- 5001

-- (1.10 secs, 728366872 bytes)

-- ghci> length (sucDigitos5 (10^5000))

-- 5001

-- (1.12 secs, 728393864 bytes)

-- ghci> length (sucDigitos6 (10^5000))

-- 5001

-- (1.20 secs, 728403052 bytes)

-- ghci> length (sucDigitos (10^3000000))

-- 3000001

-- (2.73 secs, 820042696 bytes)

-- ghci> length (sucDigitos3 (10^3000000))

-- 3000001

-- (3.69 secs, 820043688 bytes)

-- 2ª definición de ordenDeDivisibilidad

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

ordenDeDivisibilidad2 :: Integer -> Int

ordenDeDivisibilidad2 x =

length

$ takeWhile (==0)

$ zipWith (mod . read) (tail $ inits $ show x) [1..]

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 fracción continua de Lange

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

En 1999, L.J. Lange publicó el artículo An elegant new continued fraction for π.

En el primer teorema del artículo se demuestra la siguiente expresión de π mediante una fracción continua
$Calculo_de_pi_mediante_la_fraccion_continua_de_Lange$

La primeras aproximaciones son

   a(1) = 3+1                = 4.0
   a(2) = 3+(1/(6+9))        = 3.066666666666667
   a(3) = 3+(1/(6+9/(6+25))) = 3.158974358974359

a(1) = 3+1 = 4.0

a(2) = 3+(1/(6+9)) = 3.066666666666667

a(3) = 3+(1/(6+9/(6+25))) = 3.158974358974359

Definir las funciones

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

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

tales que

(aproximacionPi n) es la n-ésima aproximación de pi con la fracción continua de Lange. Por ejemplo,

     aproximacionPi 1     ==  4.0
     aproximacionPi 2     ==  3.066666666666667
     aproximacionPi 3     ==  3.158974358974359
     aproximacionPi 10    ==  3.141287132741557
     aproximacionPi 100   ==  3.141592398533554
     aproximacionPi 1000  ==  3.1415926533392926

aproximacionPi 1 == 4.0

aproximacionPi 2 == 3.066666666666667

aproximacionPi 3 == 3.158974358974359

aproximacionPi 10 == 3.141287132741557

aproximacionPi 100 == 3.141592398533554

aproximacionPi 1000 == 3.1415926533392926

(grafica xs) dibuja la gráfica de las k-ésimas aproximaciones de pi donde k toma los valores de la lista xs. Por ejemplo, (grafica [1..10]) dibuja
$Calculo_de_pi_mediante_la_fraccion_continua_de_Lange_2$
(grafica [10..100]) dibuja
$Calculo_de_pi_mediante_la_fraccion_continua_de_Lange_3$
y (grafica [100..200]) dibuja
$Calculo_de_pi_mediante_la_fraccion_continua_de_Lange_4$

Soluciones

import Graphics.Gnuplot.Simple
 
-- fraccionPi es la representación de la fracción continua de pi como un
-- par de listas infinitas.
fraccionPi :: [(Integer, Integer)]
fraccionPi = zip (3 : [6,6..]) (map (^2) [1,3..])

-- (aproximacionFC n fc) es la n-ésima aproximación de la fracción
-- continua fc (como un par de listas).  
aproximacionFC :: Int -> [(Integer, Integer)] -> Double
aproximacionFC n =
  foldr (\(a,b) z -> fromIntegral a + fromIntegral b / z) 1 . take n

aproximacionPi :: Int -> Double
aproximacionPi n =
  aproximacionFC n fraccionPi
 
grafica :: [Int] -> IO ()
grafica xs = 
  plotList [Key Nothing]
           [(k,aproximacionPi k) | k <- xs]

import Graphics.Gnuplot.Simple

-- fraccionPi es la representación de la fracción continua de pi como un

-- par de listas infinitas.

fraccionPi :: [(Integer, Integer)]

fraccionPi = zip (3 : [6,6..]) (map (^2) [1,3..])

-- (aproximacionFC n fc) es la n-ésima aproximación de la fracción

-- continua fc (como un par de listas).

aproximacionFC :: Int -> [(Integer, Integer)] -> Double

aproximacionFC n =

foldr (\(a,b) z -> fromIntegral a + fromIntegral b / z) 1 . take n

aproximacionPi :: Int -> Double

aproximacionPi n =

aproximacionFC n fraccionPi

grafica :: [Int] -> IO ()

grafica xs =

plotList [Key Nothing]

[(k,aproximacionPi k) | k <- 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>

La conjetura de Gilbreath

PorJosé A. Alonso 30-marzo-20206-abril-2020

Partiendo de los 5 primeros números primos y calculando el valor absoluto de la diferencia de cada dos números consecutivos hasta quedarse con un único número se obtiene la siguiente tabla:

   2, 3, 5, 7, 11
   1, 2, 2, 4 
   1, 0, 2
   1, 2 
   1

2, 3, 5, 7, 11

1, 2, 2, 4

1, 0, 2

1, 2

Se observa que todas las filas, salvo la inicial, comienzan con el número 1.

Repitiendo el proceso pero empezando con los 8 primeros números primos se obtiene la siguiente tabla:

   2, 3, 5, 7, 11, 13, 17, 19 
   1, 2, 2, 4,  2,  4,  2  
   1, 0, 2, 2,  2,  2 
   1, 2, 0, 0,  0 
   1, 2, 0, 0 
   1, 2, 0 
   1, 2 
   1

2, 3, 5, 7, 11, 13, 17, 19

1, 2, 2, 4, 2, 4, 2

1, 0, 2, 2, 2, 2

1, 2, 0, 0, 0

1, 2, 0, 0

1, 2, 0

1, 2

Se observa que, de nuevo, todas las filas, salvo la inicial, comienza con el número 1.

La conjetura de Gilbreath afirma que si escribimos la sucesión de números primos completa y después construimos las correspondientes sucesiones formadas por el valor absoluto de la resta de cada pareja de números consecutivos, entonces todas esas filas que obtenemos comienzan siempre por 1.

El objetivo de este ejercicio es comprobar experimentalmente dicha conjetura.

Para la representación, usaremos la simétrica de la que hemos comentado anteriormente; es decir,

    2
    3, 1
    5, 2, 1
    7, 2, 0, 1
   11, 4, 2, 2, 1
   13, 2, 2, 0, 2, 1
   17, 4, 2, 0, 0, 2, 1
   19, 2, 2, 0, 0, 0, 2, 1

3, 1

5, 2, 1

7, 2, 0, 1

11, 4, 2, 2, 1

13, 2, 2, 0, 2, 1

17, 4, 2, 0, 0, 2, 1

19, 2, 2, 0, 0, 0, 2, 1

en la que la primera columna son los números primos y el elemento de la fila i y columna j (con i, j > 1) es el valor absoluto de la diferencia de los elementos (i,j-1) e (i-1,j-1).

Definir las siguientes funciones

   siguiente           :: Integer -> [Integer] -> [Integer]
   triangulo           :: [[Integer]]
   conjeturaGilbreath  :: Int -> Bool

siguiente :: Integer -> [Integer] -> [Integer]

triangulo :: [[Integer]]

conjeturaGilbreath :: Int -> Bool

tales que

(siguiente x ys) es la línea siguiente de la ys que empieza por x en la tabla de Gilbreath; es decir, si ys es [y1,y2,…,yn], entonces (siguiente x ys) es [x,|y1-x|,|y2-|y1-x||,…]. Por ejemplo,

     siguiente  7 [5,2,1]               ==  [7,2,0,1]
     siguiente 29 [23,4,2,0,0,0,0,2,1]  ==  [29,6,2,0,0,0,0,0,2,1]

1 2	siguiente 7 [5,2,1] == [7,2,0,1] siguiente 29 [23,4,2,0,0,0,0,2,1] == [29,6,2,0,0,0,0,0,2,1]

triangulo es el triángulo de Gilbreath. Por ejemplo,

     λ> take 10 triangulo
     [[ 2],
      [ 3,1],
      [ 5,2,1],
      [ 7,2,0,1],
      [11,4,2,2,1],
      [13,2,2,0,2,1],
      [17,4,2,0,0,2,1],
      [19,2,2,0,0,0,2,1],
      [23,4,2,0,0,0,0,2,1],
      [29,6,2,0,0,0,0,0,2,1]]

λ> take 10 triangulo

[[ 2],

[ 3,1],

[ 5,2,1],

[ 7,2,0,1],

[11,4,2,2,1],

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

[17,4,2,0,0,2,1],

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

[23,4,2,0,0,0,0,2,1],

[29,6,2,0,0,0,0,0,2,1]]

(conjeturaGilbreath n) se verifica si se cumple la conjetura de Gilbreath para los n primeros números primos; es decir, en el triángulo de Gilbreath cuya primera columna son los n primeros números primos, todas las filas a partir de la segunda terminan en 1. Por ejemplo,

     λ> conjeturaGilbreath 1000
     True

1 2	λ> conjeturaGilbreath 1000 True

Soluciones

import Data.Numbers.Primes

siguiente :: Integer -> [Integer] -> [Integer]
siguiente x ys = scanl (\m n -> abs (m-n)) x ys 

triangulo :: [[Integer]]
triangulo = 
  [2] : [siguiente x ys | (x,ys) <- zip (tail primes) triangulo]

conjeturaGilbreath :: Int -> Bool
conjeturaGilbreath n = all p (tail (take n triangulo))
  where p xs = last xs == 1

import Data.Numbers.Primes

siguiente :: Integer -> [Integer] -> [Integer]

siguiente x ys = scanl (\m n -> abs (m-n)) x ys

triangulo :: [[Integer]]

triangulo =

[2] : [siguiente x ys | (x,ys) <- zip (tail primes) triangulo]

conjeturaGilbreath :: Int -> Bool

conjeturaGilbreath n = all p (tail (take n triangulo))

where p xs = last xs == 1

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 simplicidad es la última sofisticación.»

Leonardo da Vinci.

Primero no consecutivo

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

Definir la función

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

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

tal que (primeroNoConsecutivo xs) es el primer elemento de la lista xs que no es igual al siguiente de su elemento anterior en xs o Nothing si tal elemento no existe. Por ejemplo

   primeroNoConsecutivo [1,2,3,4,6,7,8] == Just 6
   primeroNoConsecutivo "bcdfg"         == Just 'f'
   primeroNoConsecutivo "bcdef"         == Nothing

primeroNoConsecutivo [1,2,3,4,6,7,8] == Just 6

primeroNoConsecutivo "bcdfg" == Just 'f'

primeroNoConsecutivo "bcdef" == Nothing

Soluciones

import Data.Maybe (listToMaybe)

-- 1ª solución
primeroNoConsecutivo1 :: (Eq a, Enum a) => [a] -> Maybe a
primeroNoConsecutivo1 xs
  | null ys   = Nothing
  | otherwise = Just (head ys)
  where ys = [y | (z,y) <- zip xs (tail xs), y /= succ z]

-- 2ª solución
primeroNoConsecutivo2 :: (Eq a, Enum a) => [a] -> Maybe a
primeroNoConsecutivo2 xs = 
  listToMaybe [y | (z,y) <- zip xs (tail xs), y /= succ z]

-- 3ª solución
primeroNoConsecutivo3 :: (Eq a,Enum a) => [a] -> Maybe a
primeroNoConsecutivo3 (x:y:zs)
  | succ x /= y = Just y 
  | otherwise   = primeroNoConsecutivo3 (y:zs)
primeroNoConsecutivo3 _ = Nothing

-- 4ª solución
primeroNoConsecutivo :: (Eq a,Enum a) => [a] -> Maybe a
primeroNoConsecutivo [] = Nothing
primeroNoConsecutivo (x:ys) = aux x ys
  where aux _ [] = Nothing
        aux x' (z:zs) | z == succ x' = aux z zs
                      | otherwise    = Just z

import Data.Maybe (listToMaybe)

-- 1ª solución

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

primeroNoConsecutivo1 xs

| null ys = Nothing

| otherwise = Just (head ys)

where ys = [y | (z,y) <- zip xs (tail xs), y /= succ z]

-- 2ª solución

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

primeroNoConsecutivo2 xs =

listToMaybe [y | (z,y) <- zip xs (tail xs), y /= succ z]

-- 3ª solución

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

primeroNoConsecutivo3 (x:y:zs)

| succ x /= y = Just y

| otherwise = primeroNoConsecutivo3 (y:zs)

primeroNoConsecutivo3 _ = Nothing

-- 4ª solución

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

primeroNoConsecutivo [] = Nothing

primeroNoConsecutivo (x:ys) = aux x ys

where aux _ [] = Nothing

aux x' (z:zs) | z == succ x' = aux z zs

| otherwise = Just z

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 única enseñanza que un profesor puede dar, en mi opinión, es la de pensar delante de sus alumnos.»

Henri Lebesgue.

Grafo de una FNC (fórmula en forma normal conjuntiva)

PorJosé A. Alonso 26-febrero-20204-marzo-2020

Para reducir el problema del clique a SAT se comienza asociando a cada fórmula F en FNC un grafo G de forma que F es saisfacible si, y sólo si, G tiene un clique con tantos nodos como cláusulas tiene F.

Los nodos del grafo de F son los literales de las cláusulas de F junto con el número de la cláusula. Por ejemplo, la lista de nodos de la FNC [[1,-2,3],[-1,2],[-2,3]] es

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

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

(1,-1),(1,2),

(2,-2),(2,3)]

En el grafo de F, hay un arco entre dos nodos si, y solo si, corresponden a cláusulas distintas y sus literales no son complementarios. Por ejemplo,

hay un arco entre (0,1) y (1,2) [porque son de cláusulas distintas (0 y 1) y sus literales (1 y 2) no son complementarios.
no hay un arco entre (0,1) y (1,-1) [porque sus literales (1 y -1) no son complementarios.
no hay un arco entre (0,1) y (0,3) [porque son de la misma cláusula (la 0)].

Nota: En este ejercicio se usará los conceptos de los anteriores importando los módulos Evaluacion_de_FNC y Grafo.

Definir las funciones

   nodosFNC :: FNC -> [(Int,Literal)]
   grafoFNC :: FNC -> Grafo (Int,Literal)

1 2	nodosFNC :: FNC -> [(Int,Literal)] grafoFNC :: FNC -> Grafo (Int,Literal)

tales que

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

     λ> nodosFNC [[1,-2,3],[-1,2],[-2,3]]
     [(0,1),(0,-2),(0,3),(1,-1),(1,2),(2,-2),(2,3)]

1 2	λ> nodosFNC [[1,-2,3],[-1,2],[-2,3]] [(0,1),(0,-2),(0,3),(1,-1),(1,2),(2,-2),(2,3)]

(grafo FNC f) es el grafo de f. Por ejemplo,

     λ> grafoFNC [[1,-2,3],[-1,2],[-2,3]]
     [ ((0,1),(1,2)),  ((0,1),(2,-2)), ((0,1),(2,3)),
       ((0,-2),(1,-1)),((0,-2),(2,-2)),((0,-2),(2,3)),
       ((0,3),(1,-1)), ((0,3),(1,2)),  ((0,3),(2,-2)),((0,3),(2,3)),
       ((1,-1),(2,-2)),((1,-1),(2,3)),
       ((1,2),(2,3))]
     λ> grafoFNC [[1,2],[1,-2],[-1,2],[-1,-2]]
     [((0,1),(1,1)),((0,1),(1,-2)),((0,1),(2,2)),((0,1),(3,-2)),
      ((0,2),(1,1)),((0,2),(2,-1)),((0,2),(2,2)),((0,2),(3,-1)),
      ((1,1),(2,2)),((1,1),(3,-2)),
      ((1,-2),(2,-1)),((1,-2),(3,-1)),((1,-2),(3,-2)),
      ((2,-1),(3,-1)),((2,-1),(3,-2)),
      ((2,2),(3,-1))]

λ> grafoFNC [[1,-2,3],[-1,2],[-2,3]]

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

((0,-2),(1,-1)),((0,-2),(2,-2)),((0,-2),(2,3)),

((0,3),(1,-1)), ((0,3),(1,2)), ((0,3),(2,-2)),((0,3),(2,3)),

((1,-1),(2,-2)),((1,-1),(2,3)),

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

λ> grafoFNC [[1,2],[1,-2],[-1,2],[-1,-2]]

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

((0,2),(1,1)),((0,2),(2,-1)),((0,2),(2,2)),((0,2),(3,-1)),

((1,1),(2,2)),((1,1),(3,-2)),

((1,-2),(2,-1)),((1,-2),(3,-1)),((1,-2),(3,-2)),

((2,-1),(3,-1)),((2,-1),(3,-2)),

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

Soluciones

module Grafo_FNC where

import Evaluacion_de_FNC
import Grafo
import Data.List (tails)

nodosFNC :: FNC -> [(Int,Literal)]
nodosFNC f = 
  [(i,x) | (i,xs) <- zip [0..] f
         , x <- xs]

grafoFNC :: FNC -> Grafo (Int,Literal)
grafoFNC f = 
  [ ((i,x),(i',x'))
  | ((i,x),(i',x')) <- parejas (nodosFNC f)
  , i' /= i
  , x' /= negate x]

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

module Grafo_FNC where

import Evaluacion_de_FNC

import Grafo

import Data.List (tails)

nodosFNC :: FNC -> [(Int,Literal)]

nodosFNC f =

[(i,x) | (i,xs) <- zip [0..] f

, x <- xs]

grafoFNC :: FNC -> Grafo (Int,Literal)

grafoFNC f =

[ ((i,x),(i',x'))

| ((i,x),(i',x')) <- parejas (nodosFNC f)

, i' /= i

, x' /= negate x]

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

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 dos caras: son la ciencia rigurosa de Euclides, pero también son algo más. La matemática presentada a la manera euclidiana aparece como una ciencia sistemática y deductiva; pero la matemática en ciernes aparece como una ciencia experimental e inductiva. Ambos aspectos son tan antiguos como la propia ciencia de las matemáticas.»

George Pólya.

La conjetura de Mertens

PorJosé A. Alonso 27-enero-20203-febrero-2020

Un número entero n es libre de cuadrados si no existe un número primo p tal que p² divide a n; es decir, los factores primos de n son todos distintos.

La función de Möbius μ(n) está definida para todos los enteros positivos como sigue:

μ(n) = 1 si n es libre de cuadrados y tiene un número par de factores primos.
μ(n) = -1 si n es libre de cuadrados y tiene un número impar de factores primos.
μ(n) = 0 si n no es libre de cuadrados.

Sus primeros valores son 1, -1, -1, 0, -1, 1, -1, 0, 0, 1, …

La función de Mertens M(n) está definida para todos los enteros positivos como la suma de μ(k) para 1 ≤ k ≤ n. Sus primeros valores son 1, 0, -1, -1, -2, -1, -2, -2, …

La conjetura de Mertens afirma que

Para todo entero x mayor que 1, el valor absoluto de la función de Mertens en x es menor que la raíz cuadrada de x.

La conjetura fue planteada por Franz Mertens en 1897. Riele Odlyzko, demostraronen 1985 que la conjetura de Mertens deja de ser cierta más o menos a partir de $10^{10^{64}}$ , cifra que luego de algunos refinamientos se redujo a $10^{10^{40}}$ .

Definir las funciones

   mobius :: Integer -> Integer
   mertens :: Integer -> Integer
   graficaMertens :: Integer -> IO ()

mobius :: Integer -> Integer

mertens :: Integer -> Integer

graficaMertens :: Integer -> IO ()

tales que

(mobius n) es el valor de la función de Möbius en n. Por ejemplo,

     mobius 6   ==  1
     mobius 30  ==  -1
     mobius 12  ==  0

mobius 6 == 1

mobius 30 == -1

mobius 12 == 0

(mertens n) es el valor de la función de Mertens en n. Por ejemplo,

     mertens 1     ==  1
     mertens 2     ==  0
     mertens 3     ==  -1
     mertens 5     ==  -2
     mertens 661   ==  -11
     mertens 1403  ==  11

mertens 1 == 1

mertens 2 == 0

mertens 3 == -1

mertens 5 == -2

mertens 661 == -11

mertens 1403 == 11

(graficaMertens n) dibuja la gráfica de la función de Mertens, la raíz cuadrada y el opuestos de la raíz cuadrada para los n primeros n enteros positivos. Por ejemplo, (graficaMertens 1000) dibuja

Comprobar con QuickCheck la conjetura de Mertens.

Nota: El ejercicio está basado en La conjetura de Merterns y su relación con un número tan raro como extremada y colosalmente grande publicado por @Alvy la semana pasada en Microsiervos.

Soluciones

import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck
import Graphics.Gnuplot.Simple

mobius :: Integer -> Integer
mobius n | tieneRepetidos xs = 0
         | otherwise         = (-1)^(length xs)
  where xs = primeFactors n

tieneRepetidos :: [Integer] -> Bool
tieneRepetidos xs =
  or [x == y | (x,y) <- zip xs (tail xs)]
        
mertens :: Integer -> Integer
mertens n = sum (map mobius [1..n])

-- Definición de graficaMertens
-- ============================

graficaMertens :: Integer -> IO ()
graficaMertens n = do
  plotLists [ Key Nothing
            , Title "Conjetura de Mertens"
            , PNG "La_conjetura_de_Mertens.png"
            ]
            [ [mertens k | k <- [1..n]]
            , raices
            , map negate raices
            ]
    
  where
    raices = [ceiling (sqrt k) | k <- [1..fromIntegral n]]

-- Conjetura de Mertens
-- ====================

-- La conjetura es
conjeturaDeMertens :: Integer -> Property
conjeturaDeMertens n =
  n > 1
  ==>
  abs (mertens n) < ceiling (sqrt n')
  where n' = fromIntegral n

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

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

import Graphics.Gnuplot.Simple

mobius :: Integer -> Integer

mobius n | tieneRepetidos xs = 0

| otherwise = (-1)^(length xs)

where xs = primeFactors n

tieneRepetidos :: [Integer] -> Bool

tieneRepetidos xs =

or [x == y | (x,y) <- zip xs (tail xs)]

mertens :: Integer -> Integer

mertens n = sum (map mobius [1..n])

-- Definición de graficaMertens

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

graficaMertens :: Integer -> IO ()

graficaMertens n = do

plotLists [ Key Nothing

, Title "Conjetura de Mertens"

, PNG "La_conjetura_de_Mertens.png"

]

[ [mertens k | k <- [1..n]]

, raices

, map negate raices

]

where

raices = [ceiling (sqrt k) | k <- [1..fromIntegral n]]

-- Conjetura de Mertens

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

-- La conjetura es

conjeturaDeMertens :: Integer -> Property

conjeturaDeMertens n =

n > 1

==>

abs (mertens n) < ceiling (sqrt n')

where n' = fromIntegral n

-- La comprobación es

-- λ> quickCheck conjeturaDeMertens

-- +++ 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

«El control de la complejidad es la esencia de la programación informática.»

Brian Kernighan.

Infinitud de primos gemelos

PorJosé A. Alonso 24-diciembre-201931-diciembre-2019

Un par de números primos (p,q) es un par de números primos gemelos si su distancia de 2; es decir, si q = p+2. Por ejemplo, (17,19) es una par de números primos gemelos.

La conjetura de los primos gemelos postula la existencia de infinitos pares de primos gemelos.

Definir la constante

   primosGemelos :: [(Integer,Integer)]

1	primosGemelos :: [(Integer,Integer)]

tal que sus elementos son los pares de primos gemelos. Por ejemplo,

   λ> take 7 primosGemelos
   [(3,5),(5,7),(11,13),(17,19),(29,31),(41,43),(59,61)]
   λ> primosGemelos !! (4*10^4)
   (6381911,6381913)

λ> take 7 primosGemelos

[(3,5),(5,7),(11,13),(17,19),(29,31),(41,43),(59,61)]

λ> primosGemelos !! (4*10^4)

(6381911,6381913)

Comprobar con QuickCheck la conjetura de los primos gemelos.

Soluciones

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

-- 1ª solución
primosGemelos :: [(Integer,Integer)]
primosGemelos = [(x,x+2) | x <- primes, isPrime (x+2)]

-- 2ª solución
primosGemelos2 :: [(Integer,Integer)]
primosGemelos2 = [(x,y) | (x,y) <- zip primes (tail primes)
                        , y - x == 2]

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

--    λ> primosGemelos !! (2*10^4)
--    (2840447,2840449)
--    (3.93 secs, 12,230,474,952 bytes)
--    λ> primosGemelos2 !! (2*10^4)
--    (2840447,2840449)
--    (0.77 secs, 2,202,822,456 bytes)

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

-- La propiedad es
prop_primosGemelos :: Integer -> Property
prop_primosGemelos n =
  n >= 0 ==> not (null [(x,y) | (x,y) <- primosGemelos2, x > n])

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

import Data.Numbers.Primes (primes, isPrime)

import Test.QuickCheck

-- 1ª solución

primosGemelos :: [(Integer,Integer)]

primosGemelos = [(x,x+2) | x <- primes, isPrime (x+2)]

-- 2ª solución

primosGemelos2 :: [(Integer,Integer)]

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

, y - x == 2]

-- Comparación de eficiencia

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

-- λ> primosGemelos !! (2*10^4)

-- (2840447,2840449)

-- (3.93 secs, 12,230,474,952 bytes)

-- λ> primosGemelos2 !! (2*10^4)

-- (2840447,2840449)

-- (0.77 secs, 2,202,822,456 bytes)

-- Propiedad

-- =========

-- La propiedad es

prop_primosGemelos :: Integer -> Property

prop_primosGemelos n =

n >= 0 ==> not (null [(x,y) | (x,y) <- primosGemelos2, x > n])

-- La comprobación es

-- λ> quickCheck prop_primosGemelos

-- +++ OK, passed 100 tests.

Pensamiento

El sentimiento ha de tener tanto de individual como de genérico; debe orientarse hacia valores universales, o que pretenden serlo.

Antonio Machado

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

Reparto de escaños por la ley d’Hont

PorJosé A. Alonso 23-abril-201925-abril-2021

El sistema D’Hondt es una fórmula creada por Victor d’Hondt, que permite obtener el número de cargos electos asignados a las candidaturas, en proporción a los votos conseguidos.

Definir la función

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

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

   ghci> reparto 7 [340000,280000,160000,60000,15000]
   [(1,3),(2,3),(3,1)]
   ghci> reparto 21 [391000,311000,184000,73000,27000,12000,2000]
   [(1,9),(2,7),(3,4),(4,1)]

ghci> reparto 7 [340000,280000,160000,60000,15000]

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

ghci> reparto 21 [391000,311000,184000,73000,27000,12000,2000]

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

es decir, en el primer ejemplo,

al 1º partido (que obtuvo 340000 votos) le corresponden 3 escaños,
al 2º partido (que obtuvo 280000 votos) le corresponden 3 escaños,
al 3º partido (que obtuvo 160000 votos) le corresponden 1 escaño.

Soluciones

import Data.List (sort, group)

-- Para los ejemplos que siguen, se usará la siguiente ditribución de
-- votos entre 5 partidos.
ejVotos :: [Int]
ejVotos = [340000,280000,160000,60000,15000]

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

reparto :: Int -> [Int] -> [(Int,Int)]
reparto n vs = 
  [(x,1 + length xs) | (x:xs) <- group (sort (repartoAux n vs))] 

-- (repartoAux n vs) es el número de los partidos, cuyos votos son vs, que
-- obtienen los n escaños. Por ejemplo,
--    ghci> repartoAux 7 ejVotos
--    [1,2,1,3,2,1,2]
repartoAux :: Int -> [Int] -> [Int]
repartoAux n vs = map snd (repartoAux' n vs)

-- (repartoAux' n vs) es la lista formada por los n restos mayores
-- correspondientes a la lista de votos vs. Por ejemplo,
--    ghci> repartoAux' 7 ejVotos
--    [(340000,1),(280000,2),(170000,1),(160000,3),(140000,2),(113333,1),
--     (93333,2)]
repartoAux' :: Int -> [Int] -> [(Int,Int)]
repartoAux' n vs = 
  take n (reverse (sort (concatMap (restos n) (votosPartidos vs))))

-- (votosPartidos vs) es la lista con los pares formados por los votos y
-- el número de cada partido. Por ejemplo, 
--    ghci> votosPartidos ejVotos
--    [(340000,1),(280000,2),(160000,3),(60000,4),(15000,5)]
votosPartidos :: [Int] -> [(Int,Int)]
votosPartidos vs = zip vs [1..]

-- (restos n (x,i)) es la lista obtenidas dividiendo n entre 1, 2,..., n.
-- Por ejemplo, 
--    ghci> restos 5 (340000,1)
--    [(340000,1),(170000,1),(113333,1),(85000,1),(68000,1)]
restos :: Int -> (Int,Int) -> [(Int,Int)]
restos n (x,i) = [(x `div` k,i) | k <- [1..n]]

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

reparto2 :: Int -> [Int] -> [(Int,Int)]
reparto2 n xs = 
  ( map (\x -> (head x, length x))  
  . group  
  . sort  
  . map snd  
  . take n  
  . reverse  
  . sort
  ) [(x `div` i, p) | (x,p) <- zip xs [1..], i <- [1..n]]

import Data.List (sort, group)

-- Para los ejemplos que siguen, se usará la siguiente ditribución de

-- votos entre 5 partidos.

ejVotos :: [Int]

ejVotos = [340000,280000,160000,60000,15000]

-- 1ª solución

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

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

reparto n vs =

[(x,1 + length xs) | (x:xs) <- group (sort (repartoAux n vs))]

-- (repartoAux n vs) es el número de los partidos, cuyos votos son vs, que

-- obtienen los n escaños. Por ejemplo,

-- ghci> repartoAux 7 ejVotos

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

repartoAux :: Int -> [Int] -> [Int]

repartoAux n vs = map snd (repartoAux' n vs)

-- (repartoAux' n vs) es la lista formada por los n restos mayores

-- correspondientes a la lista de votos vs. Por ejemplo,

-- ghci> repartoAux' 7 ejVotos

-- [(340000,1),(280000,2),(170000,1),(160000,3),(140000,2),(113333,1),

-- (93333,2)]

repartoAux' :: Int -> [Int] -> [(Int,Int)]

repartoAux' n vs =

take n (reverse (sort (concatMap (restos n) (votosPartidos vs))))

-- (votosPartidos vs) es la lista con los pares formados por los votos y

-- el número de cada partido. Por ejemplo,

-- ghci> votosPartidos ejVotos

-- [(340000,1),(280000,2),(160000,3),(60000,4),(15000,5)]

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

votosPartidos vs = zip vs [1..]

-- (restos n (x,i)) es la lista obtenidas dividiendo n entre 1, 2,..., n.

-- Por ejemplo,

-- ghci> restos 5 (340000,1)

-- [(340000,1),(170000,1),(113333,1),(85000,1),(68000,1)]

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

restos n (x,i) = [(x `div` k,i) | k <- [1..n]]

-- 2ª solución

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

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

reparto2 n xs =

( map (\x -> (head x, length x))

. group

. sort

. map snd

. take n

. reverse

. sort

) [(x `div` i, p) | (x,p) <- zip xs [1..], i <- [1..n]]

Pensamiento

Sus cantares llevan
agua de remanso,
que parece quieta.
Y que no lo está;
mas no tiene prisa
por ir a la mar.

Antonio Machado

Distribución de diferencias de dígitos consecutivos de pi

PorJosé A. Alonso 4-abril-201911-abril-2019

Usando la librería Data.Number.CReal, que se instala con

   cabal install number

1	cabal install number

se pueden calcular el número pi con la precisión que se desee. Por ejemplo,

   λ> import Data.Number.CReal
   λ> showCReal 60 pi
   "3.141592653589793238462643383279502884197169399375105820974945"

λ> import Data.Number.CReal

λ> showCReal 60 pi

"3.141592653589793238462643383279502884197169399375105820974945"

importa la librería y calcula el número pi con 60 decimales.

La distribución de las diferencias de los dígitos consecutivos para los 18 primeros n dígitos de pi se calcula como sigue: los primeros 18 dígitos de pi son

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

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

Las diferencias de sus elementos consecutivos es

   2, -3, 3, -4, -4, 7, -4, 1, 2, -2, -3, -1, 2, -2, 6, 1, -1

1	2, -3, 3, -4, -4, 7, -4, 1, 2, -2, -3, -1, 2, -2, 6, 1, -1

y la distribución de sus frecuencias en el intervalo [-9,9] es

   0, 0, 0, 0, 0, 3, 2, 2, 2, 0, 2, 3, 1, 0, 0, 1, 1, 0, 0

1	0, 0, 0, 0, 0, 3, 2, 2, 2, 0, 2, 3, 1, 0, 0, 1, 1, 0, 0

es decir, el desde el -9 a -5 no aparecen, el -4 aparece 3 veces, el -2 aparece 2 veces y así sucesivamente.

Definir las funciones

   distribucionDDCpi :: Int -> [Int]
   graficas :: [Int] -> FilePath -> IO ()

1 2	distribucionDDCpi :: Int -> [Int] graficas :: [Int] -> FilePath -> IO ()

tales que

(distribucionDDCpi n) es la distribución de las diferencias de los dígitos consecutivos para los primeros n dígitos de pi. Por ejemplo,

     λ> distribucionDDCpi 18
     [0,0,0,0,0,3,2,2,2,0,2,3,1,0,0,1,1,0,0]
     λ> distribucionDDCpi 100
     [1,2,1,7,7,7,6,5,8,6,7,14,4,9,3,6,4,1,0]
     λ> distribucionDDCpi 200
     [3,6,2,13,14,12,11,12,15,17,15,19,11,17,8,13,9,2,0]
     λ> distribucionDDCpi 1000
     [16,25,23,44,57,61,55,75,92,98,80,88,64,65,42,54,39,14,8]
     λ> distribucionDDCpi 5000
     [67,99,130,196,245,314,361,391,453,468,447,407,377,304,242,221,134,97,47]

λ> distribucionDDCpi 18

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

λ> distribucionDDCpi 100

[1,2,1,7,7,7,6,5,8,6,7,14,4,9,3,6,4,1,0]

λ> distribucionDDCpi 200

[3,6,2,13,14,12,11,12,15,17,15,19,11,17,8,13,9,2,0]

λ> distribucionDDCpi 1000

[16,25,23,44,57,61,55,75,92,98,80,88,64,65,42,54,39,14,8]

λ> distribucionDDCpi 5000

[67,99,130,196,245,314,361,391,453,468,447,407,377,304,242,221,134,97,47]

(graficas ns f) dibuja en el fichero f las gráficas de las distribuciones de las diferencias de los dígitos consecutivos para los primeros n dígitos de pi, para n en ns. Por ejemplo, al evaluar (graficas [100,250..4000] «distribucionDDCpi.png» se escribe en el fichero «distribucionDDCpi.png» la siguiente gráfica

Soluciones

import Data.Number.CReal
import Graphics.Gnuplot.Simple
import Data.Array

--    λ> digitosPi 18
--    [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3,2,3]
digitosPi :: Int -> [Int]
digitosPi n = init [read [c] | c <- (x:xs)]
  where (x:_:xs) = showCReal n pi

--    λ> diferenciasConsecutivos (digitosPi 18)
--    [2,-3,3,-4,-4,7,-4,1,2,-2,-3,-1,2,-2,6,1,-1]
diferenciasConsecutivos :: Num a => [a] -> [a]
diferenciasConsecutivos xs =
  zipWith (-) xs (tail xs)

distribucionDDCpi :: Int -> [Int]
distribucionDDCpi =
  distribucion . diferenciasConsecutivos . digitosPi
  where distribucion xs =
          elems (accumArray (+) 0 (-9,9) (zip xs (repeat 1)))

graficas :: [Int] -> FilePath -> IO ()
graficas ns f = 
  plotLists [Key Nothing, PNG f]
            [puntos n | n <- ns]
  where puntos :: Int -> [(Int,Int)]
        puntos n = zip [-9..9] (distribucionDDCpi n)

import Data.Number.CReal

import Graphics.Gnuplot.Simple

import Data.Array

-- λ> digitosPi 18

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

digitosPi :: Int -> [Int]

digitosPi n = init [read [c] | c <- (x:xs)]

where (x:_:xs) = showCReal n pi

-- λ> diferenciasConsecutivos (digitosPi 18)

-- [2,-3,3,-4,-4,7,-4,1,2,-2,-3,-1,2,-2,6,1,-1]

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

diferenciasConsecutivos xs =

zipWith (-) xs (tail xs)

distribucionDDCpi :: Int -> [Int]

distribucionDDCpi =

distribucion . diferenciasConsecutivos . digitosPi

where distribucion xs =

elems (accumArray (+) 0 (-9,9) (zip xs (repeat 1)))

graficas :: [Int] -> FilePath -> IO ()

graficas ns f =

plotLists [Key Nothing, PNG f]

[puntos n | n <- ns]

where puntos :: Int -> [(Int,Int)]

puntos n = zip [-9..9] (distribucionDDCpi n)

Pensamiento

Doy consejo, a fuer de viejo:
nunca sigas mi consejo.

Antonio Machado

Triángulo de Pascal binario

PorJosé A. Alonso 31-enero-20197-febrero-2019

Los triángulos binarios de Pascal se formas a partir de una lista de ceros y unos usando las reglas del triángulo de Pascal, donde cada uno de los números es suma módulo dos de los dos situados en diagonal por encima suyo. Por ejemplo, los triángulos binarios de Pascal correspondientes a [1,0,1,1,1] y [1,0,1,1,0] son

   1 0 1 1 1   1 0 1 1 0     
    1 1 0 0     1 1 0 1  
     0 1 0       0 1 1   
      1 1         1 0    
       0           1

1 0 1 1 1 1 0 1 1 0

1 1 0 0 1 1 0 1

0 1 0 0 1 1

1 1 1 0

0 1

Sus finales, desde el extremo inferior al extremos superior derecho, son [0,1,0,0,1] y [1,0,1,1,0], respectivamente.

Una lista es Pascal capicúa si es igual a los finales de su triángulo binario de Pascal. Por ejemplo, [1,0,1,1,0] es Pascal capicúa.

Definir las funciones

   trianguloPascalBinario :: [Int] -> [[Int]]
   pascalCapicuas         :: Int -> [[Int]]
   nPascalCapicuas        :: Int -> Integer

trianguloPascalBinario :: [Int] -> [[Int]]

pascalCapicuas :: Int -> [[Int]]

nPascalCapicuas :: Int -> Integer

tales que

(trianguloPascalBinario xs) es el triágulo binario de Pascal correspondiente a la lista xs. Por ejemplo,

     λ> trianguloPascalBinario [1,0,1,1,1]
     [[1,0,1,1,1],[1,1,0,0],[0,1,0],[1,1],[0]]
     λ> trianguloPascalBinario [1,0,1,1,0]
     [[1,0,1,1,0],[1,1,0,1],[0,1,1],[1,0],[1]]

λ> trianguloPascalBinario [1,0,1,1,1]

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

λ> trianguloPascalBinario [1,0,1,1,0]

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

(pascalCapicuas n) es la lista de listas de Pascal capicúas de n elementos. Por ejemplo,

     λ> pascalCapicuas 2
     [[0,0],[1,0]]
     λ> pascalCapicuas 3
     [[0,0,0],[0,1,0],[1,0,0],[1,1,0]]
     λ> pascalCapicuas 4
     [[0,0,0,0],[0,1,1,0],[1,0,0,0],[1,1,1,0]]

λ> pascalCapicuas 2

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

λ> pascalCapicuas 3

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

λ> pascalCapicuas 4

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

(nPascalCapicuas n) es el número de listas de Pascal capicúas de n elementos. Por ejemplo,

     λ> nPascalCapicuas 2
     2
     λ> nPascalCapicuas 3
     4
     λ> nPascalCapicuas 4
     4
     λ> nPascalCapicuas 400
     1606938044258990275541962092341162602522202993782792835301376
     λ> length (show (nPascalCapicuas (10^5)))
     15052
     λ> length (show (nPascalCapicuas (10^6)))
     150515
     λ> length (show (nPascalCapicuas (10^7)))
     1505150

λ> nPascalCapicuas 2

λ> nPascalCapicuas 3

λ> nPascalCapicuas 4

λ> nPascalCapicuas 400

1606938044258990275541962092341162602522202993782792835301376

λ> length (show (nPascalCapicuas (10^5)))

15052

λ> length (show (nPascalCapicuas (10^6)))

150515

λ> length (show (nPascalCapicuas (10^7)))

1505150

Soluciones

import Data.List (genericLength, unfoldr)

-- Definición de trianguloPascalBinario
-- ====================================

trianguloPascalBinario :: [Int] -> [[Int]]
trianguloPascalBinario xs =
  takeWhile (not . null) (iterate siguiente xs)

-- (siguiente xs) es la línea siguiente a la xs en el triángulo binario
-- de Pascal. Por ejemplo,
--    λ> siguiente [1,0,1,1,1]
--    [1,1,0,0]
--    λ> siguiente it
--    [0,1,0]
--    λ> siguiente it
--    [1,1]
--    λ> siguiente it
--    [0]
--    λ> siguiente it
--    []
--    λ> siguiente it
--    []
siguiente :: [Int] -> [Int]
siguiente xs = [(x + y) `mod` 2 | (x,y) <- zip xs (tail xs)]

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

trianguloPascalBinario2 :: [Int] -> [[Int]]
trianguloPascalBinario2 = unfoldr f 
  where f [] = Nothing
        f xs = Just (xs, siguiente xs)
 
-- Definición de pascalCapicuas
-- ============================

pascalCapicuas :: Int -> [[Int]]
pascalCapicuas n =
  [xs | xs <- inicios n
      , esPascalCapicua xs]

-- (inicios n) es la lista de longitud n formadas por ceros y unos. Por
-- ejemplo, 
--    λ> inicios 0
--    [[]]
--    λ> inicios 1
--    [[0],[1]]
--    λ> inicios 2
--    [[0,0],[0,1],[1,0],[1,1]]
--    λ> inicios 3
--    [[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]
inicios :: Int -> [[Int]]
inicios 0 = [[]]
inicios n = map (0:) xss ++ map (1:) xss
  where xss = inicios (n-1)

-- Otra forma de definir inicios es
inicios2 :: Int -> [[Int]]
inicios2 n = sucInicios !! n
  where sucInicios    = iterate siguiente [[]]
        siguiente xss = map (0:) xss ++ map (1:) xss

-- (esPascalCapicua xs) se verifica si xs es una lista de Pascal
-- capicúa. Por ejemplo, 
--    esPascalCapicua [1,0,1,1,0]  ==  True
--    esPascalCapicua [1,0,1,1,1]  ==  False
esPascalCapicua :: [Int] -> Bool
esPascalCapicua xs =
  xs == finalesTrianguloPascalBinario xs

-- (finalesTrianguloPascalBinario xs) es la inversa de la lista de los
-- finales del triángulo binarios de xs. Por ejemplo,
--    λ> finalesTrianguloPascalBinario [1,0,1,1,1]
--    [0,1,0,0,1]
finalesTrianguloPascalBinario :: [Int] -> [Int]
finalesTrianguloPascalBinario =
  reverse . map last . trianguloPascalBinario

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

nPascalCapicuas :: Int -> Integer
nPascalCapicuas =
  genericLength . pascalCapicuas

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

nPascalCapicuas2 :: Int -> Integer
nPascalCapicuas2 n =
  2 ^ ((n + 1) `div` 2)

import Data.List (genericLength, unfoldr)

-- Definición de trianguloPascalBinario

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

trianguloPascalBinario :: [Int] -> [[Int]]

trianguloPascalBinario xs =

takeWhile (not . null) (iterate siguiente xs)

-- (siguiente xs) es la línea siguiente a la xs en el triángulo binario

-- de Pascal. Por ejemplo,

-- λ> siguiente [1,0,1,1,1]

-- [1,1,0,0]

-- λ> siguiente it

-- [0,1,0]

-- λ> siguiente it

-- [1,1]

-- λ> siguiente it

-- [0]

-- λ> siguiente it

-- []

-- λ> siguiente it

-- []

siguiente :: [Int] -> [Int]

siguiente xs = [(x + y) `mod` 2 | (x,y) <- zip xs (tail xs)]

-- 2ª definición de trianguloPascalBinario

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

trianguloPascalBinario2 :: [Int] -> [[Int]]

trianguloPascalBinario2 = unfoldr f

where f [] = Nothing

f xs = Just (xs, siguiente xs)

-- Definición de pascalCapicuas

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

pascalCapicuas :: Int -> [[Int]]

pascalCapicuas n =

[xs | xs <- inicios n

, esPascalCapicua xs]

-- (inicios n) es la lista de longitud n formadas por ceros y unos. Por

-- ejemplo,

-- λ> inicios 0

-- [[]]

-- λ> inicios 1

-- [[0],[1]]

-- λ> inicios 2

-- [[0,0],[0,1],[1,0],[1,1]]

-- λ> inicios 3

-- [[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]

inicios :: Int -> [[Int]]

inicios 0 = [[]]

inicios n = map (0:) xss ++ map (1:) xss

where xss = inicios (n-1)

-- Otra forma de definir inicios es

inicios2 :: Int -> [[Int]]

inicios2 n = sucInicios !! n

where sucInicios = iterate siguiente [[]]

siguiente xss = map (0:) xss ++ map (1:) xss

-- (esPascalCapicua xs) se verifica si xs es una lista de Pascal

-- capicúa. Por ejemplo,

-- esPascalCapicua [1,0,1,1,0] == True

-- esPascalCapicua [1,0,1,1,1] == False

esPascalCapicua :: [Int] -> Bool

esPascalCapicua xs =

xs == finalesTrianguloPascalBinario xs

-- (finalesTrianguloPascalBinario xs) es la inversa de la lista de los

-- finales del triángulo binarios de xs. Por ejemplo,

-- λ> finalesTrianguloPascalBinario [1,0,1,1,1]

-- [0,1,0,0,1]

finalesTrianguloPascalBinario :: [Int] -> [Int]

finalesTrianguloPascalBinario =

reverse . map last . trianguloPascalBinario

-- 1ª definición de nPascalCapicuas

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

nPascalCapicuas :: Int -> Integer

nPascalCapicuas =

genericLength . pascalCapicuas

-- 2ª definición de nPascalCapicuas

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

nPascalCapicuas2 :: Int -> Integer

nPascalCapicuas2 n =

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

Pensamiento

La envidia de la virtud
hizo a Caín criminal.
¡Gloria a Caín! Hoy el vicio
es lo que se envidia más.

Antonio Machado

Recorrido de árboles en espiral

PorJosé A. Alonso 25-enero-20191-febrero-2019

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

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

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

Por ejemplo, los árboles

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

1 1 1

/ \ / \ / \

/ \ 8 3 8 3

2 3 /|\ /|\ |

/ \ / \ 4 5 6 4 5 6 7

4 5 6 7

se representan por

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

ej1, ej2, ej3 :: Arbol Int

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

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

Definir la función

   espiral :: Arbol a -> [a]

1	espiral :: Arbol a -> [a]

tal que (espiral x) es la lista de los nodos del árbol x recorridos en espiral; es decir, la raíz de x, los nodos del primer nivel de izquierda a derecha, los nodos del segundo nivel de derecha a izquierda y así sucesivamente. Por ejemplo,

   espiral ej1  ==  [1,2,3,7,6,5,4]
   espiral ej2  ==  [1,8,3,6,5,4]
   espiral ej3  ==  [1,8,3,7,6,5,4]

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

espiral ej2 == [1,8,3,6,5,4]

espiral ej3 == [1,8,3,7,6,5,4]

Soluciones

data Arbol a = N a [Arbol a]
  deriving Show
           
ej1, ej2, ej3 :: Arbol Int
ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 [N 6 [], N 7 []]]
ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]
ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

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

espiral :: Arbol a -> [a]
espiral x =
  concat [f xs | (f,xs) <- zip (cycle [reverse,id]) (niveles x)]

-- (niveles x) es la lista de los niveles del árbol x. Por ejemplo, 
--    niveles ej1 == [[1],[8,3],[4]]
--    niveles ej2 == [[1],[8,3],[4,5,6]]
--    niveles ej3 == [[1],[8,3],[4,5,6,7]]
niveles :: Arbol a -> [[a]]
niveles x = takeWhile (not . null) [nivel n x | n <- [0..]]

-- (nivel n x) es el nivel de nivel n del árbol x. Por ejemplo,
--    nivel 0 ej1  ==  [1]
--    nivel 1 ej1  ==  [8,3]
--    nivel 2 ej1  ==  [4]
--    nivel 4 ej1  ==  []
nivel :: Int -> Arbol a ->  [a]
nivel 0 (N x _)  = [x]
nivel n (N _ xs) = concatMap (nivel (n-1)) xs

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

espiral2 :: Arbol a -> [a]
espiral2 = 
  concat . zipWith ($) (cycle [reverse,id]) . niveles

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

espiral3 :: Arbol a -> [a]
espiral3 = concat . zipWith ($) (cycle [reverse,id]) . niveles3

niveles3 :: Arbol a -> [[a]]
niveles3 t = map (map raiz)
           . takeWhile (not . null)
           . iterate (concatMap subBosque) $ [t]

raiz :: Arbol a -> a
raiz (N x _) = x

subBosque :: Arbol a -> [Arbol a]
subBosque (N _ ts) = ts

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

espiral4 :: Arbol a -> [a]
espiral4 = concat . zipWith ($) (cycle [reverse,id]) . niveles4

niveles4 :: Arbol a -> [[a]]
niveles4 = map (map raiz)
         . takeWhile (not . null)
         . iterate (concatMap subBosque)
         . return  

-- 5ª definición
-- =============

espiral5 :: Arbol a -> [a]
espiral5 x = concat $ zipWith ($) (cycle [reverse,id]) $ niveles5 [x]

niveles5 :: [Arbol a] -> [[a]]
niveles5 [] = []
niveles5 xs = a : niveles5 (concat b)
  where (a,b) = unzip $ map (\(N x y) -> (x,y)) xs

-- 6ª definición
-- =============

espiral6 :: Arbol a -> [a]
espiral6 = concat . zipWith ($) (cycle [reverse,id]) . niveles5 . return

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

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

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

-- 1ª solución

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

espiral :: Arbol a -> [a]

espiral x =

concat [f xs | (f,xs) <- zip (cycle [reverse,id]) (niveles x)]

-- (niveles x) es la lista de los niveles del árbol x. Por ejemplo,

-- niveles ej1 == [[1],[8,3],[4]]

-- niveles ej2 == [[1],[8,3],[4,5,6]]

-- niveles ej3 == [[1],[8,3],[4,5,6,7]]

niveles :: Arbol a -> [[a]]

niveles x = takeWhile (not . null) [nivel n x | n <- [0..]]

-- (nivel n x) es el nivel de nivel n del árbol x. Por ejemplo,

-- nivel 0 ej1 == [1]

-- nivel 1 ej1 == [8,3]

-- nivel 2 ej1 == [4]

-- nivel 4 ej1 == []

nivel :: Int -> Arbol a -> [a]

nivel 0 (N x _) = [x]

nivel n (N _ xs) = concatMap (nivel (n-1)) xs

-- 2ª solución

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

espiral2 :: Arbol a -> [a]

espiral2 =

concat . zipWith ($) (cycle [reverse,id]) . niveles

-- 3ª solución

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

espiral3 :: Arbol a -> [a]

espiral3 = concat . zipWith ($) (cycle [reverse,id]) . niveles3

niveles3 :: Arbol a -> [[a]]

niveles3 t = map (map raiz)

. takeWhile (not . null)

. iterate (concatMap subBosque) $ [t]

raiz :: Arbol a -> a

raiz (N x _) = x

subBosque :: Arbol a -> [Arbol a]

subBosque (N _ ts) = ts

-- 4ª solución

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

espiral4 :: Arbol a -> [a]

espiral4 = concat . zipWith ($) (cycle [reverse,id]) . niveles4

niveles4 :: Arbol a -> [[a]]

niveles4 = map (map raiz)

. takeWhile (not . null)

. iterate (concatMap subBosque)

. return

-- 5ª definición

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

espiral5 :: Arbol a -> [a]

espiral5 x = concat $ zipWith ($) (cycle [reverse,id]) $ niveles5 [x]

niveles5 :: [Arbol a] -> [[a]]

niveles5 [] = []

niveles5 xs = a : niveles5 (concat b)

where (a,b) = unzip $ map (\(N x y) -> (x,y)) xs

-- 6ª definición

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

espiral6 :: Arbol a -> [a]

espiral6 = concat . zipWith ($) (cycle [reverse,id]) . niveles5 . return

Pensamiento

Dice la monotonía
del agua clara al caer:
un día es como otro día;
hoy es lo mismo que ayer.

Antonio Machado

El 2019 es un número de la suerte

PorJosé A. Alonso 4-enero-201925-marzo-2022

Un número de la suerte es un número natural que se genera por una criba, similar a la criba de Eratóstenes, como se indica a continuación:

Se comienza con la lista de los números enteros a partir de 1:

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

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

Se eliminan los números de dos en dos

   1,  3,  5,  7,  9,   11,   13,   15,   17,   19,   21,   23,   25...

1	1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25...

Como el segundo número que ha quedado es 3, se eliminan los números restantes de tres en tres:

   1,  3,      7,  9,         13,   15,         19,   21,         25...

1	1, 3, 7, 9, 13, 15, 19, 21, 25...

Como el tercer número que ha quedado es 7, se eliminan los números restantes de siete en siete:

   1,  3,      7,  9,         13,   15,               21,         25...

1	1, 3, 7, 9, 13, 15, 21, 25...

Este procedimiento se repite indefinidamente y los supervivientes son los números de la suerte:

   1,3,7,9,13,15,21,25,31,33,37,43,49,51,63,67,69,73,75,79

1	1,3,7,9,13,15,21,25,31,33,37,43,49,51,63,67,69,73,75,79

Definir las funciones

   numerosDeLaSuerte  :: [Int]
   esNumeroDeLaSuerte :: Int -> Bool

1 2	numerosDeLaSuerte :: [Int] esNumeroDeLaSuerte :: Int -> Bool

tales que

numerosDeLaSuerte es la sucesión de los números de la suerte. Por ejemplo,

     λ> take 20 numerosDeLaSuerte
     [1,3,7,9,13,15,21,25,31,33,37,43,49,51,63,67,69,73,75,79]
     λ> numerosDeLaSuerte !! 277
     2019
     λ> numerosDeLaSuerte !! 2000
     19309

λ> take 20 numerosDeLaSuerte

[1,3,7,9,13,15,21,25,31,33,37,43,49,51,63,67,69,73,75,79]

λ> numerosDeLaSuerte !! 277

2019

λ> numerosDeLaSuerte !! 2000

19309

(esNumeroDeLaSuerte n) que se verifica si n es un número de la suerte. Por ejemplo,

   esNumeroDeLaSuerte 15    ==  True
   esNumeroDeLaSuerte 16    ==  False
   esNumeroDeLaSuerte 2019  ==  True

esNumeroDeLaSuerte 15 == True

esNumeroDeLaSuerte 16 == False

esNumeroDeLaSuerte 2019 == True

Soluciones

-- 1ª definición de numerosDeLaSuerte 
numerosDeLaSuerte :: [Int]
numerosDeLaSuerte = criba 3 [1,3..]
  where
    criba i (n:s:xs) =
      n : criba (i + 1) (s : [x | (k, x) <- zip [i..] xs
                                , rem k s /= 0])

-- 2ª definición de numerosDeLaSuerte 
numerosDeLaSuerte2 :: [Int]
numerosDeLaSuerte2 =  1 : criba 2 [1, 3..]
  where criba k xs = z : criba (k + 1) (aux xs)
          where z = xs !! (k - 1 )
                aux ws = us ++ aux vs
                  where (us, _:vs) = splitAt (z - 1) ws 

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

--    λ> numerosDeLaSuerte2 !! 200
--    1387
--    (9.25 secs, 2,863,983,232 bytes)
--    λ> numerosDeLaSuerte !! 200
--    1387
--    (0.06 secs, 10,263,880 bytes)

-- Definición de esNumeroDeLaSuerte
esNumeroDeLaSuerte :: Int -> Bool
esNumeroDeLaSuerte n =
  n == head (dropWhile (<n) numerosDeLaSuerte)

-- 1ª definición de numerosDeLaSuerte

numerosDeLaSuerte :: [Int]

numerosDeLaSuerte = criba 3 [1,3..]

where

criba i (n:s:xs) =

n : criba (i + 1) (s : [x | (k, x) <- zip [i..] xs

, rem k s /= 0])

-- 2ª definición de numerosDeLaSuerte

numerosDeLaSuerte2 :: [Int]

numerosDeLaSuerte2 = 1 : criba 2 [1, 3..]

where criba k xs = z : criba (k + 1) (aux xs)

where z = xs !! (k - 1 )

aux ws = us ++ aux vs

where (us, _:vs) = splitAt (z - 1) ws

-- Comparación de eficiencia

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

-- λ> numerosDeLaSuerte2 !! 200

-- 1387

-- (9.25 secs, 2,863,983,232 bytes)

-- λ> numerosDeLaSuerte !! 200

-- 1387

-- (0.06 secs, 10,263,880 bytes)

-- Definición de esNumeroDeLaSuerte

esNumeroDeLaSuerte :: Int -> Bool

esNumeroDeLaSuerte n =

n == head (dropWhile (<n) numerosDeLaSuerte)

Pensamiento

Ya es sólo brocal el pozo;
púlpito será mañana;
pasado mañana, trono.

Antonio Machado

Números colinas

PorJosé A. Alonso 29-noviembre-201819-enero-2019

Se dice que un número natural n es una colina si su primer dígito es igual a su último dígito, los primeros dígitos son estrictamente creciente hasta llegar al máximo, el máximo se puede repetir y los dígitos desde el máximo al final son estrictamente decrecientes.

Definir la función

   esColina :: Integer -> Bool

1	esColina :: Integer -> Bool

tal que (esColina n) se verifica si n es un número colina. Por ejemplo,

   esColina 12377731  ==  True
   esColina 1237731   ==  True
   esColina 123731    ==  True
   esColina 122731    ==  False
   esColina 12377730  ==  False
   esColina 12377730  ==  False
   esColina 10377731  ==  False
   esColina 12377701  ==  False
   esColina 33333333  ==  True

esColina 12377731 == True

esColina 1237731 == True

esColina 123731 == True

esColina 122731 == False

esColina 12377730 == False

esColina 10377731 == False

esColina 12377701 == False

esColina 33333333 == True

Soluciones

import Data.Char (digitToInt)

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

esColina :: Integer -> Bool
esColina n =
  head ds == last ds &&
  esCreciente xs &&
  esDecreciente ys
  where ds = digitos n
        m  = maximum ds
        xs = takeWhile (<m) ds
        ys = dropWhile (==m) (dropWhile (<m) ds)

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 425  ==  [4,2,5]
digitos :: Integer -> [Int]
digitos n = map digitToInt (show n)

-- (esCreciente xs) se verifica si la lista xs es estrictamente
-- creciente. Por ejemplo,
--    esCreciente [2,4,7]  ==  True
--    esCreciente [2,2,7]  ==  False
--    esCreciente [2,1,7]  ==  False
esCreciente :: [Int] -> Bool
esCreciente xs = and [x < y | (x,y) <- zip xs (tail xs)]

-- (esDecreciente xs) se verifica si la lista xs es estrictamente
-- decreciente. Por ejemplo,
--    esDecreciente [7,4,2]  ==  True
--    esDecreciente [7,2,2]  ==  False
--    esDecreciente [7,1,2]  ==  False
esDecreciente :: [Int] -> Bool
esDecreciente xs = and [x > y | (x,y) <- zip xs (tail xs)]

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

esColina2 :: Integer -> Bool
esColina2 n =
  head ds == last ds &&
  null (dropWhile (==(-1)) (dropWhile (==0) (dropWhile (==1) xs)))
  where ds = digitos n
        xs = [signum (y-x) | (x,y) <- zip ds (tail ds)] 

-- Equivalencia
-- ============

-- La propiedad de equivalencia es
prop_esColina :: Integer -> Property
prop_esColina n =
  n >= 0 ==> esColina n == esColina2 n 

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

import Data.Char (digitToInt)

-- 1ª definición

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

esColina :: Integer -> Bool

esColina n =

head ds == last ds &&

esCreciente xs &&

esDecreciente ys

where ds = digitos n

m = maximum ds

xs = takeWhile (<m) ds

ys = dropWhile (==m) (dropWhile (<m) ds)

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

-- digitos 425 == [4,2,5]

digitos :: Integer -> [Int]

digitos n = map digitToInt (show n)

-- (esCreciente xs) se verifica si la lista xs es estrictamente

-- creciente. Por ejemplo,

-- esCreciente [2,4,7] == True

-- esCreciente [2,2,7] == False

-- esCreciente [2,1,7] == False

esCreciente :: [Int] -> Bool

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

-- (esDecreciente xs) se verifica si la lista xs es estrictamente

-- decreciente. Por ejemplo,

-- esDecreciente [7,4,2] == True

-- esDecreciente [7,2,2] == False

-- esDecreciente [7,1,2] == False

esDecreciente :: [Int] -> Bool

esDecreciente xs = and [x > y | (x,y) <- zip xs (tail xs)]

-- 2ª definición

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

esColina2 :: Integer -> Bool

esColina2 n =

head ds == last ds &&

null (dropWhile (==(-1)) (dropWhile (==0) (dropWhile (==1) xs)))

where ds = digitos n

xs = [signum (y-x) | (x,y) <- zip ds (tail ds)]

-- Equivalencia

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

-- La propiedad de equivalencia es

prop_esColina :: Integer -> Property

prop_esColina n =

n >= 0 ==> esColina n == esColina2 n

-- La comprobación es

-- λ> quickCheck prop_esColina

-- +++ OK, passed 100 tests.

Referencia

Basado en el problema Is this number a hill number? de Code Golf

Pensamiento

Si me tengo que morir
poco me importa aprender.
Y si no puedo saber,
poco me importa vivir.

Antonio Machado

Números primos sumas de dos primos

PorJosé A. Alonso 26-noviembre-201819-enero-2019

Definir las funciones

   esPrimoSumaDeDosPrimos :: Integer -> Bool

1	esPrimoSumaDeDosPrimos :: Integer -> Bool

primosSumaDeDosPrimos :: [Integer]
tales que

(esPrimoSumaDeDosPrimos x) se verifica si x es un número primo que se puede escribir como la suma de dos números primos. Por ejemplo,

     esPrimoSumaDeDosPrimos 19        ==  True
     esPrimoSumaDeDosPrimos 20        ==  False
     esPrimoSumaDeDosPrimos 23        ==  False
     esPrimoSumaDeDosPrimos 18409541  ==  False

esPrimoSumaDeDosPrimos 19 == True

esPrimoSumaDeDosPrimos 20 == False

esPrimoSumaDeDosPrimos 23 == False

esPrimoSumaDeDosPrimos 18409541 == False

primosSumaDeDosPrimos es la lista de los números primos que se pueden escribir como la suma de dos números primos. Por ejemplo,

     λ> take 17 primosSumaDeDosPrimos
     [5,7,13,19,31,43,61,73,103,109,139,151,181,193,199,229,241]
     λ> primosSumaDeDosPrimos !! (10^5)
     18409543

λ> take 17 primosSumaDeDosPrimos

[5,7,13,19,31,43,61,73,103,109,139,151,181,193,199,229,241]

λ> primosSumaDeDosPrimos !! (10^5)

18409543

Soluciones

import Data.Numbers.Primes (isPrime, primes)

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

esPrimoSumaDeDosPrimos :: Integer -> Bool
esPrimoSumaDeDosPrimos x =
  isPrime x && isPrime (x - 2)

primosSumaDeDosPrimos :: [Integer]
primosSumaDeDosPrimos =
  [x | x <- primes
     , isPrime (x - 2)]

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

primosSumaDeDosPrimos2 :: [Integer]
primosSumaDeDosPrimos2 =
  [y | (x,y) <- zip primes (tail primes)
     , y == x + 2]

esPrimoSumaDeDosPrimos2 :: Integer -> Bool
esPrimoSumaDeDosPrimos2 x = 
  x == head (dropWhile (<x) primosSumaDeDosPrimos2)

-- Equivalencias
-- =============

-- Equivalencia de esPrimoSumaDeDosPrimos
prop_esPrimoSumaDeDosPrimos_equiv :: Integer -> Property
prop_esPrimoSumaDeDosPrimos_equiv x =
  x > 0 ==>
  esPrimoSumaDeDosPrimos x == esPrimoSumaDeDosPrimos2 x

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

-- Equivalencia de primosSumaDeDosPrimos
prop_primosSumaDeDosPrimos_equiv :: Int -> Property
prop_primosSumaDeDosPrimos_equiv n =
  n >= 0 ==>
  primosSumaDeDosPrimos !! n == primosSumaDeDosPrimos2 !! n

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

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

--    λ> primosSumaDeDosPrimos !! (10^4)
--    1261081
--    (2.07 secs, 4,540,085,256 bytes)
--
-- Se recarga para evitar memorización    
--    λ> primosSumaDeDosPrimos2 !! (10^4)
--    1261081
--    (0.49 secs, 910,718,408 bytes)

import Data.Numbers.Primes (isPrime, primes)

-- 1ª solución

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

esPrimoSumaDeDosPrimos :: Integer -> Bool

esPrimoSumaDeDosPrimos x =

isPrime x && isPrime (x - 2)

primosSumaDeDosPrimos :: [Integer]

primosSumaDeDosPrimos =

[x | x <- primes

, isPrime (x - 2)]

-- 2ª solución

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

primosSumaDeDosPrimos2 :: [Integer]

primosSumaDeDosPrimos2 =

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

, y == x + 2]

esPrimoSumaDeDosPrimos2 :: Integer -> Bool

esPrimoSumaDeDosPrimos2 x =

x == head (dropWhile (<x) primosSumaDeDosPrimos2)

-- Equivalencias

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

-- Equivalencia de esPrimoSumaDeDosPrimos

prop_esPrimoSumaDeDosPrimos_equiv :: Integer -> Property

prop_esPrimoSumaDeDosPrimos_equiv x =

x > 0 ==>

esPrimoSumaDeDosPrimos x == esPrimoSumaDeDosPrimos2 x

-- La comprobación es

-- λ> quickCheck prop_esPrimoSumaDeDosPrimos_equiv

-- +++ OK, passed 100 tests.

-- Equivalencia de primosSumaDeDosPrimos

prop_primosSumaDeDosPrimos_equiv :: Int -> Property

prop_primosSumaDeDosPrimos_equiv n =

n >= 0 ==>

primosSumaDeDosPrimos !! n == primosSumaDeDosPrimos2 !! n

-- La comprobación es

-- λ> quickCheck prop_primosSumaDeDosPrimos_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> primosSumaDeDosPrimos !! (10^4)

-- 1261081

-- (2.07 secs, 4,540,085,256 bytes)

-- Se recarga para evitar memorización

-- λ> primosSumaDeDosPrimos2 !! (10^4)

-- 1261081

-- (0.49 secs, 910,718,408 bytes)

Pensamiento

Sed incompresivos; yo os aconsejo la incomprensión, aunque sólo sea para destripar los chistes de los tontos.

Antonio Machado

Distancia de Hamming

PorJosé A. Alonso 12-noviembre-201817-enero-2019

La distancia de Hamming entre dos listas es el número de posiciones en que los correspondientes elementos son distintos. Por ejemplo, la distancia de Hamming entre «roma» y «loba» es 2 (porque hay 2 posiciones en las que los elementos correspondientes son distintos: la 1ª y la 3ª).

Definir la función

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

1	distancia :: Eq a => [a] -> [a] -> Int

tal que (distancia xs ys) es la distancia de Hamming entre xs e ys. Por ejemplo,

   distancia "romano" "comino"  ==  2
   distancia "romano" "camino"  ==  3
   distancia "roma"   "comino"  ==  2
   distancia "roma"   "camino"  ==  3
   distancia "romano" "ron"     ==  1
   distancia "romano" "cama"    ==  2
   distancia "romano" "rama"    ==  1

distancia "romano" "comino" == 2

distancia "romano" "camino" == 3

distancia "roma" "comino" == 2

distancia "roma" "camino" == 3

distancia "romano" "ron" == 1

distancia "romano" "cama" == 2

distancia "romano" "rama" == 1

Comprobar con QuickCheck si la distancia de Hamming tiene la siguiente propiedad

   distancia(xs,ys) = 0 si, y sólo si, xs = ys

1	distancia(xs,ys) = 0 si, y sólo si, xs = ys

y, en el caso de que no se verifique, modificar ligeramente la propiedad para obtener una condición necesaria y suficiente de distancia(xs,ys) = 0.

Soluciones

import Test.QuickCheck

-- 1ª definición:
distancia :: Eq a => [a] -> [a] -> Int
distancia xs ys = length [(x,y) | (x,y) <- zip xs ys, x /= y] 

-- 2ª definición:
distancia2 :: Eq a => [a] -> [a] -> Int
distancia2 [] ys = 0
distancia2 xs [] = 0
distancia2 (x:xs) (y:ys) | x /= y    = 1 + distancia2 xs ys
                         | otherwise = distancia2 xs ys

-- La propiedad es
prop_distancia1 :: [Int] -> [Int] -> Bool
prop_distancia1 xs ys =
    (distancia xs ys == 0) == (xs == ys)

-- La comprobación es
--    ghci> quickCheck prop_distancia1
--    *** Failed! Falsifiable (after 2 tests and 1 shrink): 
--    []
--    [1]
-- 
-- En efecto,
--    ghci> distancia [] [1] == 0
--    True
--    ghci> [] == [1]
--    False
-- 
-- La primera modificación es restringir la propiedad a lista de igual
-- longitud: 
prop_distancia2 :: [Int] -> [Int] -> Property
prop_distancia2 xs ys =
    length xs == length ys ==> 
    (distancia xs ys == 0) == (xs == ys)

-- La comprobación es
--    ghci> quickCheck prop_distancia2
--    *** Gave up! Passed only 33 tests.

-- Nota. La propiedad se verifica, pero al ser la condición demasiado
-- restringida sólo 33 de los casos la cumple.

-- La segunda restricción es limitar las listas a la longitud de la más
-- corta: 
prop_distancia3 :: [Int] -> [Int] -> Bool
prop_distancia3 xs ys =
    (distancia xs ys == 0) == (take n xs == take n ys)
    where n = min (length xs) (length ys)

-- La comprobación es
--    ghci> quickCheck prop_distancia3
--    +++ OK, passed 100 tests.

import Test.QuickCheck

-- 1ª definición:

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

distancia xs ys = length [(x,y) | (x,y) <- zip xs ys, x /= y]

-- 2ª definición:

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

distancia2 [] ys = 0

distancia2 xs [] = 0

distancia2 (x:xs) (y:ys) | x /= y = 1 + distancia2 xs ys

| otherwise = distancia2 xs ys

-- La propiedad es

prop_distancia1 :: [Int] -> [Int] -> Bool

prop_distancia1 xs ys =

(distancia xs ys == 0) == (xs == ys)

-- La comprobación es

-- ghci> quickCheck prop_distancia1

-- *** Failed! Falsifiable (after 2 tests and 1 shrink):

-- []

-- [1]

-- En efecto,

-- ghci> distancia [] [1] == 0

-- True

-- ghci> [] == [1]

-- False

-- La primera modificación es restringir la propiedad a lista de igual

-- longitud:

prop_distancia2 :: [Int] -> [Int] -> Property

prop_distancia2 xs ys =

length xs == length ys ==>

(distancia xs ys == 0) == (xs == ys)

-- La comprobación es

-- ghci> quickCheck prop_distancia2

-- *** Gave up! Passed only 33 tests.

-- Nota. La propiedad se verifica, pero al ser la condición demasiado

-- restringida sólo 33 de los casos la cumple.

-- La segunda restricción es limitar las listas a la longitud de la más

-- corta:

prop_distancia3 :: [Int] -> [Int] -> Bool

prop_distancia3 xs ys =

(distancia xs ys == 0) == (take n xs == take n ys)

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

-- La comprobación es

-- ghci> quickCheck prop_distancia3

-- +++ OK, passed 100 tests.

Pensamiento

En mi soledad/
he visto cosas muy claras,
que no son verdad.

Antonio Machado

Recorrido en ZigZag

PorJosé A. Alonso 7-junio-20187-julio-2018

El recorrido en ZigZag de una matriz consiste en pasar de la primera fila hasta la última, de izquierda a derecha en las filas impares y de derecha a izquierda en las filas pares, como se indica en la figura.

         /             \
         | 1 -> 2 -> 3 |
         |           | |
         |           v |
         | 4 <- 5 <- 6 |   =>  Recorrido ZigZag: [1,2,3,6,5,4,7,8,9]
         | |           |
         | v           |
         | 7 -> 8 -> 9 |
         \             /

/ \

| 1 -> 2 -> 3 |

| | |

| v |

| 4 <- 5 <- 6 | => Recorrido ZigZag: [1,2,3,6,5,4,7,8,9]

| | |

| v |

| 7 -> 8 -> 9 |

\ /

Definir la función

   recorridoZigZag :: Matrix a -> [a]

1	recorridoZigZag :: Matrix a -> [a]

tal que (recorridoZigZag m) es la lista con los elementos de la matriz m cuando se recorre esta en ZigZag. Por ejemplo,

   λ> recorridoZigZag (fromLists [[1,2,3],[4,5,6],[7,8,9]])
   [1,2,3,6,5,4,7,8,9]
   λ> recorridoZigZag (fromLists [[1,2],[3,4],[5,6],[7,8]])
   [1,2,4,3,5,6,8,7]
   λ> recorridoZigZag (fromLists [[1,2,3,4],[5,6,7,8],[9,10,11,12]])
   [1,2,3,4,8,7,6,5,9,10,11,12]
   λ> recorridoZigZag (fromList 5 4 "Cada paso es la meta")
   "Cadasap o es al meta"
   λ> recorridoZigZag (fromList 4 5 "Cada paso es la meta")
   "Cada  osapes laatem "
   λ> recorridoZigZag (fromList 10 2 "Cada paso es la meta")
   "Caad psao se l ameat"
   λ> recorridoZigZag (fromList 2 10 "Cada paso es la meta")
   "Cada paso atem al se"

λ> recorridoZigZag (fromLists [[1,2,3],[4,5,6],[7,8,9]])

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

λ> recorridoZigZag (fromLists [[1,2],[3,4],[5,6],[7,8]])

[1,2,4,3,5,6,8,7]

λ> recorridoZigZag (fromLists [[1,2,3,4],[5,6,7,8],[9,10,11,12]])

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

λ> recorridoZigZag (fromList 5 4 "Cada paso es la meta")

"Cadasap o es al meta"

λ> recorridoZigZag (fromList 4 5 "Cada paso es la meta")

"Cada osapes laatem "

λ> recorridoZigZag (fromList 10 2 "Cada paso es la meta")

"Caad psao se l ameat"

λ> recorridoZigZag (fromList 2 10 "Cada paso es la meta")

"Cada paso atem al se"

Soluciones

import Data.Matrix (Matrix, toLists, fromLists, fromList)

recorridoZigZag :: Matrix a -> [a]
recorridoZigZag m =
  concat [f xs | (f,xs) <- zip (cycle [id,reverse]) (toLists m)]

import Data.Matrix (Matrix, toLists, fromLists, fromList)

recorridoZigZag :: Matrix a -> [a]

recorridoZigZag m =

concat [f xs | (f,xs) <- zip (cycle [id,reverse]) (toLists m)]

El problema de las N torres

PorJosé A. Alonso 5-junio-201825-abril-2021

El problema de las N torres consiste en colocar N torres en un tablero con N filas y N columnas de forma que no haya dos torres en la misma fila ni en la misma columna.

Cada solución del problema de puede representar mediante una matriz con ceros y unos donde los unos representan las posiciones ocupadas por las torres y los ceros las posiciones libres. Por ejemplo,

   ( 0 1 0 )
   ( 1 0 0 )
   ( 0 0 1 )

( 0 1 0 )

( 1 0 0 )

( 0 0 1 )

representa una solución del problema de las 3 torres.

Definir las funciones

   torres  :: Int -> [Matrix Int]
   nTorres :: Int -> Integer

1 2	torres :: Int -> [Matrix Int] nTorres :: Int -> Integer

tales que
+ (torres n) es la lista de las soluciones del problema de las n torres. Por ejemplo,

      λ> torres 3
      [( 1 0 0 )
       ( 0 1 0 )
       ( 0 0 1 )
      ,( 1 0 0 )
       ( 0 0 1 )
       ( 0 1 0 )
      ,( 0 1 0 )
       ( 1 0 0 )
       ( 0 0 1 )
      ,( 0 1 0 )
       ( 0 0 1 )
       ( 1 0 0 )
      ,( 0 0 1 )
       ( 1 0 0 )
       ( 0 1 0 )
      ,( 0 0 1 )
       ( 0 1 0 )
       ( 1 0 0 )
      ]

λ> torres 3

[( 1 0 0 )

( 0 1 0 )

( 0 0 1 )

,( 1 0 0 )

( 0 0 1 )

( 0 1 0 )

,( 0 1 0 )

( 1 0 0 )

( 0 0 1 )

,( 0 1 0 )

( 0 0 1 )

( 1 0 0 )

,( 0 0 1 )

( 1 0 0 )

( 0 1 0 )

,( 0 0 1 )

( 0 1 0 )

( 1 0 0 )

]

(nTorres n) es el número de soluciones del problema de las n torres. Por ejemplo,

      λ> nTorres 3
      6
      λ> length (show (nTorres (10^4)))
      35660

λ> nTorres 3

λ> length (show (nTorres (10^4)))

35660

Soluciones

[schedule expon=’2018-06-12′ expat=»06:00″]

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

[/schedule]

[schedule on=’2018-06-12′ at=»06:00″]

import Data.List (genericLength, sort, permutations)
import Data.Matrix 

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

torres1 :: Int -> [Matrix Int]
torres1 n = 
    [permutacionAmatriz n p | p <- sort (permutations [1..n])]

permutacionAmatriz :: Int -> [Int] -> Matrix Int
permutacionAmatriz n p =
    matrix n n f
    where f (i,j) | (i,j) `elem` posiciones = 1
                  | otherwise               = 0
          posiciones = zip [1..n] p    

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

torres2 :: Int -> [Matrix Int]
torres2 = map fromLists . permutations . toLists . identity

-- El cálculo con la definición anterior es:
--    λ> identity 3
--    ( 1 0 0 )
--    ( 0 1 0 )
--    ( 0 0 1 )
--    
--    λ> toLists it
--    [[1,0,0],[0,1,0],[0,0,1]]
--    λ> permutations it
--    [[[1,0,0],[0,1,0],[0,0,1]],
--     [[0,1,0],[1,0,0],[0,0,1]],
--     [[0,0,1],[0,1,0],[1,0,0]],
--     [[0,1,0],[0,0,1],[1,0,0]],
--     [[0,0,1],[1,0,0],[0,1,0]],
--     [[1,0,0],[0,0,1],[0,1,0]]]
--    λ> map fromLists it
--    [( 1 0 0 )
--     ( 0 1 0 )
--     ( 0 0 1 )
--    ,( 0 1 0 )
--     ( 1 0 0 )
--     ( 0 0 1 )
--    ,( 0 0 1 )
--     ( 0 1 0 )
--     ( 1 0 0 )
--    ,( 0 1 0 )
--     ( 0 0 1 )
--     ( 1 0 0 )
--    ,( 0 0 1 )
--     ( 1 0 0 )
--     ( 0 1 0 )
--    ,( 1 0 0 )
--     ( 0 0 1 )
--     ( 0 1 0 )
--    ]

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

nTorres1 :: Int -> Integer
nTorres1 = genericLength . torres1

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

nTorres2 :: Int -> Integer
nTorres2 n = product [1..fromIntegral n]

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

--    λ> nTorres1 9
--    362880
--    (4.22 secs, 693,596,128 bytes)
--    λ> nTorres2 9
--    362880
--    (0.00 secs, 0 bytes)

import Data.List (genericLength, sort, permutations)

import Data.Matrix

-- 1ª definición de torres

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

torres1 :: Int -> [Matrix Int]

torres1 n =

[permutacionAmatriz n p | p <- sort (permutations [1..n])]

permutacionAmatriz :: Int -> [Int] -> Matrix Int

permutacionAmatriz n p =

matrix n n f

where f (i,j) | (i,j) `elem` posiciones = 1

| otherwise = 0

posiciones = zip [1..n] p

-- 2ª definición de torres

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

torres2 :: Int -> [Matrix Int]

torres2 = map fromLists . permutations . toLists . identity

-- El cálculo con la definición anterior es:

-- λ> identity 3

-- ( 1 0 0 )

-- ( 0 1 0 )

-- ( 0 0 1 )

-- λ> toLists it

-- [[1,0,0],[0,1,0],[0,0,1]]

-- λ> permutations it

-- [[[1,0,0],[0,1,0],[0,0,1]],

-- [[0,1,0],[1,0,0],[0,0,1]],

-- [[0,0,1],[0,1,0],[1,0,0]],

-- [[0,1,0],[0,0,1],[1,0,0]],

-- [[0,0,1],[1,0,0],[0,1,0]],

-- [[1,0,0],[0,0,1],[0,1,0]]]

-- λ> map fromLists it

-- [( 1 0 0 )

-- ( 0 1 0 )

-- ( 0 0 1 )

-- ,( 0 1 0 )

-- ( 1 0 0 )

-- ( 0 0 1 )

-- ,( 0 0 1 )

-- ( 0 1 0 )

-- ( 1 0 0 )

-- ,( 0 1 0 )

-- ( 0 0 1 )

-- ( 1 0 0 )

-- ,( 0 0 1 )

-- ( 1 0 0 )

-- ( 0 1 0 )

-- ,( 1 0 0 )

-- ( 0 0 1 )

-- ( 0 1 0 )

-- ]

-- 1ª definición de nTorres

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

nTorres1 :: Int -> Integer

nTorres1 = genericLength . torres1

-- 2ª definición de nTorres

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

nTorres2 :: Int -> Integer

nTorres2 n = product [1..fromIntegral n]

-- Comparación de eficiencia

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

-- λ> nTorres1 9

-- 362880

-- (4.22 secs, 693,596,128 bytes)

-- λ> nTorres2 9

-- 362880

-- (0.00 secs, 0 bytes)

[/schedule]

La regla de los signos de Descartes

PorJosé A. Alonso 30-mayo-20186-junio-2018

Los polinomios pueden representarse mediante listas. Por ejemplo, el polinomio x^5+3x^4-5x^2+x-7 se representa por [1,3,0,-5,1,-7]. En dicha lista, obviando el cero, se producen tres cambios de signo: del 3 al -5, del -5 al 1 y del 1 al -7. Llamando C(p) al número de cambios de signo en la lista de coeficientes del polinomio p(x), tendríamos entonces que en este caso C(p)=3.

La regla de los signos de Descartes dice que el número de raíces reales positivas de una ecuación polinómica con coeficientes reales igualada a cero es, como mucho, igual al número de cambios de signo que se produzcan entre sus coeficientes (obviando los ceros). Por ejemplo, en el caso anterior la ecuación tendría como mucho tres soluciones reales positivas, ya que C(p)=3.

Además, si la cota C(p) no se alcanza, entonces el número de raíces positivas de la ecuación difiere de ella un múltiplo de dos. En el ejemplo anterior esto significa que la ecuación puede tener tres raíces positivas o tener solamente una, pero no podría ocurrir que tuviera dos o que no tuviera ninguna.

Definir las funciones

   cambios :: [Int] -> [(Int,Int)]
   nRaicesPositivas :: [Int] -> [Int]

1 2	cambios :: [Int] -> [(Int,Int)] nRaicesPositivas :: [Int] -> [Int]

tales que

(cambios xs) es la lista de los pares de elementos de xs con signos distintos, obviando los ceros. Por ejemplo,

     cambios [1,3,0,-5,1,-7]  ==  [(3,-5),(-5,1),(1,-7)]

1	cambios [1,3,0,-5,1,-7] == [(3,-5),(-5,1),(1,-7)]

(nRaicesPositivas p) es la lista de los posibles números de raíces positivas del polinomio p (representado mediante una lista) según la regla de los signos de Descartes. Por ejemplo,

     nRaicesPositivas [1,3,0,-5,1,-7]  ==  [3,1]

1	nRaicesPositivas [1,3,0,-5,1,-7] == [3,1]

que significa que la ecuación x^5+3x^4-5x^2+x-7=0 puede tener 3 ó 1 raíz positiva.

Soluciones

-- 1ª definición (por comprensión)
-- ===============================

cambios1 :: [Int] -> [(Int,Int)]
cambios1 xs = [(x,y) | (x,y) <- consecutivos (noCeros xs), x*y < 0]
  where consecutivos xs = zip xs (tail xs)

-- (noCeros xs) es la lista de los elementos de xs distintos de cero. 
-- Por ejemplo,  
--    noCeros [1,3,0,-5,1,-7]  ==  [1,3,-5,1,-7]
noCeros :: [Int] -> [Int]
noCeros = filter (/=0)

-- 2ª definición (por recursión)
-- =============================

cambios2 :: [Int] -> [(Int,Int)]
cambios2 xs = cambios2' (noCeros xs)
  where cambios2' (x:y:xs)
          | x*y < 0   = (x,y) : cambios2' (y:xs)
          | otherwise = cambios2' (y:xs)
        cambios2' _ = []

nRaicesPositivas :: [Int] -> [Int]
nRaicesPositivas xs = [n,n-2..0]
  where n = length (cambios1 xs)

-- 1ª definición (por comprensión)

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

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

cambios1 xs = [(x,y) | (x,y) <- consecutivos (noCeros xs), x*y < 0]

where consecutivos xs = zip xs (tail xs)

-- (noCeros xs) es la lista de los elementos de xs distintos de cero.

-- Por ejemplo,

-- noCeros [1,3,0,-5,1,-7] == [1,3,-5,1,-7]

noCeros :: [Int] -> [Int]

noCeros = filter (/=0)

-- 2ª definición (por recursión)

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

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

cambios2 xs = cambios2' (noCeros xs)

where cambios2' (x:y:xs)

| x*y < 0 = (x,y) : cambios2' (y:xs)

| otherwise = cambios2' (y:xs)

cambios2' _ = []

nRaicesPositivas :: [Int] -> [Int]

nRaicesPositivas xs = [n,n-2..0]

where n = length (cambios1 xs)

Alturas primas

PorJosé A. Alonso 10-abril-201826-marzo-2022

Se considera una enumeración de los números primos:

    p(1)=2,  p(2)=3, p(3)=5, p(4)=7, p(5)=11, p(6)=13, p(7)=17,...

1	p(1)=2, p(2)=3, p(3)=5, p(4)=7, p(5)=11, p(6)=13, p(7)=17,...

Dado un entero x > 1, su altura prima es el mayor i tal que el primo p(i) aparece en la factorización de x en números primos. Por ejemplo, la altura prima de 3500 tiene longitud 4, pues 3500=2^2×5^3×7^1 y la de 34 tiene es 7, pues 34 = 2×17. Además, se define la altura prima de 1 como 0.

Definir las funciones

   alturaPrima        :: Integer -> Integer
   alturasPrimas      :: Integer -> [Integer]
   graficaAlturaPrima :: Integer -> IO ()

alturaPrima :: Integer -> Integer

alturasPrimas :: Integer -> [Integer]

graficaAlturaPrima :: Integer -> IO ()

tales que

(alturaPrima x) es la altura prima de x. Por ejemplo,

     alturaPrima 3500  ==  4
     alturaPrima 34    ==  7

1 2	alturaPrima 3500 == 4 alturaPrima 34 == 7

(alturasPrimas n) es la lista de las altura prima de los primeros n números enteros positivos. Por ejemplo,

     alturasPrimas 15  ==  [0,1,2,1,3,2,4,1,2,3,5,2,6,4,3]
     maximum (alturasPrimas 10000)  ==  1229
     maximum (alturasPrimas 20000)  ==  2262
     maximum (alturasPrimas 30000)  ==  3245
     maximum (alturasPrimas 40000)  ==  4203

alturasPrimas 15 == [0,1,2,1,3,2,4,1,2,3,5,2,6,4,3]

maximum (alturasPrimas 10000) == 1229

maximum (alturasPrimas 20000) == 2262

maximum (alturasPrimas 30000) == 3245

maximum (alturasPrimas 40000) == 4203

(graficaAlturaPrima n) dibuja las alturas primas de los números entre 2 y n. Por ejemplo, (graficaAlturaPrima 500) dibuja

Soluciones

import Data.List (genericLength)
import Data.Numbers.Primes (isPrime, primes, primeFactors)
import Data.Array
import Graphics.Gnuplot.Simple

-- 1ª definicioń de alturaPrima
-- ============================

alturaPrima :: Integer -> Integer
alturaPrima 1 = 0
alturaPrima n = indice (mayorFactorPrimo n)

-- (mayorFactorPrimo n) es el mayor factor primo de n. Por ejemplo,
--    mayorFactorPrimo 3500  ==  7
--    mayorFactorPrimo 34    ==  17
mayorFactorPrimo :: Integer -> Integer
mayorFactorPrimo = last . primeFactors

-- (indice p) es el índice de p en la sucesión de los números
-- primos. Por ejemplo,
--    indice 7   ==  4
--    indice 17  ==  7
indice :: Integer -> Integer
indice p = genericLength (takeWhile (<=p) primes)

-- 2ª definicioń de alturaPrima
-- ============================

alturaPrima2 :: Integer -> Integer
alturaPrima2 n = v ! n
  where v = array (1,n) [(i,f i) | i <- [1..n]]
        f 1 = 0
        f k | isPrime k = indice2 k
            | otherwise = v ! (k `div` (head (primeFactors k)))

indice2 :: Integer -> Integer
indice2 p = head [n | (x,n) <- indicesPrimos, x == p]

-- indicesPrimos es la suceción formada por los números primos y sus
-- índices. Por ejemplo,
--    λ> take 10 indicesPrimos
--    [(2,1),(3,2),(5,3),(7,4),(11,5),(13,6),(17,7),(19,8),(23,9),(29,10)]
indicesPrimos :: [(Integer,Integer)]
indicesPrimos = zip primes [1..]

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

alturasPrimas :: Integer -> [Integer]
alturasPrimas n = map alturaPrima [1..n]

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

alturasPrimas2 :: Integer -> [Integer]
alturasPrimas2 n = elems v 
  where v = array (1,n) [(i,f i) | i <- [1..n]]
        f 1 = 0
        f k | isPrime k = indice2 k
            | otherwise = v ! (k `div` (head (primeFactors k)))

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

--    λ> maximum (alturasPrimas 20000)
--    2262
--    (29.97 secs, 13,179,984,536 bytes)
--    λ> maximum (alturasPrimas2 20000)
--    2262
--    (2.11 secs, 455,259,448 bytes)

-- Definición de graficaAlturaPrima
-- ================================

graficaAlturaPrima :: Integer -> IO ()
graficaAlturaPrima n =
  plotList [ Key Nothing
           , PNG "Alturas_primas.png"
           ]
           (alturasPrimas2 n)

import Data.List (genericLength)

import Data.Numbers.Primes (isPrime, primes, primeFactors)

import Data.Array

import Graphics.Gnuplot.Simple

-- 1ª definicioń de alturaPrima

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

alturaPrima :: Integer -> Integer

alturaPrima 1 = 0

alturaPrima n = indice (mayorFactorPrimo n)

-- (mayorFactorPrimo n) es el mayor factor primo de n. Por ejemplo,

-- mayorFactorPrimo 3500 == 7

-- mayorFactorPrimo 34 == 17

mayorFactorPrimo :: Integer -> Integer

mayorFactorPrimo = last . primeFactors

-- (indice p) es el índice de p en la sucesión de los números

-- primos. Por ejemplo,

-- indice 7 == 4

-- indice 17 == 7

indice :: Integer -> Integer

indice p = genericLength (takeWhile (<=p) primes)

-- 2ª definicioń de alturaPrima

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

alturaPrima2 :: Integer -> Integer

alturaPrima2 n = v ! n

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

f 1 = 0

f k | isPrime k = indice2 k

| otherwise = v ! (k `div` (head (primeFactors k)))

indice2 :: Integer -> Integer

indice2 p = head [n | (x,n) <- indicesPrimos, x == p]

-- indicesPrimos es la suceción formada por los números primos y sus

-- índices. Por ejemplo,

-- λ> take 10 indicesPrimos

-- [(2,1),(3,2),(5,3),(7,4),(11,5),(13,6),(17,7),(19,8),(23,9),(29,10)]

indicesPrimos :: [(Integer,Integer)]

indicesPrimos = zip primes [1..]

-- 1ª definición de alturasPrimas

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

alturasPrimas :: Integer -> [Integer]

alturasPrimas n = map alturaPrima [1..n]

-- 2ª definición de alturasPrimas

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

alturasPrimas2 :: Integer -> [Integer]

alturasPrimas2 n = elems v

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

f 1 = 0

f k | isPrime k = indice2 k

| otherwise = v ! (k `div` (head (primeFactors k)))

-- Comparación de eficiencia

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

-- λ> maximum (alturasPrimas 20000)

-- 2262

-- (29.97 secs, 13,179,984,536 bytes)

-- λ> maximum (alturasPrimas2 20000)

-- 2262

-- (2.11 secs, 455,259,448 bytes)

-- Definición de graficaAlturaPrima

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

graficaAlturaPrima :: Integer -> IO ()

graficaAlturaPrima n =

plotList [ Key Nothing

, PNG "Alturas_primas.png"

]

(alturasPrimas2 n)

La carrera de Collatz

PorJosé A. Alonso 4-abril-201811-abril-2018

Sea f la siguiente función, aplicable a cualquier número entero positivo:

Si el número es par, se divide entre 2.
Si el número es impar, se multiplica por 3 y se suma 1.

La carrera de Collatz consiste en, dada una lista de números ns, sustituir cada número n de ns por f(n) hasta que alguno sea igual a 1. Por ejemplo, la siguiente sucesión es una carrera de Collatz

   [ 3, 6,20, 49, 73]
   [10, 3,10,148,220]
   [ 5,10, 5, 74,110]
   [16, 5,16, 37, 55]
   [ 8,16, 8,112,166]
   [ 4, 8, 4, 56, 83]
   [ 2, 4, 2, 28,250]
   [ 1, 2, 1, 14,125]

[ 3, 6,20, 49, 73]

[10, 3,10,148,220]

[ 5,10, 5, 74,110]

[16, 5,16, 37, 55]

[ 8,16, 8,112,166]

[ 4, 8, 4, 56, 83]

[ 2, 4, 2, 28,250]

[ 1, 2, 1, 14,125]

En esta carrera, los ganadores son 3 y 20.

Definir la función

   ganadores :: [Int] -> [Int]

1	ganadores :: [Int] -> [Int]

tal que (ganadores ns) es la lista de los ganadores de la carrera de Collatz a partir de la lista inicial ns. Por ejmplo,

   ganadores [3,6,20,49,73]  ==  [3,20]

1	ganadores [3,6,20,49,73] == [3,20]

Soluciones

ganadores :: [Int] -> [Int]
ganadores xs = selecciona xs (final xs)

-- (final xs) es el estado final de la carrera de Collatz a partir de
-- xs. Por ejemplo,
--    final [3,6,20,49,73]  ==  [1,2,1,14,125]
final :: [Int] -> [Int]
final xs | elem 1 xs = xs
         | otherwise = final [siguiente x | x <- xs]

-- (siguiente x) es el siguiente de x en la carrera de Collatz. Por
-- ejemplo, 
--    siguiente 3  ==  10
--    siguiente 6  ==  3
siguiente :: Int -> Int
siguiente x | even x    = x `div` 2
            | otherwise = 3*x+1

-- (selecciona xs ys) es la lista de los elementos de xs cuyos tales que
-- los elementos de ys en la misma posición son iguales a 1. Por ejemplo,
--    selecciona [3,6,20,49,73] [1,2,1,14,125]  ==  [3,20]
selecciona :: [Int] -> [Int] -> [Int]
selecciona xs ys =
  [x | (x,y) <- zip xs ys, y == 1]

ganadores :: [Int] -> [Int]

ganadores xs = selecciona xs (final xs)

-- (final xs) es el estado final de la carrera de Collatz a partir de

-- xs. Por ejemplo,

-- final [3,6,20,49,73] == [1,2,1,14,125]

final :: [Int] -> [Int]

final xs | elem 1 xs = xs

| otherwise = final [siguiente x | x <- xs]

-- (siguiente x) es el siguiente de x en la carrera de Collatz. Por

-- ejemplo,

-- siguiente 3 == 10

-- siguiente 6 == 3

siguiente :: Int -> Int

siguiente x | even x = x `div` 2

| otherwise = 3*x+1

-- (selecciona xs ys) es la lista de los elementos de xs cuyos tales que

-- los elementos de ys en la misma posición son iguales a 1. Por ejemplo,

-- selecciona [3,6,20,49,73] [1,2,1,14,125] == [3,20]

selecciona :: [Int] -> [Int] -> [Int]

selecciona xs ys =

[x | (x,y) <- zip xs ys, y == 1]

Operaciones binarias con matrices

PorJosé A. Alonso 28-marzo-20185-abril-2018

Entre dos matrices de la misma dimensión se pueden aplicar distintas operaciones binarias entre los elementos en la misma posición. Por ejemplo, si a y b son las matrices

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

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

entonces a+b y a-b son, respectivamente

   |4 8 8|     |2 0 4|
   |7 7 9|     |3 5 5

1 2	\|4 8 8\| \|2 0 4\| \|7 7 9\| \|3 5 5

Definir la función

   opMatriz :: (Int -> Int -> Int) -> 
               Matriz Int -> Matriz Int -> Matriz Int

1 2	opMatriz :: (Int -> Int -> Int) -> Matriz Int -> Matriz Int -> Matriz Int

tal que (opMatriz f p q) es la matriz obtenida aplicando la operación f entre los elementos de p y q de la misma posición. Por ejemplo,

   λ> a = listArray ((1,1),(2,3)) [3,4,6,5,6,7]
   λ> b = listArray ((1,1),(2,3)) [1,4,2,2,1,2]
   λ> elems (opMatriz (+) a b)
   [4,8,8,7,7,9]
   λ> elems (opMatriz max a b)
   [3,4,6,5,6,7]
   λ> c = listArray ((1,1),(2,2)) ["ab","c","d","ef"]
   λ> d = listArray ((1,1),(2,2)) [3,1,0,5]
   λ> elems (opMatriz menor c d)
   [True,False,False,True]

λ> a = listArray ((1,1),(2,3)) [3,4,6,5,6,7]

λ> b = listArray ((1,1),(2,3)) [1,4,2,2,1,2]

λ> elems (opMatriz (+) a b)

[4,8,8,7,7,9]

λ> elems (opMatriz max a b)

[3,4,6,5,6,7]

λ> c = listArray ((1,1),(2,2)) ["ab","c","d","ef"]

λ> d = listArray ((1,1),(2,2)) [3,1,0,5]

λ> elems (opMatriz menor c d)

[True,False,False,True]

Soluciones

import Data.Array

-- 1ª solución
opMatriz :: (a -> b -> c) ->
            Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c
opMatriz f p q =
  array (bounds p) [(k, f (p!k) (q!k)) | k <- indices p]
          
-- 2ª solución
opMatriz2 :: (a -> b -> c) ->
            Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c
opMatriz2 f p q = 
  listArray (bounds p) [f x y | (x,y) <- zip (elems p) (elems q)]

-- 3ª solución
opMatriz3 :: (a -> b -> c) ->
            Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c
opMatriz3 f p q = 
  listArray (bounds p) (zipWith f (elems p) (elems q))

import Data.Array

-- 1ª solución

opMatriz :: (a -> b -> c) ->

Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c

opMatriz f p q =

array (bounds p) [(k, f (p!k) (q!k)) | k <- indices p]

-- 2ª solución

opMatriz2 :: (a -> b -> c) ->

Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c

opMatriz2 f p q =

listArray (bounds p) [f x y | (x,y) <- zip (elems p) (elems q)]

-- 3ª solución

opMatriz3 :: (a -> b -> c) ->

Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c

opMatriz3 f p q =

listArray (bounds p) (zipWith f (elems p) (elems q))

La conjetura de Gilbreath

PorJosé A. Alonso 8-marzo-201825-abril-2021

Partiendo de los 5 primeros números primos y calculando el valor absoluto de la diferencia de cada dos números consecutivos hasta quedarse con un único número se obtiene la siguiente tabla:

   2, 3, 5, 7, 11
   1, 2, 2, 4 
   1, 0, 2
   1, 2 
   1

2, 3, 5, 7, 11

1, 2, 2, 4

1, 0, 2

1, 2

Se observa que todas las filas, salvo la inicial, comienzan con el número 1.

Repitiendo el proceso pero empezando con los 8 primeros números primos se obtiene la siguiente tabla:

   2, 3, 5, 7, 11, 13, 17, 19 
   1, 2, 2, 4,  2,  4,  2  
   1, 0, 2, 2,  2,  2 
   1, 2, 0, 0,  0 
   1, 2, 0, 0 
   1, 2, 0 
   1, 2 
   1

2, 3, 5, 7, 11, 13, 17, 19

1, 2, 2, 4, 2, 4, 2

1, 0, 2, 2, 2, 2

1, 2, 0, 0, 0

1, 2, 0, 0

1, 2, 0

1, 2

Se observa que, de nuevo, todas las filas, salvo la inicial, comienza con el número 1.

El objetivo de este ejercicio es comprobar experimentalmente dicha conjetura.

Para la representación, usaremos la simétrica de la que hemos comentado anteriormente; es decir,

    2
    3, 1
    5, 2, 1
    7, 2, 0, 1
   11, 4, 2, 2, 1
   13, 2, 2, 0, 2, 1
   17, 4, 2, 0, 0, 2, 1
   19, 2, 2, 0, 0, 0, 2, 1

3, 1

5, 2, 1

7, 2, 0, 1

11, 4, 2, 2, 1

13, 2, 2, 0, 2, 1

17, 4, 2, 0, 0, 2, 1

19, 2, 2, 0, 0, 0, 2, 1

en la que la primera columna son los números primos y el elemento de la fila i y columna j (con i, j > 1) es el valor absoluto de la diferencia de los elementos (i,j-1) e (i-1,j-1).

Definir las siguientes funciones

   siguiente           :: Integer -> [Integer] -> [Integer]
   triangulo           :: [[Integer]]
   conjetura_Gilbreath :: Int -> Bool

siguiente :: Integer -> [Integer] -> [Integer]

triangulo :: [[Integer]]

conjetura_Gilbreath :: Int -> Bool

tales que

(siguiente x ys) es la línea siguiente de la ys que empieza por x en la tabla de Gilbreath; es decir, si ys es [y1,y2,…,yn], entonces (siguiente x ys) es [x,|y1-x|,|y2-|y1-x||,…] Por ejemplo,

     siguiente  7 [5,2,1]               ==  [7,2,0,1]
     siguiente 29 [23,4,2,0,0,0,0,2,1]  ==  [29,6,2,0,0,0,0,0,2,1]

1 2	siguiente 7 [5,2,1] == [7,2,0,1] siguiente 29 [23,4,2,0,0,0,0,2,1] == [29,6,2,0,0,0,0,0,2,1]

triangulo es el triángulo de Gilbreath. Por ejemplo,

     ghci> take 10 triangulo
     [[ 2],
      [ 3,1],
      [ 5,2,1],
      [ 7,2,0,1],
      [11,4,2,2,1],
      [13,2,2,0,2,1],
      [17,4,2,0,0,2,1],
      [19,2,2,0,0,0,2,1],
      [23,4,2,0,0,0,0,2,1],
      [29,6,2,0,0,0,0,0,2,1]]

ghci> take 10 triangulo

[[ 2],

[ 3,1],

[ 5,2,1],

[ 7,2,0,1],

[11,4,2,2,1],

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

[17,4,2,0,0,2,1],

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

[23,4,2,0,0,0,0,2,1],

[29,6,2,0,0,0,0,0,2,1]]

(conjeturaGilbreath n) se verifica si se cumple la conjetura de Gilbreath para los n primeros números primos; es decir, en el triángulo de Gilbreath cuya primera columna son los n primeros números primos, todas las filas a partir de la segunda terminan en 1. Por ejemplo,

     ghci> conjeturaGilbreath 1000
     True

1 2	ghci> conjeturaGilbreath 1000 True

Soluciones

import Data.Numbers.Primes

siguiente :: Integer -> [Integer] -> [Integer]
siguiente x ys = scanl (\m n -> abs (m-n)) x ys 

triangulo :: [[Integer]]
triangulo = 
    [2] : [siguiente x ys | (x,ys) <- zip (tail primes) triangulo]

conjeturaGilbreath :: Int -> Bool
conjeturaGilbreath n = all p (tail (take n triangulo))
  where p xs = last xs == 1

import Data.Numbers.Primes

siguiente :: Integer -> [Integer] -> [Integer]

siguiente x ys = scanl (\m n -> abs (m-n)) x ys

triangulo :: [[Integer]]

triangulo =

[2] : [siguiente x ys | (x,ys) <- zip (tail primes) triangulo]

conjeturaGilbreath :: Int -> Bool

conjeturaGilbreath n = all p (tail (take n triangulo))

where p xs = last xs == 1

Soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas 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

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Referencia

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico