tail

Números consecutivos compuestos

PorJosé A. Alonso 22-noviembre-201629-noviembre-2016

Una serie compuesta de longitud n es una lista de n números consecutivos que son todos compuestos. Por ejemplo, [8,9,10] y [24,25,26] son dos series compuestas de longitud 3.

Cada serie compuesta se puede representar por el par formado por su primer y último elemento. Por ejemplo, las dos series anteriores se pueden representar pos (8,10) y (24,26) respectivamente.

Definir la función

   menorSerieCompuesta :: Integer -> (Integer,Integer)

1	menorSerieCompuesta :: Integer -> (Integer,Integer)

tal que (menorSerieCompuesta n) es la menor serie compuesta (es decir, la que tiene menores elementos) de longitud 3. Por ejemplo,

   menorSerieCompuesta 3    ==  (8,10)
   menorSerieCompuesta 4    ==  (24,27)
   menorSerieCompuesta 5    ==  (24,28)
   menorSerieCompuesta 150  ==  (4652354,4652503)

menorSerieCompuesta 3 == (8,10)

menorSerieCompuesta 4 == (24,27)

menorSerieCompuesta 5 == (24,28)

menorSerieCompuesta 150 == (4652354,4652503)

Comprobar con QuickCheck que para n > 1, el primer elemento de (menorSerieCompuesta n) es igual al primero de (menorSerieCompuesta (n-1)) o al primero de (menorSerieCompuesta (n+1)).

Soluciones

import Data.Numbers.Primes
import Test.QuickCheck

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

menorSerieCompuesta1 :: Integer -> (Integer,Integer)
menorSerieCompuesta1 n = (x,x+n-1)
  where x = head [y | y <- [1..]
                    , esCompuesta [y..y+n-1]]

esCompuesta :: [Integer] -> Bool
esCompuesta xs =  all (not . isPrime) xs

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

menorSerieCompuesta2 :: Integer -> (Integer,Integer)
menorSerieCompuesta2 n = (x+1,x+n)
  where (x,y) = head [(p,q) | (p,q) <- zip primes (tail primes)
                            , q - p >= n + 1]

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

--    λ> menorSerieCompuesta1 75
--    (155922,155996)
--    (12.16 secs, 30,378,380,552 bytes)
--    λ> menorSerieCompuesta2 75
--    (155922,155996)
--    (0.07 secs, 89,813,752 bytes)


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

-- La propiedad es
prop_menorSerieCompuesta :: Integer -> Property
prop_menorSerieCompuesta n =
  n > 1 ==> x == y || y == z
  where [x,y,z] = map (fst . menorSerieCompuesta2) [n-1,n,n+1]

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

import Data.Numbers.Primes

import Test.QuickCheck

-- 1ª definición

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

menorSerieCompuesta1 :: Integer -> (Integer,Integer)

menorSerieCompuesta1 n = (x,x+n-1)

where x = head [y | y <- [1..]

, esCompuesta [y..y+n-1]]

esCompuesta :: [Integer] -> Bool

esCompuesta xs = all (not . isPrime) xs

-- 2ª definición

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

menorSerieCompuesta2 :: Integer -> (Integer,Integer)

menorSerieCompuesta2 n = (x+1,x+n)

where (x,y) = head [(p,q) | (p,q) <- zip primes (tail primes)

, q - p >= n + 1]

-- Comparación de eficiencia

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

-- λ> menorSerieCompuesta1 75

-- (155922,155996)

-- (12.16 secs, 30,378,380,552 bytes)

-- λ> menorSerieCompuesta2 75

-- (155922,155996)

-- (0.07 secs, 89,813,752 bytes)

-- Comprobación de la propiedad

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

-- La propiedad es

prop_menorSerieCompuesta :: Integer -> Property

prop_menorSerieCompuesta n =

n > 1 ==> x == y || y == z

where [x,y,z] = map (fst . menorSerieCompuesta2) [n-1,n,n+1]

-- La comprobación es

-- λ> quickCheck prop_menorSerieCompuesta

-- +++ OK, passed 100 tests.

Referencias

Sucesión A030296 de la OEIS.

Conjetura de Rassias

PorJosé A. Alonso 8-noviembre-201615-noviembre-2016

El artículo de esta semana del blog Números y hoja de cálculo está dedicado a la Conjetura de Rassias. Dicha conjetura afirma que

Para cada número primo p > 2 existen dos primos a y b, con a < b, tales que
(p-1)a = b+1

Dado un primo p > 2, los pares de Rassia de p son los pares de primos (a,b), con a < b, tales que (p-1)a = b+1. Por ejemplo, (2,7) y (3,11) son pares de Rassia de 5 ya que

2 y 7 son primos, 2 < 7 y (5-1)·2 = 7+1
3 y 11 son primos, 3 < 11 y (5-1)·3 = 11+1

Definir las siguientes funciones

   paresRassias     :: Integer -> [(Integer,Integer)]
   conjeturaRassias :: Integer -> Bool

1 2	paresRassias :: Integer -> [(Integer,Integer)] conjeturaRassias :: Integer -> Bool

tales que

(paresRassias p) es la lista de los pares de Rassias del primo p (que se supone que es mayor que 2). Por ejemplo,

     take 3 (paresRassias 5)    == [(2,7),(3,11),(5,19)]
     take 3 (paresRassias 1229) == [(71,87187),(113,138763),(191,234547)]

1 2	take 3 (paresRassias 5) == [(2,7),(3,11),(5,19)] take 3 (paresRassias 1229) == [(71,87187),(113,138763),(191,234547)]

(conjeturaRassia x) se verifica si para todos los primos menores que x (y mayores que 2) se cumple la conjetura de Rassia. Por ejemplo,

     conjeturaRassias (10^5)  ==  True

1	conjeturaRassias (10^5) == True

Soluciones

import Data.Numbers.Primes (primes, isPrime)

paresRassias :: Integer -> [(Integer,Integer)]
paresRassias p =
  [(a,b) | a <- primes
         , let b = (p - 1) * a - 1
         , isPrime b]

conjeturaRassias :: Integer -> Bool
conjeturaRassias x =
  and [(not . null . paresRassias) p | p <- tail (takeWhile (<x) primes)]

import Data.Numbers.Primes (primes, isPrime)

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

paresRassias p =

[(a,b) | a <- primes

, let b = (p - 1) * a - 1

, isPrime b]

conjeturaRassias :: Integer -> Bool

conjeturaRassias x =

and [(not . null . paresRassias) p | p <- tail (takeWhile (<x) primes)]

Referencias

Conjetura de Rassias por Antonio Roldán en el blog «Números y hoja de cálculo»
Rassias’ conjecture en Wikipedia

Sucesión fractal

PorJosé A. Alonso 10-mayo-201625-abril-2021

La sucesión fractal

   0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, 0, 8, 4, 9, 2, 
   10, 5, 11, 1, 12, 6, 13, 3, 14, 7, 15, ...

1 2	0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, 0, 8, 4, 9, 2, 10, 5, 11, 1, 12, 6, 13, 3, 14, 7, 15, ...

está construida de la siguiente forma:

los términos pares forman la sucesión de los números naturales

     0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...

1	0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...

los términos impares forman la misma sucesión original

     0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, ...

1	0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, ...

Definir las funciones

   sucFractal     :: [Integer]
   sumaSucFractal :: Integer -> Integer

1 2	sucFractal :: [Integer] sumaSucFractal :: Integer -> Integer

tales que

sucFractal es la lista de los términos de la sucesión fractal. Por ejemplo,

     take 20 sucFractal   == [0,0,1,0,2,1,3,0,4,2,5,1,6,3,7,0,8,4,9,2]
     sucFractal !! 30     == 15
     sucFractal !! (10^7) == 5000000

take 20 sucFractal == [0,0,1,0,2,1,3,0,4,2,5,1,6,3,7,0,8,4,9,2]

sucFractal !! 30 == 15

sucFractal !! (10^7) == 5000000

(sumaSucFractal n) es la suma de los n primeros términos de la sucesión fractal. Por ejemplo,

     sumaSucFractal 10      ==  13
     sumaSucFractal (10^5)  == 1666617368
     sumaSucFractal (10^10) == 16666666661668691669
     sumaSucFractal (10^15) == 166666666666666166673722792954
     sumaSucFractal (10^20) == 1666666666666666666616666684103392376198
     length (show (sumaSucFractal (10^15000))) == 30000
     sumaSucFractal (10^15000) `mod` (10^9)    == 455972157

sumaSucFractal 10 == 13

sumaSucFractal (10^5) == 1666617368

sumaSucFractal (10^10) == 16666666661668691669

sumaSucFractal (10^15) == 166666666666666166673722792954

sumaSucFractal (10^20) == 1666666666666666666616666684103392376198

length (show (sumaSucFractal (10^15000))) == 30000

sumaSucFractal (10^15000) `mod` (10^9) == 455972157

Soluciones

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

sucFractal1 :: [Integer]
sucFractal1 = 
    map termino [0..]

-- (termino n) es el término n de la secuencia anterior. Por ejemplo,
--   termino 0            ==  0
--   termino 1            ==  0
--   map termino [0..10]  ==  [0,0,1,0,2,1,3,0,4,2,5]
termino :: Integer -> Integer
termino 0 = 0
termino n 
    | even n    = n `div` 2
    | otherwise = termino (n `div` 2)

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

sucFractal2 :: [Integer]
sucFractal2 =
    0 : 0 : mezcla [1..] (tail sucFractal2)

-- (mezcla xs ys) es la lista obtenida intercalando las listas infinitas
-- xs e ys. Por ejemplo,
--    take 10 (mezcla [0,2..] [0,-2..])  ==  [0,0,2,-2,4,-4,6,-6,8,-8]
mezcla :: [Integer] -> [Integer] -> [Integer]
mezcla (x:xs) (y:ys) =
    x:y:mezcla xs ys

-- Comparación de eficiencia de definiciones de sucFractal
-- =======================================================

--    λ> sum (take (10^6) sucFractal1)
--    166666169612
--    (5.56 secs, 842,863,264 bytes)
--    λ> sum (take (10^6) sucFractal2)
--    166666169612
--    (1.81 secs, 306,262,616 bytes)

-- En lo que sigue usaremos la 2ª definición
sucFractal :: [Integer]
sucFractal = sucFractal2

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

sumaSucFractal1 :: Integer -> Integer
sumaSucFractal1 n =
    sum (map termino [0..n-1])

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

sumaSucFractal2 :: Integer -> Integer
sumaSucFractal2 n =
    sum (take (fromIntegral n) sucFractal)

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

sumaSucFractal3 :: Integer -> Integer
sumaSucFractal3 0 = 0
sumaSucFractal3 1 = 0
sumaSucFractal3 n
    | even n    = sumaN (n `div` 2) + sumaSucFractal3 (n `div` 2)
    | otherwise = sumaN ((n+1) `div` 2) + sumaSucFractal3 (n `div` 2)
    where sumaN n = (n*(n-1)) `div` 2

-- Comparación de eficiencia de definiciones de sumaSucFractal
-- ===========================================================

--    λ> sumaSucFractal1 (10^6)
--    166666169612
--    (5.25 secs, 810,622,504 bytes)
--    λ> sumaSucFractal2 (10^6)
--    166666169612
--    (1.72 secs, 286,444,048 bytes)
--    λ> sumaSucFractal3 (10^6)
--    166666169612
--    (0.01 secs, 0 bytes)
--    
--    λ> sumaSucFractal2 (10^7)
--    16666661685034
--    (17.49 secs, 3,021,580,920 bytes)
--    λ> sumaSucFractal3 (10^7)
--    16666661685034
--    (0.01 secs, 0 bytes)

-- 1ª definición de sucFractal

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

sucFractal1 :: [Integer]

sucFractal1 =

map termino [0..]

-- (termino n) es el término n de la secuencia anterior. Por ejemplo,

-- termino 0 == 0

-- termino 1 == 0

-- map termino [0..10] == [0,0,1,0,2,1,3,0,4,2,5]

termino :: Integer -> Integer

termino 0 = 0

termino n

| even n = n `div` 2

| otherwise = termino (n `div` 2)

-- 2ª definición de sucFractal

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

sucFractal2 :: [Integer]

sucFractal2 =

0 : 0 : mezcla [1..] (tail sucFractal2)

-- (mezcla xs ys) es la lista obtenida intercalando las listas infinitas

-- xs e ys. Por ejemplo,

-- take 10 (mezcla [0,2..] [0,-2..]) == [0,0,2,-2,4,-4,6,-6,8,-8]

mezcla :: [Integer] -> [Integer] -> [Integer]

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

x:y:mezcla xs ys

-- Comparación de eficiencia de definiciones de sucFractal

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

-- λ> sum (take (10^6) sucFractal1)

-- 166666169612

-- (5.56 secs, 842,863,264 bytes)

-- λ> sum (take (10^6) sucFractal2)

-- 166666169612

-- (1.81 secs, 306,262,616 bytes)

-- En lo que sigue usaremos la 2ª definición

sucFractal :: [Integer]

sucFractal = sucFractal2

-- 1ª definición de sumaSucFractal

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

sumaSucFractal1 :: Integer -> Integer

sumaSucFractal1 n =

sum (map termino [0..n-1])

-- 2ª definición de sumaSucFractal

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

sumaSucFractal2 :: Integer -> Integer

sumaSucFractal2 n =

sum (take (fromIntegral n) sucFractal)

-- 3ª definición de sumaSucFractal

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

sumaSucFractal3 :: Integer -> Integer

sumaSucFractal3 0 = 0

sumaSucFractal3 1 = 0

sumaSucFractal3 n

| even n = sumaN (n `div` 2) + sumaSucFractal3 (n `div` 2)

| otherwise = sumaN ((n+1) `div` 2) + sumaSucFractal3 (n `div` 2)

where sumaN n = (n*(n-1)) `div` 2

-- Comparación de eficiencia de definiciones de sumaSucFractal

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

-- λ> sumaSucFractal1 (10^6)

-- 166666169612

-- (5.25 secs, 810,622,504 bytes)

-- λ> sumaSucFractal2 (10^6)

-- 166666169612

-- (1.72 secs, 286,444,048 bytes)

-- λ> sumaSucFractal3 (10^6)

-- 166666169612

-- (0.01 secs, 0 bytes)

-- λ> sumaSucFractal2 (10^7)

-- 16666661685034

-- (17.49 secs, 3,021,580,920 bytes)

-- λ> sumaSucFractal3 (10^7)

-- 16666661685034

-- (0.01 secs, 0 bytes)

Referencia

Fractal sequences and restricted Nim por Lionel Levine.

Mínima diferencia entre elementos de una lista

PorJosé A. Alonso 18-abril-201625-abril-2016

Definir la función

   minimaDiferencia :: (Num a, Ord a) => [a] -> a

1	minimaDiferencia :: (Num a, Ord a) => [a] -> a

tal que (minimaDiferencia xs) es el menor valor absoluto de las diferencias entre todos los pares de elementos de xs (que se supone que tiene al menos 2 elementos). Por ejemplo,

   minimaDiferencia [1,5,3,19,18,25]  ==  1
   minimaDiferencia [30,5,20,9]       ==  4
   minimaDiferencia [30,5,20,9,5]     ==  0
   minimaDiferencia [1..10^6]         ==  1

minimaDiferencia [1,5,3,19,18,25] == 1

minimaDiferencia [30,5,20,9] == 4

minimaDiferencia [30,5,20,9,5] == 0

minimaDiferencia [1..10^6] == 1

En el primer ejemplo la menor diferencia es 1 y se da entre los elementos 19 y 18; en el 2ª es 4 entre los elementos 5 y 9 y en la 3ª es 0 porque el elemento 5 está repetido.

Soluciones

import Data.List (delete, sort)

-- 1ª definición    
minimaDiferencia1 :: (Num a, Ord a) => [a] -> a
minimaDiferencia1 xs =
    minimum [abs (x - y) | x <- xs, y <- delete x xs]

-- 2ª definición    
minimaDiferencia2 :: (Num a, Ord a) => [a] -> a
minimaDiferencia2 [x,y]  = abs (x - y)
minimaDiferencia2 (x:xs) = min (minimum [abs (x - y) | y <- xs])
                               (minimaDiferencia2 xs)      

-- 3ª definición    
minimaDiferencia3 :: (Num a, Ord a) => [a] -> a
minimaDiferencia3 xs =
    minimum [y - x | (x,y) <- zip ys (tail ys)]
    where ys = sort xs

-- Comparación de eficiencia
--    λ> minimaDiferencia1 [1..2*10^3]
--    1
--    (3.47 secs, 1,419,790,688 bytes)
--    λ> minimaDiferencia2 [1..2*10^3]
--    1
--    (0.78 secs, 684,030,712 bytes)
--    λ> minimaDiferencia3 [1..2*10^3]
--    1
--    (0.02 secs, 0 bytes)
--    
--    λ> minimaDiferencia2 [1..5*10^3]
--    1
--    (5.14 secs, 4,233,952,776 bytes)
--    λ> minimaDiferencia3 [1..5*10^3]
--    1
--    (0.02 secs, 0 bytes)

import Data.List (delete, sort)

-- 1ª definición

minimaDiferencia1 :: (Num a, Ord a) => [a] -> a

minimaDiferencia1 xs =

minimum [abs (x - y) | x <- xs, y <- delete x xs]

-- 2ª definición

minimaDiferencia2 :: (Num a, Ord a) => [a] -> a

minimaDiferencia2 [x,y] = abs (x - y)

minimaDiferencia2 (x:xs) = min (minimum [abs (x - y) | y <- xs])

(minimaDiferencia2 xs)

-- 3ª definición

minimaDiferencia3 :: (Num a, Ord a) => [a] -> a

minimaDiferencia3 xs =

minimum [y - x | (x,y) <- zip ys (tail ys)]

where ys = sort xs

-- Comparación de eficiencia

-- λ> minimaDiferencia1 [1..2*10^3]

-- 1

-- (3.47 secs, 1,419,790,688 bytes)

-- λ> minimaDiferencia2 [1..2*10^3]

-- 1

-- (0.78 secs, 684,030,712 bytes)

-- λ> minimaDiferencia3 [1..2*10^3]

-- 1

-- (0.02 secs, 0 bytes)

-- λ> minimaDiferencia2 [1..5*10^3]

-- 1

-- (5.14 secs, 4,233,952,776 bytes)

-- λ> minimaDiferencia3 [1..5*10^3]

-- 1

-- (0.02 secs, 0 bytes)

Caminos reducidos

PorJosé A. Alonso 12-abril-201625-abril-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
--    (2.17 secs, 379049224 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

-- (2.17 secs, 379049224 bytes)

Números consecutivos compuestos

Soluciones

Referencias

Conjetura de Rassias

Soluciones

Referencias

Sucesión fractal

Soluciones

Referencia

Mínima diferencia entre elementos de una lista

Soluciones

Caminos reducidos

Soluciones

Entradas recientes

Buscar

Correo electrónico