Medio

Números compuestos persistentes

PorJosé A. Alonso 15-enero-202122-enero-2021

Un número compuesto persistente es un número compuesto que no se puede transformar en un número primo cambiando sólo uno de sus dígitos. Por ejemplo,

20 no es un compuesto persistente porque cambiando su último dígito por un 3 se transforma en 23 que es primo.
25 no es un compuesto persistente porque cambiando su primer dígito por un 0 se transforma en 5 que es primo.
200 es un compuesto persistente ya que al cambiar su útimo dígito por un impar se obtienen los números 201, 203, 207, 205 y 209 que no son primos y todos sus demás transformados son pares y, por tanto, tampoco son primos.

Definir las funciones

   esCompuestoPersistente :: Integer -> Bool
   compuestosPersistentes :: [Integer]

1 2	esCompuestoPersistente :: Integer -> Bool compuestosPersistentes :: [Integer]

tales que

(esCompuestoPersistente n) se verifica si n es un número compuesto persistente. Por ejemplo,

     esCompuestoPersistente 20    ==  False
     esCompuestoPersistente 200   ==  True
     esCompuestoPersistente 2021  ==  False

esCompuestoPersistente 20 == False

esCompuestoPersistente 200 == True

esCompuestoPersistente 2021 == False

compuestosPersistentes es la lista de los números compuestos persistentes. Por ejemplo,

     λ> take 10 compuestoPersistentes
     [200,204,206,208,320,322,324,325,326,328]

1 2	λ> take 10 compuestoPersistentes [200,204,206,208,320,322,324,325,326,328]

Comprobar con QuickCheck que todos los números de la forma 510+2310*k son números compuestos persistentes.

Soluciones

import Data.Numbers.Primes (isPrime, primes)
import Test.QuickCheck (Property, (==>), quickCheck)

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

esCompuestoPersistente :: Integer -> Bool
esCompuestoPersistente n =
  esCompuesto n && all (not . isPrime) (transformados n)

-- (eCompuesto n) se verifica si n es un número compuesto. Por ejemplo,
--    esCompuesto 15  ==  True
--    esCompuesto 16  ==  True
--    esCompuesto 17  ==  False
esCompuesto :: Integer -> Bool
esCompuesto n =  n > 1 && not (isPrime n)

-- (transformados n) es la lista delos números obtenidos modificando uno
-- de los dígitos de n. Por ejemplo,
--    λ> transformados 27
--    [7,17,37,47,57,67,77,87,97,20,21,22,23,24,25,26,28,29]
transformados :: Integer -> [Integer]
transformados n = map read (aux (show n))
  where aux []     = []
        aux [x]    = [[y] | y <- ['0'..'9'], y /= x]
        aux (x:xs) = [y:xs | y <- ['0'..'9'], y /= x] ++
                     [x:ys | ys <- aux xs]

compuestosPersistentes :: [Integer]
compuestosPersistentes = filter esCompuestoPersistente [1..]

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

esCompuestoPersistente2 :: Integer -> Bool
esCompuestoPersistente2 n =
  not (any (esTransformadoDe n) (takeWhile (<=10^m-1) primes))
  where m = length (show n)

-- (esTransformadoDe m n) se verifica si n se puede obtener modificando uno
-- de los dígitos de n. Por ejemplo,
--    esTransformadoDe 27 47  ==  True
--    esTransformadoDe 27 25  ==  True
--    esTransformadoDe 27 45  ==  False
--    esTransformadoDe 27 7   ==  True
--    esTransformadoDe 27 2   ==  False
esTransformadoDe :: Integer -> Integer -> Bool
esTransformadoDe m n =
  1 == length (filter (==False) (zipWith (==) xs zs))
  where xs = show m
        ys = show n
        zs = replicate (length xs - length ys) '0' ++ ys

compuestosPersistentes2 :: [Integer]
compuestosPersistentes2 = filter esCompuestoPersistente2 [1..]

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

esCompuestoPersistente3 :: Integer -> Bool
esCompuestoPersistente3 n =
  null (primosTransformados n)

-- (primosTransformados n) es la lista de los números primos que se
-- puede obtener modificando uno de los dígitos de n. Por ejemplo,
--    primosTransformados 27   ==  [17,23,29,37,47,67,97,7]
--    primosTransformados 26   ==  [23,29]
--    primosTransformados 200  ==  []
--    primosTransformados 202  ==  [2]
primosTransformados :: Integer -> [Integer]
primosTransformados n =
  [x | x <- primosNdigitos p, difierenEnUnaPosicion n x] ++
  [x | x <- [read ('0' : tail ns)], isPrime x]
  where ns = show n
        p  = length ns

-- (difierenEnUnaPosicion m n) se verifica si los números m y n difieren
-- en una posición (suponiendo que m y n tienen el mismo número de
-- dígitos). Por ejemplo,
--    difierenEnUnaPosicion 325 375  ==  True
--    difierenEnUnaPosicion 325 357  ==  False
difierenEnUnaPosicion :: Integer -> Integer -> Bool
difierenEnUnaPosicion m n =
  1 == length (filter (==False) (zipWith (==) (show m) (show n)))

-- (primosNdigitos n) es la lista de los primos con n dígitos. Por
-- ejemplo,
--    λ> primosNdigitos 2
--    [11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]
primosNdigitos :: Int -> [Integer]
primosNdigitos n = takeWhile (<=10^n-1) (dropWhile (<=10^(n-1)) primes)

compuestosPersistentes3 :: [Integer]
compuestosPersistentes3 = filter esCompuestoPersistente3 [1..]

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

esCompuestoPersistente4 :: Integer -> Bool
esCompuestoPersistente4 n =
  null (primosTransformados2 n)

-- (primosTransformados2 n) es la lista de los números primos que se
-- puede obtener modificando uno de los dígitos de n. Por ejemplo,
--    primosTransformados2 27   ==  [17,23,29,37,47,67,97,7]
--    primosTransformados2 26   ==  [23,29]
--    primosTransformados2 200  ==  []
--    primosTransformados2 202  ==  [2]
primosTransformados2 :: Integer -> [Integer]
primosTransformados2 n =
  [x | x <- primosEntre (menorTransformado n) (mayorTransformado n)
     , difierenEnUnaPosicion n x] ++
  [x | x <- [read ('0' : tail ns)], isPrime x]
  where ns = show n
        p  = length ns

-- (primosEntre x y) lista de números prios mayores o iguales que x y
-- menores o iguales que y. Por ejemplo,
--    primosEntre 11 41  ==  [11,13,17,19,23,29,31,37,41]
primosEntre ::Integer -> Integer -> [Integer]
primosEntre x y = takeWhile (<= y) (dropWhile (< x) primes)

-- (menorTransformado x) es el menor número, con la misma cantidad de
-- dígitos que x, que se puede obtener modificando uno de los dígitos de
-- n. Por ejemplo,
--    menorTransformado 375   ==  175
--    menorTransformado 14    ==  11
--    menorTransformado 4     ==  1
--    menorTransformado 1145  ==  1115
menorTransformado :: Integer -> Integer
menorTransformado x
  | x <= 9    = 1
  | y > '1'   = read ('1' : ys)
  | otherwise = read ('1' : show (menorTransformado (read ys)))
  where (y:ys) = show x

-- (mayorTransformado x) es el mayor número, con la misma cantidad de
-- dígitos que x, que se puede obtener modificando uno de los dígitos de
-- n. Por ejemplo,
--    mayorTransformado 375   ==  975
--    mayorTransformado 93    ==  99
--    mayorTransformado 4     ==  9
--    mayorTransformado 9945  ==  9995
mayorTransformado :: Integer -> Integer
mayorTransformado x
  | x <= 9    = 9
  | y < '9'   = read ('9' : ys)
  | otherwise = read ('9' : show (mayorTransformado (read ys)))
  where (y:ys) = show x

compuestosPersistentes4 :: [Integer]
compuestosPersistentes4 = filter esCompuestoPersistente4 [1..]

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

-- La comparación es
--    λ> compuestosPersistentes !! 1000
--    8180
--    (0.54 secs, 1,577,628,232 bytes)
--    λ> compuestosPersistentes2 !! 1000
--    8180
--    (10.13 secs, 15,883,929,392 bytes)
--    λ> compuestosPersistentes3 !! 1000
--    8180
--    (7.09 secs, 14,165,470,304 bytes)
--    λ> compuestosPersistentes4 !! 1000
--    8180
--    (6.54 secs, 13,332,608,480 bytes)

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

-- La propiedad es
prop_compuestosPersistentes :: Integer -> Property
prop_compuestosPersistentes k =
  k > 0 ==> esCompuestoPersistente (510 + 2310 * k)

-- La comprobación de la propiedad es
--    λ> quickCheck prop_compuestosPersistentes
--    +++ OK, passed 100 tests.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

import Data.Numbers.Primes (isPrime, primes)

import Test.QuickCheck (Property, (==>), quickCheck)

-- 1ª solución

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

esCompuestoPersistente :: Integer -> Bool

esCompuestoPersistente n =

esCompuesto n && all (not . isPrime) (transformados n)

-- (eCompuesto n) se verifica si n es un número compuesto. Por ejemplo,

-- esCompuesto 15 == True

-- esCompuesto 16 == True

-- esCompuesto 17 == False

esCompuesto :: Integer -> Bool

esCompuesto n = n > 1 && not (isPrime n)

-- (transformados n) es la lista delos números obtenidos modificando uno

-- de los dígitos de n. Por ejemplo,

-- λ> transformados 27

-- [7,17,37,47,57,67,77,87,97,20,21,22,23,24,25,26,28,29]

transformados :: Integer -> [Integer]

transformados n = map read (aux (show n))

where aux [] = []

aux [x] = [[y] | y <- ['0'..'9'], y /= x]

aux (x:xs) = [y:xs | y <- ['0'..'9'], y /= x] ++

[x:ys | ys <- aux xs]

compuestosPersistentes :: [Integer]

compuestosPersistentes = filter esCompuestoPersistente [1..]

-- 2ª solución

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

esCompuestoPersistente2 :: Integer -> Bool

esCompuestoPersistente2 n =

not (any (esTransformadoDe n) (takeWhile (<=10^m-1) primes))

where m = length (show n)

-- (esTransformadoDe m n) se verifica si n se puede obtener modificando uno

-- de los dígitos de n. Por ejemplo,

-- esTransformadoDe 27 47 == True

-- esTransformadoDe 27 25 == True

-- esTransformadoDe 27 45 == False

-- esTransformadoDe 27 7 == True

-- esTransformadoDe 27 2 == False

esTransformadoDe :: Integer -> Integer -> Bool

esTransformadoDe m n =

1 == length (filter (==False) (zipWith (==) xs zs))

where xs = show m

ys = show n

zs = replicate (length xs - length ys) '0' ++ ys

compuestosPersistentes2 :: [Integer]

compuestosPersistentes2 = filter esCompuestoPersistente2 [1..]

-- 3ª solución

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

esCompuestoPersistente3 :: Integer -> Bool

esCompuestoPersistente3 n =

null (primosTransformados n)

-- (primosTransformados n) es la lista de los números primos que se

-- puede obtener modificando uno de los dígitos de n. Por ejemplo,

-- primosTransformados 27 == [17,23,29,37,47,67,97,7]

-- primosTransformados 26 == [23,29]

-- primosTransformados 200 == []

-- primosTransformados 202 == [2]

primosTransformados :: Integer -> [Integer]

primosTransformados n =

[x | x <- primosNdigitos p, difierenEnUnaPosicion n x] ++

[x | x <- [read ('0' : tail ns)], isPrime x]

where ns = show n

p = length ns

-- (difierenEnUnaPosicion m n) se verifica si los números m y n difieren

-- en una posición (suponiendo que m y n tienen el mismo número de

-- dígitos). Por ejemplo,

-- difierenEnUnaPosicion 325 375 == True

-- difierenEnUnaPosicion 325 357 == False

difierenEnUnaPosicion :: Integer -> Integer -> Bool

difierenEnUnaPosicion m n =

1 == length (filter (==False) (zipWith (==) (show m) (show n)))

-- (primosNdigitos n) es la lista de los primos con n dígitos. Por

-- ejemplo,

-- λ> primosNdigitos 2

-- [11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]

primosNdigitos :: Int -> [Integer]

primosNdigitos n = takeWhile (<=10^n-1) (dropWhile (<=10^(n-1)) primes)

compuestosPersistentes3 :: [Integer]

compuestosPersistentes3 = filter esCompuestoPersistente3 [1..]

-- 4ª solución

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

esCompuestoPersistente4 :: Integer -> Bool

esCompuestoPersistente4 n =

null (primosTransformados2 n)

-- (primosTransformados2 n) es la lista de los números primos que se

-- puede obtener modificando uno de los dígitos de n. Por ejemplo,

-- primosTransformados2 27 == [17,23,29,37,47,67,97,7]

-- primosTransformados2 26 == [23,29]

-- primosTransformados2 200 == []

-- primosTransformados2 202 == [2]

primosTransformados2 :: Integer -> [Integer]

primosTransformados2 n =

[x | x <- primosEntre (menorTransformado n) (mayorTransformado n)

, difierenEnUnaPosicion n x] ++

[x | x <- [read ('0' : tail ns)], isPrime x]

where ns = show n

p = length ns

-- (primosEntre x y) lista de números prios mayores o iguales que x y

-- menores o iguales que y. Por ejemplo,

-- primosEntre 11 41 == [11,13,17,19,23,29,31,37,41]

primosEntre ::Integer -> Integer -> [Integer]

primosEntre x y = takeWhile (<= y) (dropWhile (< x) primes)

-- (menorTransformado x) es el menor número, con la misma cantidad de

-- dígitos que x, que se puede obtener modificando uno de los dígitos de

-- n. Por ejemplo,

-- menorTransformado 375 == 175

-- menorTransformado 14 == 11

-- menorTransformado 4 == 1

-- menorTransformado 1145 == 1115

menorTransformado :: Integer -> Integer

menorTransformado x

| x <= 9 = 1

| y > '1' = read ('1' : ys)

| otherwise = read ('1' : show (menorTransformado (read ys)))

where (y:ys) = show x

-- (mayorTransformado x) es el mayor número, con la misma cantidad de

-- dígitos que x, que se puede obtener modificando uno de los dígitos de

-- n. Por ejemplo,

-- mayorTransformado 375 == 975

-- mayorTransformado 93 == 99

-- mayorTransformado 4 == 9

-- mayorTransformado 9945 == 9995

mayorTransformado :: Integer -> Integer

mayorTransformado x

| x <= 9 = 9

| y < '9' = read ('9' : ys)

| otherwise = read ('9' : show (mayorTransformado (read ys)))

where (y:ys) = show x

compuestosPersistentes4 :: [Integer]

compuestosPersistentes4 = filter esCompuestoPersistente4 [1..]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> compuestosPersistentes !! 1000

-- 8180

-- (0.54 secs, 1,577,628,232 bytes)

-- λ> compuestosPersistentes2 !! 1000

-- 8180

-- (10.13 secs, 15,883,929,392 bytes)

-- λ> compuestosPersistentes3 !! 1000

-- 8180

-- (7.09 secs, 14,165,470,304 bytes)

-- λ> compuestosPersistentes4 !! 1000

-- 8180

-- (6.54 secs, 13,332,608,480 bytes)

-- Propiedad

-- =========

-- La propiedad es

prop_compuestosPersistentes :: Integer -> Property

prop_compuestosPersistentes k =

k > 0 ==> esCompuestoPersistente (510 + 2310 * k)

-- La comprobación de la propiedad es

-- λ> quickCheck prop_compuestosPersistentes

-- +++ OK, passed 100 tests.

Números bigenerados

PorJosé A. Alonso 14-enero-202121-enero-2021

Se dice que y es un generador de x si x es igual a la suma de y los dígitos de y. Por ejemplo, 1996 y 2014 son generadores de 2021 ya que

   2021 = 1996 + 1 + 9 + 9 + 6
   2021 = 2014 + 2 + 0 + 1 + 4

1 2	2021 = 1996 + 1 + 9 + 9 + 6 2021 = 2014 + 2 + 0 + 1 + 4

Un número bigenerado es un número que tiene exactamente 2 generadores. Por ejemplo,

2021 es un número bigenerados y sus generadores son 1996 y 2014
20 no es bigenerador porque no tiene ningún generador
21 no es bigenerador porque tiene sólo un generador (el 15).
101 es el menor número bigenerado ysus generadores son 91 y 100.

Definir las funciones

   esBigenerado :: Integer -> Bool
   bigenerados  :: [Integer]

1 2	esBigenerado :: Integer -> Bool bigenerados :: [Integer]

tales que

(esBigenerado x) se verifica si x es bigenerado. Por ejemplo,

     esBigenerado 2021  ==  True
     esBigenerado 20    ==  False
     esBigenerado 21    ==  False
     esBigenerado 101   ==  True

esBigenerado 2021 == True

esBigenerado 20 == False

esBigenerado 21 == False

esBigenerado 101 == True

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

     λ> take 12 bigenerados
     [101,103,105,107,109,111,113,115,117,202,204,206]

1 2	λ> take 12 bigenerados [101,103,105,107,109,111,113,115,117,202,204,206]

Comprobar con QuickCheck que la lista de los números bigenerados es infinita; es decir, para cualquier número positivo n existe un y mayor que x que es bigenerado.

Soluciones

import Test.QuickCheck (Property, (==>), quickCheck)

esBigenerado :: Integer -> Bool
esBigenerado x = length (generadores x) == 2

-- (generadores x) es la lista de los generadores de x. Por ejemplo,
--    generadores 2021  ==  [1996,2014]
--    generadores 20    ==  []
--    generadores 21    ==  [15]
--    generadores 101   ==  [91,100]
generadores :: Integer -> [Integer]
generadores x = filter (esGenerador x) [1..x]

-- (esGenerador x y) se verifica si y es un generador de x. Por ejemplo,
--    esGenerador 818 796  ==  True
--    esGenerador 818 805  ==  True
esGenerador :: Integer -> Integer -> Bool
esGenerador x y = x == y + sumaDigitos y

-- (sumaDigitos n) es la suma de los dígitos de n. Por ejemplo,
--    sumaDigitos 2021  ==  5
sumaDigitos :: Integer -> Integer
sumaDigitos = sum . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 2021  ==  [2,0,2,1]
digitos :: Integer -> [Integer]
digitos x = [read [c] | c <- show x]

bigenerados :: [Integer]
bigenerados = filter esBigenerado [1..]

-- La propiedad es
prop_bigenerados :: Integer -> Property
prop_bigenerados n =
  n >= 0 ==> any esBigenerado [n+1..]

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

import Test.QuickCheck (Property, (==>), quickCheck)

esBigenerado :: Integer -> Bool

esBigenerado x = length (generadores x) == 2

-- (generadores x) es la lista de los generadores de x. Por ejemplo,

-- generadores 2021 == [1996,2014]

-- generadores 20 == []

-- generadores 21 == [15]

-- generadores 101 == [91,100]

generadores :: Integer -> [Integer]

generadores x = filter (esGenerador x) [1..x]

-- (esGenerador x y) se verifica si y es un generador de x. Por ejemplo,

-- esGenerador 818 796 == True

-- esGenerador 818 805 == True

esGenerador :: Integer -> Integer -> Bool

esGenerador x y = x == y + sumaDigitos y

-- (sumaDigitos n) es la suma de los dígitos de n. Por ejemplo,

-- sumaDigitos 2021 == 5

sumaDigitos :: Integer -> Integer

sumaDigitos = sum . digitos

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

-- digitos 2021 == [2,0,2,1]

digitos :: Integer -> [Integer]

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

bigenerados :: [Integer]

bigenerados = filter esBigenerado [1..]

-- La propiedad es

prop_bigenerados :: Integer -> Property

prop_bigenerados n =

n >= 0 ==> any esBigenerado [n+1..]

-- La comprobación es

-- λ> quickCheck prop_bigenerados

-- +++ OK, passed 100 tests.

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>

Caminos reducidos

PorJosé A. Alonso 5-junio-20202-enero-2021

Un camino es una sucesión de pasos en una de las cuatros direcciones Norte, Sur, Este, Oeste. Ir en una dirección y a continuación en la opuesta es un esfuerzo que se puede reducir, Por ejemplo, el camino [Norte,Sur,Este,Sur] se puede reducir a [Este,Sur].

Un camino se dice que es reducido si no tiene dos pasos consecutivos en direcciones opuesta. Por ejemplo, [Este,Sur] es reducido y [Norte,Sur,Este,Sur] no lo es.

En Haskell, las direcciones y los caminos se pueden definir por

   data Direccion = N | S | E | O deriving (Show, Eq)
   type Camino = [Direccion]

1 2	data Direccion = N \| S \| E \| O deriving (Show, Eq) type Camino = [Direccion]

Definir la función

   reducido :: Camino -> Camino

1	reducido :: Camino -> Camino

tal que (reducido ds) es el camino reducido equivalente al camino ds. Por ejemplo,

   reducido []                              ==  []
   reducido [N]                             ==  [N]
   reducido [N,O]                           ==  [N,O]
   reducido [N,O,E]                         ==  [N]
   reducido [N,O,E,S]                       ==  [] 
   reducido [N,O,S,E]                       ==  [N,O,S,E]
   reducido [S,S,S,N,N,N]                   ==  []
   reducido [N,S,S,E,O,N]                   ==  []
   reducido [N,S,S,E,O,N,O]                 ==  [O]
   reducido (take (10^7) (cycle [N,E,O,S])) ==  []

reducido [] == []

reducido [N] == [N]

reducido [N,O] == [N,O]

reducido [N,O,E] == [N]

reducido [N,O,E,S] == []

reducido [N,O,S,E] == [N,O,S,E]

reducido [S,S,S,N,N,N] == []

reducido [N,S,S,E,O,N] == []

reducido [N,S,S,E,O,N,O] == [O]

reducido (take (10^7) (cycle [N,E,O,S])) == []

Nótese que en el penúltimo ejemplo las reducciones son

       [N,S,S,E,O,N,O]  
   --> [S,E,O,N,O]  
   --> [S,N,O]  
   --> [O]

[N,S,S,E,O,N,O]

--> [S,E,O,N,O]

--> [S,N,O]

--> [O]

Soluciones

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

-- 1ª solución (por recursión):
reducido1 :: Camino -> Camino
reducido1 [] = []
reducido1 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido1 ds

opuesta :: Direccion -> Direccion
opuesta N = S
opuesta S = N
opuesta E = O
opuesta O = E

-- 2ª solución (por plegado)
reducido2 :: Camino -> Camino
reducido2 = foldr aux []
    where aux N (S:xs) = xs
          aux S (N:xs) = xs
          aux E (O:xs) = xs
          aux O (E:xs) = xs
          aux x xs     = x:xs

-- 3ª solución 
reducido3 :: Camino -> Camino
reducido3 []       = []
reducido3 (N:S:ds) = reducido3 ds
reducido3 (S:N:ds) = reducido3 ds
reducido3 (E:O:ds) = reducido3 ds
reducido3 (O:E:ds) = reducido3 ds
reducido3 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido3 ds

-- 4ª solución
reducido4 :: Camino -> Camino
reducido4 ds = reverse (aux ([],ds)) where 
    aux (N:xs, S:ys) = aux (xs,ys)
    aux (S:xs, N:ys) = aux (xs,ys)
    aux (E:xs, O:ys) = aux (xs,ys)
    aux (O:xs, E:ys) = aux (xs,ys)
    aux (  xs, y:ys) = aux (y:xs,ys)
    aux (  xs,   []) = xs

-- Comparación de eficiencia
--    ghci> reducido1 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (3.87 secs, 460160736 bytes)
--    ghci> reducido2 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (1.16 secs, 216582880 bytes)
--    ghci> reducido3 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.58 secs, 98561872 bytes)
--    ghci> reducido4 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.64 secs, 176154640 bytes)
--    
--    ghci> reducido3 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (5.43 secs, 962694784 bytes)
--    ghci> reducido4 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (9.29 secs, 1722601528 bytes)
-- 
--    ghci> length $ reducido3 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    (4.52 secs, 547004960 bytes)
--    ghci> length $ reducido4 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    
--    ghci> let n=10^6 in reducido1 (replicate n N ++ replicate n S)
--    []
--    (7.35 secs, 537797096 bytes)
--    ghci> let n=10^6 in reducido2 (replicate n N ++ replicate n S)
--    []
--    (2.30 secs, 244553404 bytes)
--    ghci> let n=10^6 in reducido3 (replicate n N ++ replicate n S)
--    []
--    (8.08 secs, 545043608 bytes)
--    ghci> let n=10^6 in reducido4 (replicate n N ++ replicate n S)
--    []
--    (1.96 secs, 205552240 bytes)

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

-- 1ª solución (por recursión):

reducido1 :: Camino -> Camino

reducido1 [] = []

reducido1 (d:ds) | null ds' = [d]

| d == opuesta (head ds') = tail ds'

| otherwise = d:ds'

where ds' = reducido1 ds

opuesta :: Direccion -> Direccion

opuesta N = S

opuesta S = N

opuesta E = O

opuesta O = E

-- 2ª solución (por plegado)

reducido2 :: Camino -> Camino

reducido2 = foldr aux []

where aux N (S:xs) = xs

aux S (N:xs) = xs

aux E (O:xs) = xs

aux O (E:xs) = xs

aux x xs = x:xs

-- 3ª solución

reducido3 :: Camino -> Camino

reducido3 [] = []

reducido3 (N:S:ds) = reducido3 ds

reducido3 (S:N:ds) = reducido3 ds

reducido3 (E:O:ds) = reducido3 ds

reducido3 (O:E:ds) = reducido3 ds

reducido3 (d:ds) | null ds' = [d]

| d == opuesta (head ds') = tail ds'

| otherwise = d:ds'

where ds' = reducido3 ds

-- 4ª solución

reducido4 :: Camino -> Camino

reducido4 ds = reverse (aux ([],ds)) where

aux (N:xs, S:ys) = aux (xs,ys)

aux (S:xs, N:ys) = aux (xs,ys)

aux (E:xs, O:ys) = aux (xs,ys)

aux (O:xs, E:ys) = aux (xs,ys)

aux ( xs, y:ys) = aux (y:xs,ys)

aux ( xs, []) = xs

-- Comparación de eficiencia

-- ghci> reducido1 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (3.87 secs, 460160736 bytes)

-- ghci> reducido2 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (1.16 secs, 216582880 bytes)

-- ghci> reducido3 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (0.58 secs, 98561872 bytes)

-- ghci> reducido4 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (0.64 secs, 176154640 bytes)

-- ghci> reducido3 (take (10^7) (cycle [N,E,O,S]))

-- []

-- (5.43 secs, 962694784 bytes)

-- ghci> reducido4 (take (10^7) (cycle [N,E,O,S]))

-- []

-- (9.29 secs, 1722601528 bytes)

-- ghci> length $ reducido3 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])

-- 400002

-- (4.52 secs, 547004960 bytes)

-- ghci> length $ reducido4 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])

-- 400002

-- ghci> let n=10^6 in reducido1 (replicate n N ++ replicate n S)

-- []

-- (7.35 secs, 537797096 bytes)

-- ghci> let n=10^6 in reducido2 (replicate n N ++ replicate n S)

-- []

-- (2.30 secs, 244553404 bytes)

-- ghci> let n=10^6 in reducido3 (replicate n N ++ replicate n S)

-- []

-- (8.08 secs, 545043608 bytes)

-- ghci> let n=10^6 in reducido4 (replicate n N ++ replicate n S)

-- []

-- (1.96 secs, 205552240 bytes)

La sucesión ECG

PorJosé A. Alonso 1-junio-20202-enero-2021

La sucesión ECG estás definida por a(1) = 1, a(2) = 2 y, para n >= 3, a(n) es el menor natural que aún no está en la sucesión tal que a(n) tiene algún divisor común con a(n-1).

Los primeros términos de la sucesión son 1, 2, 4, 6, 3, 9, 12, 8, 10, 5, 15, …

Al dibujar su gráfica, se parece a la de los electrocardiogramas (abreviadamente, ECG). Por ello, la sucesión se conoce como la sucesión ECG.

Definir las funciones

   sucECG :: [Integer]
   graficaSucECG :: Int -> IO ()

1 2	sucECG :: [Integer] graficaSucECG :: Int -> IO ()

tales que

sucECG es la lista de los términos de la sucesión ECG. Por ejemplo,

     λ> take 20 sucECG
     [1,2,4,6,3,9,12,8,10,5,15,18,14,7,21,24,16,20,22,11]
     λ> sucECG !! 6000
     6237

λ> take 20 sucECG

[1,2,4,6,3,9,12,8,10,5,15,18,14,7,21,24,16,20,22,11]

λ> sucECG !! 6000

6237

(graficaSucECG n) dibuja la gráfica de los n primeros términos de la sucesión ECG. Por ejemplo, (graficaSucECG 160) dibuja

Soluciones

import Data.List (delete)
import Graphics.Gnuplot.Simple

sucECG :: [Integer]
sucECG = 1 : ecg 2 [2..]
  where ecg x zs = f zs
          where f (y:ys) | gcd x y > 1 = y : ecg y (delete y zs)
                         | otherwise   = f ys

graficaSucECG :: Int -> IO ()
graficaSucECG n =
  plotList [ Key Nothing
           , PNG "La_sucesion_ECG.png" 
           ]
           (take n sucECG)

import Data.List (delete)

import Graphics.Gnuplot.Simple

sucECG :: [Integer]

sucECG = 1 : ecg 2 [2..]

where ecg x zs = f zs

where f (y:ys) | gcd x y > 1 = y : ecg y (delete y zs)

| otherwise = f ys

graficaSucECG :: Int -> IO ()

graficaSucECG n =

plotList [ Key Nothing

, PNG "La_sucesion_ECG.png"

]

(take n sucECG)

Operaciones con series de potencias

PorJosé A. Alonso 29-mayo-202025-marzo-2022

Una serie de potencias es una serie de la forma

   a₀ + a₁x + a₂x² + a₃x³ + ...

1	a₀ + a₁x + a₂x² + a₃x³ + ...

Las series de potencias se pueden representar mediante listas infinitas. Por ejemplo, la serie de la función exponencial es

   e^x = 1 + x + x²/2! + x³/3! + ...

1	e^x = 1 + x + x²/2! + x³/3! + ...

y se puede representar por [1, 1, 1/2, 1/6, 1/24, 1/120, …]

Las operaciones con series se pueden ver como una generalización de las de los polinomios.

En lo que sigue, usaremos el tipo (Serie a) para representar las series de potencias con coeficientes en a y su definición es

   type Serie a = [a]

1	type Serie a = [a]

Definir las siguientes funciones

   opuesta      :: Num a => Serie a -> Serie a
   suma         :: Num a => Serie a -> Serie a -> Serie a
   resta        :: Num a => Serie a -> Serie a -> Serie a
   producto     :: Num a => Serie a -> Serie a -> Serie a
   cociente     :: Fractional a => Serie a -> Serie a -> Serie a
   derivada     :: (Num a, Enum a) => Serie a -> Serie a
   integral     :: (Fractional a, Enum a) => Serie a -> Serie a
   expx         :: Serie Rational

opuesta :: Num a => Serie a -> Serie a

suma :: Num a => Serie a -> Serie a -> Serie a

resta :: Num a => Serie a -> Serie a -> Serie a

producto :: Num a => Serie a -> Serie a -> Serie a

cociente :: Fractional a => Serie a -> Serie a -> Serie a

derivada :: (Num a, Enum a) => Serie a -> Serie a

integral :: (Fractional a, Enum a) => Serie a -> Serie a

expx :: Serie Rational

tales que

(opuesta xs) es la opuesta de la serie xs. Por ejemplo,

     λ> take 7 (opuesta [-6,-4..])
     [6,4,2,0,-2,-4,-6]

1 2	λ> take 7 (opuesta [-6,-4..]) [6,4,2,0,-2,-4,-6]

(suma xs ys) es la suma de las series xs e ys. Por ejemplo,

     λ> take 7 (suma [1,3..] [2,4..])
     [3,7,11,15,19,23,27]

1 2	λ> take 7 (suma [1,3..] [2,4..]) [3,7,11,15,19,23,27]

(resta xs ys) es la resta de las series xs es ys. Por ejemplo,

     λ> take 7 (resta [3,5..] [2,4..])
     [1,1,1,1,1,1,1]
     λ> take 7 (resta ([3,7,11,15,19,23,27] ++ repeat 0) [1,3..])
     [2,4,6,8,10,12,14]

λ> take 7 (resta [3,5..] [2,4..])

[1,1,1,1,1,1,1]

λ> take 7 (resta ([3,7,11,15,19,23,27] ++ repeat 0) [1,3..])

[2,4,6,8,10,12,14]

(producto xs ys) es el producto de las series xs e ys. Por ejemplo,

     λ> take 7 (producto [3,5..] [2,4..])
     [6,22,52,100,170,266,392]

1 2	λ> take 7 (producto [3,5..] [2,4..]) [6,22,52,100,170,266,392]

(cociente xs ys) es el cociente de las series xs e ys. Por ejemplo,

     λ> take 7 (cociente ([6,22,52,100,170,266,392] ++ repeat 0) [3,5..])
     [2.0,4.0,6.0,8.0,10.0,12.0,14.0]

1 2	λ> take 7 (cociente ([6,22,52,100,170,266,392] ++ repeat 0) [3,5..]) [2.0,4.0,6.0,8.0,10.0,12.0,14.0]

(derivada xs) es la derivada de la serie xs. Por ejemplo,

     λ> take 7 (derivada [2,4..])
     [4,12,24,40,60,84,112]

1 2	λ> take 7 (derivada [2,4..]) [4,12,24,40,60,84,112]

(integral xs) es la integral de la serie xs. Por ejemplo,

     λ> take 7 (integral ([4,12,24,40,60,84,112] ++ repeat 0))
     [0.0,4.0,6.0,8.0,10.0,12.0,14.0]

1 2	λ> take 7 (integral ([4,12,24,40,60,84,112] ++ repeat 0)) [0.0,4.0,6.0,8.0,10.0,12.0,14.0]

expx es la serie de la función exponencial. Por ejemplo,

     λ> take 8 expx
     [1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]
     λ> take 8 (derivada expx)
     [1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]
     λ> take 8 (integral expx)
     [0 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 expx

[1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 (derivada expx)

[1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 (integral expx)

[0 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

Soluciones

type Serie a = [a] 

opuesta :: Num a => Serie a -> Serie a
opuesta = map negate

suma :: Num a => Serie a -> Serie a -> Serie a
suma = zipWith (+)

resta :: Num a => Serie a -> Serie a -> Serie a
resta xs ys = suma xs (opuesta ys)

producto :: Num a => Serie a -> Serie a -> Serie a
producto (x:xs) zs@(y:ys) = 
    x*y : suma (producto xs zs) (map (x*) ys)

cociente :: Fractional a => Serie a -> Serie a -> Serie a
cociente (x:xs) (y:ys) = zs 
    where zs = x/y : map (/y) (resta xs (producto zs ys))  

derivada :: (Num a, Enum a) => Serie a -> Serie a
derivada (_:xs) = zipWith (*) xs [1..]

integral :: (Fractional a, Enum a) => Serie a -> Serie a
integral xs = 0 : zipWith (/) xs [1..]

expx :: Serie Rational
expx = map (1/) (map fromIntegral factoriales)

-- factoriales es la lista de los factoriales. Por ejemplo, 
--    take 7 factoriales  ==  [1,1,2,6,24,120,720]
factoriales :: [Integer]
factoriales = 1 : scanl1 (*) [1..]

type Serie a = [a]

opuesta :: Num a => Serie a -> Serie a

opuesta = map negate

suma :: Num a => Serie a -> Serie a -> Serie a

suma = zipWith (+)

resta :: Num a => Serie a -> Serie a -> Serie a

resta xs ys = suma xs (opuesta ys)

producto :: Num a => Serie a -> Serie a -> Serie a

producto (x:xs) zs@(y:ys) =

x*y : suma (producto xs zs) (map (x*) ys)

cociente :: Fractional a => Serie a -> Serie a -> Serie a

cociente (x:xs) (y:ys) = zs

where zs = x/y : map (/y) (resta xs (producto zs ys))

derivada :: (Num a, Enum a) => Serie a -> Serie a

derivada (_:xs) = zipWith (*) xs [1..]

integral :: (Fractional a, Enum a) => Serie a -> Serie a

integral xs = 0 : zipWith (/) xs [1..]

expx :: Serie Rational

expx = map (1/) (map fromIntegral factoriales)

-- factoriales es la lista de los factoriales. Por ejemplo,

-- take 7 factoriales == [1,1,2,6,24,120,720]

factoriales :: [Integer]

factoriales = 1 : scanl1 (*) [1..]

Números compuestos persistentes

Soluciones

Números bigenerados

Soluciones

Nuevas soluciones

Caminos reducidos

Soluciones

La sucesión ECG

Soluciones

Operaciones con series de potencias

Soluciones

Entradas recientes

Buscar

Correo electrónico