longPeriodosFibMod es la sucesión de las longitudes de los períodos de las sucesiones de Fibonacci módulo n, para n > 0. Por ejemplo,
λ> take 20 longPeriodosFibMod
[1,3,8,6,20,24,16,12,24,60,10,24,28,48,40,24,36,24,18,60]
λ> take 20 longPeriodosFibMod
[1,3,8,6,20,24,16,12,24,60,10,24,28,48,40,24,36,24,18,60]
(graficaLongPeriodosFibMod n) dibuja la gráfica de los n primeros términos de la sucesión longPeriodosFibMod. Por ejemplo, (graficaLongPeriodosFibMod n) dibuja
Soluciones
import Graphics.Gnuplot.Simple
fibsMod ::Integer->[Integer]
fibsMod n =map(`mod` n) fibs
-- fibs es la sucesión de Fibonacci. Por ejemplo,-- λ> take 20 fibs-- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]
fibs ::[Integer]
fibs =0:1:zipWith(+) fibs (tail fibs)
periodoFibMod ::Integer->[Integer]
periodoFibMod 1=[0]
periodoFibMod n =0:1: aux (drop2(fibsMod n))where aux (0:1:xs)=[]
aux (a:b:xs)= a : aux (b:xs)
longPeriodosFibMod ::[Int]
longPeriodosFibMod =[length(periodoFibMod n)| n <-[1..]]-- 2ª definición de longPeriodosFibMod-- ===================================
longPeriodosFibMod2 ::[Int]
longPeriodosFibMod2 =map longPeriodoFibMod [1..]
longPeriodoFibMod ::Integer->Int
longPeriodoFibMod 1=1
longPeriodoFibMod n = aux 1(tail(fibsMod n))0where aux 0(1: xs) k = k
aux _ (x : xs) k = aux x xs (k +1)
graficaLongPeriodosFibMod ::Int->IO()
graficaLongPeriodosFibMod n =
plotList [ Key Nothing
, Title ("graficaLongPeriodosFibMod "++show n)
, PNG ("Periodos_de_Fibonacci "++show n ++".png")](take n longPeriodosFibMod)
import Graphics.Gnuplot.Simple
fibsMod :: Integer -> [Integer]
fibsMod n = map (`mod` n) fibs
-- fibs es la sucesión de Fibonacci. Por ejemplo,
-- λ> take 20 fibs
-- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]
fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
periodoFibMod :: Integer -> [Integer]
periodoFibMod 1 = [0]
periodoFibMod n = 0 : 1 : aux (drop 2 (fibsMod n))
where aux (0:1:xs) = []
aux (a:b:xs) = a : aux (b:xs)
longPeriodosFibMod :: [Int]
longPeriodosFibMod =
[length (periodoFibMod n) | n <- [1..]]
-- 2ª definición de longPeriodosFibMod
-- ===================================
longPeriodosFibMod2 :: [Int]
longPeriodosFibMod2 = map longPeriodoFibMod [1..]
longPeriodoFibMod :: Integer -> Int
longPeriodoFibMod 1 = 1
longPeriodoFibMod n = aux 1 (tail (fibsMod n)) 0
where aux 0 (1 : xs) k = k
aux _ (x : xs) k = aux x xs (k + 1)
graficaLongPeriodosFibMod :: Int -> IO ()
graficaLongPeriodosFibMod n =
plotList [ Key Nothing
, Title ("graficaLongPeriodosFibMod " ++ show n)
, PNG ("Periodos_de_Fibonacci " ++ show n ++ ".png")]
(take n longPeriodosFibMod)
La sucesión de Lichtenberg esta formada por la representación decimal de los números binarios de la sucesión de dígitos 0 y 1 alternados Los primeros términos de ambas sucesiones son
lichtenberg :: [Integer]
graficaLichtenberg :: Int -> IO ()
lichtenberg :: [Integer]
graficaLichtenberg :: Int -> IO ()
tales que
lichtenberg es la lista cuyos elementos son los términos de la sucesión de Lichtenberg. Por ejemplo,
λ> take 17 lichtenberg
[0,1,2,5,10,21,42,85,170,341,682,1365,2730,5461,10922,21845,43690]
λ> take 17 lichtenberg
[0,1,2,5,10,21,42,85,170,341,682,1365,2730,5461,10922,21845,43690]
(graficaLichtenberg n) dibuja la gráfica del número de dígitos de los n primeros términos de la sucesión de Lichtenberg. Por ejemlo, (graficaLichtenberg 100) dibuja
Comprobar con QuickCheck que todos los términos de la sucesión de Lichtenberg, a partir del 4º, son números compuestos.
Soluciones
import Data.Char(digitToInt)import Graphics.Gnuplot.Simple
import Test.QuickCheck
import Data.Numbers.Primes (isPrime)-- 1ª solución-- ===========
lichtenberg1 ::[Integer]
lichtenberg1 =map binarioAdecimal sucAlternada
-- sucAlternada es la lista cuyos elementos son los términos de la-- sucesión de los dígitos 0 y 1 alternados. Por ejemplo,-- λ> take 7 sucAlternada-- ["0","1","10","101","1010","10101","101010"]
sucAlternada ::[String]
sucAlternada =['0']:[take n cadenaAlternada | n <-[1..]]-- cadenaAltenada es la cadena formada alternando los caracteres 1 y-- 0. Por ejemplo,-- take 20 cadenaAlternada == "10101010101010101010"
cadenaAlternada ::String
cadenaAlternada =cycle['1','0']-- (binarioAdecimal cs) es el número decimal correspondiente al número-- binario cuya cadena de dígitos es cs. Por ejemplo,-- binarioAdecimal "11101" == 29
binarioAdecimal ::String->Integer
binarioAdecimal =foldl(\acc x -> acc *2+(toInteger . digitToInt) x)0-- 2ª solución
lichtenberg2 ::[Integer]
lichtenberg2 =map a [0..]where a 0=0
a 1=1
a n = a (n-1)+2* a (n-2)+1-- 3ª solución
lichtenberg3 ::[Integer]
lichtenberg3 =0:1:map(+1)(zipWith(+)(tail lichtenberg3)(map(*2) lichtenberg3))-- Comprobación de eficiencia-- λ> length (show (lichtenberg1 !! 27))-- 8-- (0.02 secs, 155,384 bytes)-- λ> length (show (lichtenberg2 !! 27))-- 8-- (2.22 secs, 311,157,760 bytes)-- -- λ> length (show (lichtenberg1 !! (8*10^4)))-- 24083-- (1.28 secs, 664,207,040 bytes)-- λ> length (show (lichtenberg3 !! (8*10^4)))-- 24083-- (2.59 secs, 1,253,328,200 bytes)-- La propiedad es
propLichtenberg ::Int-> Property
propLichtenberg n =
n >4==>not(isPrime (lichtenberg1 !! n))-- La comprobación es-- λ> quickCheck propLichtenberg-- +++ OK, passed 100 tests.
graficaLichtenberg ::Int->IO()
graficaLichtenberg n =
plotList [ Key Nothing
, Title "Numero de digitos de la sucesion de Lichtenberg"
, PNG "Sucesion_de_Lichtenberg.png"](take n (map(length . show) lichtenberg1))
import Data.Char (digitToInt)
import Graphics.Gnuplot.Simple
import Test.QuickCheck
import Data.Numbers.Primes (isPrime)
-- 1ª solución
-- ===========
lichtenberg1 :: [Integer]
lichtenberg1 = map binarioAdecimal sucAlternada
-- sucAlternada es la lista cuyos elementos son los términos de la
-- sucesión de los dígitos 0 y 1 alternados. Por ejemplo,
-- λ> take 7 sucAlternada
-- ["0","1","10","101","1010","10101","101010"]
sucAlternada :: [String]
sucAlternada =
['0'] : [take n cadenaAlternada | n <- [1..]]
-- cadenaAltenada es la cadena formada alternando los caracteres 1 y
-- 0. Por ejemplo,
-- take 20 cadenaAlternada == "10101010101010101010"
cadenaAlternada :: String
cadenaAlternada = cycle ['1','0']
-- (binarioAdecimal cs) es el número decimal correspondiente al número
-- binario cuya cadena de dígitos es cs. Por ejemplo,
-- binarioAdecimal "11101" == 29
binarioAdecimal :: String -> Integer
binarioAdecimal =
foldl (\acc x -> acc * 2 + (toInteger . digitToInt) x) 0
-- 2ª solución
lichtenberg2 :: [Integer]
lichtenberg2 = map a [0..]
where a 0 = 0
a 1 = 1
a n = a (n-1) + 2 * a (n-2) + 1
-- 3ª solución
lichtenberg3 :: [Integer]
lichtenberg3 =
0 : 1 : map (+1) (zipWith (+) (tail lichtenberg3) (map (*2) lichtenberg3))
-- Comprobación de eficiencia
-- λ> length (show (lichtenberg1 !! 27))
-- 8
-- (0.02 secs, 155,384 bytes)
-- λ> length (show (lichtenberg2 !! 27))
-- 8
-- (2.22 secs, 311,157,760 bytes)
--
-- λ> length (show (lichtenberg1 !! (8*10^4)))
-- 24083
-- (1.28 secs, 664,207,040 bytes)
-- λ> length (show (lichtenberg3 !! (8*10^4)))
-- 24083
-- (2.59 secs, 1,253,328,200 bytes)
-- La propiedad es
propLichtenberg :: Int -> Property
propLichtenberg n =
n > 4 ==> not (isPrime (lichtenberg1 !! n))
-- La comprobación es
-- λ> quickCheck propLichtenberg
-- +++ OK, passed 100 tests.
graficaLichtenberg :: Int -> IO ()
graficaLichtenberg n =
plotList [ Key Nothing
, Title "Numero de digitos de la sucesion de Lichtenberg"
, PNG "Sucesion_de_Lichtenberg.png"
]
(take n (map (length . show) lichtenberg1))
el vecino izquierdo de 5 es 2 y su vecino derecho es 7,
el vecino izquierdo de 9 es 7 y su vecino derecho es 3,
el vecino izquierdo de 3 es 9 y su vecino derecho es 2,
el elemento 4 no tiene vecinos (porque no está en la lista).
Para indicar las direcciones se define el tipo de datos
data Direccion = I | D deriving Eq
data Direccion = I | D deriving Eq
Definir la función
vecino :: Eq a => Direccion -> [a] -> a -> Maybe a
vecino :: Eq a => Direccion -> [a] -> a -> Maybe a
tal que (vecino d xs x) es el vecino de x en la lista de elementos distintos xs según la dirección d. Por ejemplo,
vecino I [3,2,5,7,9] 5 == Just 2
vecino D [3,2,5,7,9] 5 == Just 7
vecino I [3,2,5,7,9] 9 == Just 7
vecino D [3,2,5,7,9] 9 == Just 3
vecino I [3,2,5,7,9] 3 == Just 9
vecino D [3,2,5,7,9] 3 == Just 2
vecino I [3,2,5,7,9] 4 == Nothing
vecino D [3,2,5,7,9] 4 == Nothing
vecino I [3,2,5,7,9] 5 == Just 2
vecino D [3,2,5,7,9] 5 == Just 7
vecino I [3,2,5,7,9] 9 == Just 7
vecino D [3,2,5,7,9] 9 == Just 3
vecino I [3,2,5,7,9] 3 == Just 9
vecino D [3,2,5,7,9] 3 == Just 2
vecino I [3,2,5,7,9] 4 == Nothing
vecino D [3,2,5,7,9] 4 == Nothing
Soluciones
data Direccion = I | D derivingEq-- 1ª solución-- ===========
vecino1 ::Eq a => Direccion ->[a]-> a ->Maybe a
vecino1 d xs x = busca x (vecinos d xs)-- (vecinos d xs) es la lista de elementos de xs y sus vecinos según la-- direccioń d. Por ejemplo,-- vecinos I [1..5] == [(2,1),(3,2),(4,3),(5,4),(1,5)]-- vecinos D [1..5] == [(1,2),(2,3),(3,4),(4,5),(5,1)]
vecinos :: Direccion ->[a]->[(a,a)]
vecinos I xs =zip(tail(cycle xs)) xs
vecinos D xs =zip xs (tail(cycle xs))-- (busca x ps) es el la segunda componente de primer par de ps cuya-- primera componente es igual a x. Por ejemplo, -- busca 3 [(4,1),(3,2),(3,7)] == Just 2-- busca 7 [(4,1),(3,2),(3,7)] == Nothing
busca ::Eq a => a ->[(a,b)]->Maybe b
busca x ps
|null zs = Nothing
|otherwise= Just (head zs)where zs =[z |(x',z)<- ps, x' == x]-- 2ª solución-- ===========
vecino2 ::Eq a => Direccion ->[a]-> a ->Maybe a
vecino2 d xs x =lookup x (vecinos d xs)-- 3ª solución-- ===========
vecino3 ::Eq a => Direccion ->[a]-> a ->Maybe a
vecino3 I xs x =lookup x (zip(tail(cycle xs)) xs)
vecino3 D xs x =lookup x (zip xs (tail(cycle xs)))
data Direccion = I | D deriving Eq
-- 1ª solución
-- ===========
vecino1 :: Eq a => Direccion -> [a] -> a -> Maybe a
vecino1 d xs x = busca x (vecinos d xs)
-- (vecinos d xs) es la lista de elementos de xs y sus vecinos según la
-- direccioń d. Por ejemplo,
-- vecinos I [1..5] == [(2,1),(3,2),(4,3),(5,4),(1,5)]
-- vecinos D [1..5] == [(1,2),(2,3),(3,4),(4,5),(5,1)]
vecinos :: Direccion -> [a] -> [(a,a)]
vecinos I xs = zip (tail (cycle xs)) xs
vecinos D xs = zip xs (tail (cycle xs))
-- (busca x ps) es el la segunda componente de primer par de ps cuya
-- primera componente es igual a x. Por ejemplo,
-- busca 3 [(4,1),(3,2),(3,7)] == Just 2
-- busca 7 [(4,1),(3,2),(3,7)] == Nothing
busca :: Eq a => a -> [(a,b)] -> Maybe b
busca x ps
| null zs = Nothing
| otherwise = Just (head zs)
where zs = [z | (x',z) <- ps, x' == x]
-- 2ª solución
-- ===========
vecino2 :: Eq a => Direccion -> [a] -> a -> Maybe a
vecino2 d xs x = lookup x (vecinos d xs)
-- 3ª solución
-- ===========
vecino3 :: Eq a => Direccion -> [a] -> a -> Maybe a
vecino3 I xs x = lookup x (zip (tail (cycle xs)) xs)
vecino3 D xs x = lookup x (zip xs (tail (cycle xs)))
(contadora n) es la sucesión cuyo primer elemento es n y los restantes se obtienen contando el número anterior de la sucesión. Por ejemplo,
λ> take 14 (contadora 1)
[1,11,21,1112,3112,211213,312213,212223,114213,31121314,41122314,
31221324,21322314,21322314]
λ> take 14 (contadora 5)
[5,15,1115,3115,211315,31121315,41122315,3122131415,4122231415,
3132132415,3122331415,3122331415,3122331415,3122331415]
λ> take 14 (contadora 1)
[1,11,21,1112,3112,211213,312213,212223,114213,31121314,41122314,
31221324,21322314,21322314]
λ> take 14 (contadora 5)
[5,15,1115,3115,211315,31121315,41122315,3122131415,4122231415,
3132132415,3122331415,3122331415,3122331415,3122331415]
(lugarPuntoFijoContadora n k) es el menor i <= k tal que son iguales los elementos en las posiciones i e i+1 de la sucesión contadora que cominza con n. Por ejemplo,
Nota: Este ejercicio ha sido propuesto por Ángel Ruiz.
Soluciones
import Data.List ( genericLength
, genericTake
, group
, nub
, sort
)-- Definición de numeroContado
numeroContado ::Integer->Integer
numeroContado n =(read . concat . mapconcat)[[(show . length) m,nub m]| m <-(group . sort . show) n]-- 1ª definición de contadora
contadora ::Integer->[Integer]
contadora n = n :map numeroContado (contadora n)-- 2ª definición de contadora
contadora2 ::Integer->[Integer]
contadora2 =iterate numeroContado
-- Definición de lugarPuntoFijoContadora
lugarPuntoFijoContadora ::Integer->Integer->MaybeInteger
lugarPuntoFijoContadora n k
| m == k-1= Nothing
|otherwise= Just m
where xs = genericTake k (contadora n)
ds =zipWith(-) xs (tail xs)
m = genericLength (takeWhile(/=0) ds)
import Data.List ( genericLength
, genericTake
, group
, nub
, sort
)
-- Definición de numeroContado
numeroContado :: Integer -> Integer
numeroContado n =
(read . concat . map concat) [[(show . length) m,nub m]
| m <- (group . sort . show) n]
-- 1ª definición de contadora
contadora :: Integer -> [Integer]
contadora n = n : map numeroContado (contadora n)
-- 2ª definición de contadora
contadora2 :: Integer -> [Integer]
contadora2 = iterate numeroContado
-- Definición de lugarPuntoFijoContadora
lugarPuntoFijoContadora :: Integer -> Integer -> Maybe Integer
lugarPuntoFijoContadora n k
| m == k-1 = Nothing
| otherwise = Just m
where xs = genericTake k (contadora n)
ds = zipWith (-) xs (tail xs)
m = genericLength (takeWhile (/=0) ds)
Los subnúmeros de un número x son los números que se pueden formar con dígitos de x en posiciones consecutivas. Por ejemplo, el número 254 tiene 6 subnúmeros: 2, 5, 4, 25, 54 y 254.
import Data.List ( genericLength
, inits
, tails
)
subnumerosPares ::Integer->[Integer]
subnumerosPares n =filtereven(subnumeros n)-- (subnumeros n) es la lista de los subnúmeros de n. Por ejemplo,-- subnumeros 254 == [2,25,5,254,54,4]
subnumeros ::Integer->[Integer]
subnumeros n =[read x | x <- sublistas (show n)]-- (sublistas xs) es la lista de las sublistas de xs. Por ejemplo, -- sublistas "abc" == ["a","ab","b","abc","bc","c"]
sublistas ::[a]->[[a]]
sublistas xs =concat[init(tails ys)| ys <-tail(inits xs)]-- 1ª definición-- =============
nSubnumerosPares ::Integer->Integer
nSubnumerosPares =
genericLength . subnumerosPares
-- 2ª definición-- =============
nSubnumerosPares2 ::Integer->Integer
nSubnumerosPares2 =sum . posicionesDigitosPares
-- (posicionesDigitosPares x) es la lista de las posiciones de los-- dígitos pares de x. Por ejemplo,-- posicionesDigitosPares 254 == [1,3]
posicionesDigitosPares ::Integer->[Integer]
posicionesDigitosPares x =[n |(n,y)<-zip[1..](show x)
, y `elem` "02468"]-- Comparación de eficiencia-- λ> nSubnumerosPares (2^(10^3))-- 22934-- (2.83 secs, 3,413,414,872 bytes)-- λ> nSubnumerosPares2 (2^(10^3))-- 22934-- (0.01 secs, 0 bytes)
import Data.List ( genericLength
, inits
, tails
)
subnumerosPares :: Integer -> [Integer]
subnumerosPares n =
filter even (subnumeros n)
-- (subnumeros n) es la lista de los subnúmeros de n. Por ejemplo,
-- subnumeros 254 == [2,25,5,254,54,4]
subnumeros :: Integer -> [Integer]
subnumeros n =
[read x | x <- sublistas (show n)]
-- (sublistas xs) es la lista de las sublistas de xs. Por ejemplo,
-- sublistas "abc" == ["a","ab","b","abc","bc","c"]
sublistas :: [a] -> [[a]]
sublistas xs =
concat [init (tails ys) | ys <- tail (inits xs)]
-- 1ª definición
-- =============
nSubnumerosPares :: Integer -> Integer
nSubnumerosPares =
genericLength . subnumerosPares
-- 2ª definición
-- =============
nSubnumerosPares2 :: Integer -> Integer
nSubnumerosPares2 =
sum . posicionesDigitosPares
-- (posicionesDigitosPares x) es la lista de las posiciones de los
-- dígitos pares de x. Por ejemplo,
-- posicionesDigitosPares 254 == [1,3]
posicionesDigitosPares :: Integer -> [Integer]
posicionesDigitosPares x =
[n | (n,y) <- zip [1..] (show x)
, y `elem` "02468"]
-- Comparación de eficiencia
-- λ> nSubnumerosPares (2^(10^3))
-- 22934
-- (2.83 secs, 3,413,414,872 bytes)
-- λ> nSubnumerosPares2 (2^(10^3))
-- 22934
-- (0.01 secs, 0 bytes)